First working version
This commit is contained in:
commit
f10b2c0f69
5 changed files with 96 additions and 0 deletions
2
.gitignore
vendored
Normal file
2
.gitignore
vendored
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
dist*/
|
||||||
|
.ghc.environment.*
|
5
CHANGELOG.md
Normal file
5
CHANGELOG.md
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
# Revision history for RomanNum
|
||||||
|
|
||||||
|
## 0.1.0.0 -- 2019-11-08
|
||||||
|
|
||||||
|
* A first working version, exposing a constructor, sum and shortcut for conversion from String
|
26
RomanNum.cabal
Normal file
26
RomanNum.cabal
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
cabal-version: 2.4
|
||||||
|
-- Initial package description 'RomanNum.cabal' generated by 'cabal init'.
|
||||||
|
-- For further documentation, see http://haskell.org/cabal/users-guide/
|
||||||
|
|
||||||
|
name: RomanNum
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
-- bug-reports:
|
||||||
|
-- license:
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Tissevert
|
||||||
|
maintainer: tissevert+devel@marvid.fr
|
||||||
|
-- copyright:
|
||||||
|
-- category:
|
||||||
|
extra-source-files: CHANGELOG.md
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: Data.RomanNum
|
||||||
|
-- other-modules:
|
||||||
|
-- other-extensions:
|
||||||
|
build-depends: base ^>=4.11.1.0
|
||||||
|
, containers
|
||||||
|
hs-source-dirs: src
|
||||||
|
default-language: Haskell2010
|
||||||
|
ghc-options: -Wall
|
2
Setup.hs
Normal file
2
Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
import Distribution.Simple
|
||||||
|
main = defaultMain
|
61
src/Data/RomanNum.hs
Normal file
61
src/Data/RomanNum.hs
Normal file
|
@ -0,0 +1,61 @@
|
||||||
|
module Data.RomanNum (
|
||||||
|
RomanNum(..)
|
||||||
|
, nullus
|
||||||
|
, plus
|
||||||
|
, r
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Map (Map, (!))
|
||||||
|
import qualified Data.Map as Map (fromList)
|
||||||
|
|
||||||
|
newtype RomanNum = RomanNum Int
|
||||||
|
|
||||||
|
data RomanChar = I | V | X | L | C | D | M deriving (Bounded, Eq, Ord, Enum, Show, Read)
|
||||||
|
|
||||||
|
romanChars :: [RomanChar]
|
||||||
|
romanChars = [minBound .. maxBound]
|
||||||
|
|
||||||
|
base :: [(Int, [Char])]
|
||||||
|
base = base' 1 [] . concat $ show <$> romanChars where
|
||||||
|
base' _ l "" = l
|
||||||
|
base' size l chars =
|
||||||
|
base' (size * 10) ((size, take 3 chars):l) (drop 2 chars)
|
||||||
|
|
||||||
|
values :: Map RomanChar Int
|
||||||
|
values = Map.fromList $
|
||||||
|
zip romanChars (concat $ iterate (fmap (*10)) [1, 5])
|
||||||
|
|
||||||
|
instance Show RomanNum where
|
||||||
|
show (RomanNum 0) = "nullus"
|
||||||
|
show (RomanNum n) = show' n base where
|
||||||
|
show' 0 _ = ""
|
||||||
|
show' _ [] = error "Numeral system not fine-grained enough"
|
||||||
|
show' k ((size, digits):others)
|
||||||
|
| k < size = show' k others
|
||||||
|
| otherwise =
|
||||||
|
let decDigit = k `div` size in
|
||||||
|
showDecDigit decDigit digits ++ show' (k `mod` size) others
|
||||||
|
showDecDigit _ [] = error "no digits for conversion"
|
||||||
|
showDecDigit k [digit] = k `times` digit
|
||||||
|
showDecDigit k digits
|
||||||
|
| k == 4 || (k == 9 && length digits > 2) =
|
||||||
|
(head digits) : [head (drop (if k > 5 then 2 else 1) digits)]
|
||||||
|
| k > 4 = head (drop 1 digits) : (showDecDigit (k-5) digits)
|
||||||
|
| otherwise = k `times` (head digits)
|
||||||
|
times count letter = take count $ repeat letter
|
||||||
|
|
||||||
|
r :: String -> RomanNum
|
||||||
|
r "" = nullus
|
||||||
|
r "nullus" = nullus
|
||||||
|
r n@[_] = RomanNum (values ! (read n))
|
||||||
|
r (digit:nextDigit:otherDigits) =
|
||||||
|
let (rChar, nextRChar) = (read [digit], read [nextDigit]) in
|
||||||
|
if rChar < nextRChar
|
||||||
|
then RomanNum (values ! nextRChar - values ! rChar) `plus` r otherDigits
|
||||||
|
else RomanNum (values ! rChar) `plus` r(nextDigit:otherDigits)
|
||||||
|
|
||||||
|
nullus :: RomanNum
|
||||||
|
nullus = RomanNum 0
|
||||||
|
|
||||||
|
plus :: RomanNum -> RomanNum -> RomanNum
|
||||||
|
plus (RomanNum a) (RomanNum b) = RomanNum (a + b)
|
Loading…
Reference in a new issue