module Data.Roman
( Roman (..)
, RomanSymbol (..)
, RomanNumeral
) where
import Data.Char
import Data.List.Split
import Control.Exception
class Roman r where
fromRoman :: Integral b => r -> b
data RomanSymbol
= Nulla
| I
| V
| X
| L
| C
| D
| M
deriving
( Eq
, Ord
, Show
, Enum
)
instance Roman RomanSymbol where
fromRoman Nulla =
0
fromRoman I =
1
fromRoman V =
5
fromRoman X =
10
fromRoman L =
50
fromRoman C =
100
fromRoman D =
500
fromRoman M =
1000
instance Read RomanSymbol where
readsPrec _ (a : []) =
case toUpper a of
'N' ->
[(Nulla, [])]
'I' ->
[(I, [])]
'V' ->
[(V, [])]
'X' ->
[(X, [])]
'L' ->
[(L, [])]
'C' ->
[(C, [])]
'D' ->
[(D, [])]
'M' ->
[(M, [])]
_ ->
error "Data.Roman: Parse Error"
readsPrec _ (x:xs) =
case fmap toUpper (x:xs) of
"NULLA" ->
[(Nulla, [])]
_ ->
error "Data.Roman: Parse Error"
readsPrec _ _ =
error "Data.Roman: Parse Error"
type RomanNumeral =
[RomanSymbol]
instance Roman RomanNumeral where
fromRoman =
sum . negateSubs . fromSplit . splitRn
where
negateSubs :: (Num a, Ord a) => [a] -> [a]
negateSubs (x:y:ys)
| x >= y =
x : negateSubs (y : ys)
| x < y =
[negate x, y] ++ negateSubs ys
negateSubs [x] =
[x]
negateSubs _ =
[]
fromSplit =
fmap (sum . fmap fromRoman)
splitRn rn =
splitRn' (tail splitters) (head splitters rn)
where
splitRn' [] r =
r
splitRn' sptr r =
splitRn' (tail sptr) ( head sptr =<< r)
splitters =
fmap (split . opts) delims
opts =
dropBlanks . condense
delims =
fmap oneOf [[I],[V],[X],[L],[C],[D],[L]]
instance Num RomanNumeral where
(+) a b =
fromInteger $ fromRoman a + fromRoman b
() a b
| a >= b =
fromInteger $ fromRoman a fromRoman b
| otherwise =
throw ( Underflow :: ArithException )
(*) a b =
fromInteger $ fromRoman a * fromRoman b
negate = throw ( Underflow :: ArithException )
abs = id
signum _ = 1
fromInteger 0 =
[Nulla]
fromInteger r =
fromInteger' r
where
fromInteger' a
| a >= 1000 =
M : fromInteger' (a 1000)
| a >= 900 =
C : M : fromInteger' (a 900)
| a >= 500 =
D : fromInteger' (a 500)
| a >= 400 =
C : D : fromInteger' (a 400)
| a >= 100 =
C : fromInteger' (a 100)
| a >= 90 =
X : C : fromInteger' (a 90)
| a >= 50 =
L : fromInteger' (a 50)
| a >= 40 =
X : L : fromInteger' (a 40)
| a >= 10 =
X : fromInteger' (a 10)
| a >= 9 =
I : X : fromInteger' (a 9)
| a >= 5 =
V : fromInteger' (a 5)
| a == 4 =
I : V : fromInteger' (a 4)
| a >= 1 =
I : fromInteger' (a 1)
| a == 0 =
[]
| a < 0 =
fromInteger' (negate a)
| otherwise =
error "Data.Roman: why?"
instance Read RomanNumeral where
readsPrec _ a
| fmap toUpper a == "NULLA" =
[([Nulla], [])]
| otherwise =
[(parseRoman a, [])]
where
parseRoman :: String -> RomanNumeral
parseRoman (x:xs) =
(read [x] :: RomanSymbol) : (parseRoman xs)
parseRoman [] =
[]
instance Show RomanNumeral where
show (x:xs) =
show x ++ show xs
show [] =
[]
instance Ord RomanNumeral where
compare x y=
compare (toInteger x) (toInteger y)
(<=) x y=
(<=) (toInteger x) (toInteger y)
instance Real RomanNumeral where
toRational a =
toRational (fromRoman a :: Integer)
instance Integral RomanNumeral where
quotRem x y =
tupleConv $ quotRem (fromRoman x :: Integer) (fromRoman y :: Integer)
where
tupleConv :: Integral a => (a, a) ->(RomanNumeral, RomanNumeral)
tupleConv (m, n) =
(fromIntegral m, fromIntegral n)
toInteger =
fromRoman
instance Enum RomanNumeral where
toEnum =
fromIntegral
fromEnum =
fromIntegral