{-# LANGUAGE FlexibleInstances #-}
module Data.Roman
( Roman (..)
, RomanSymbol (..)
, RomanNumeral
) where
import Data.Char ( toUpper )
import Data.List.Split ( condense, dropBlanks, oneOf, split )
import Control.Exception ( throw, ArithException(Underflow) )
class Roman r where
fromRoman :: Integral b => r -> b
data RomanSymbol
= Nulla
| N
| I
| V
| X
| L
| C
| D
| M
deriving
( RomanSymbol -> RomanSymbol -> Bool
(RomanSymbol -> RomanSymbol -> Bool)
-> (RomanSymbol -> RomanSymbol -> Bool) -> Eq RomanSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RomanSymbol -> RomanSymbol -> Bool
== :: RomanSymbol -> RomanSymbol -> Bool
$c/= :: RomanSymbol -> RomanSymbol -> Bool
/= :: RomanSymbol -> RomanSymbol -> Bool
Eq
, Eq RomanSymbol
Eq RomanSymbol =>
(RomanSymbol -> RomanSymbol -> Ordering)
-> (RomanSymbol -> RomanSymbol -> Bool)
-> (RomanSymbol -> RomanSymbol -> Bool)
-> (RomanSymbol -> RomanSymbol -> Bool)
-> (RomanSymbol -> RomanSymbol -> Bool)
-> (RomanSymbol -> RomanSymbol -> RomanSymbol)
-> (RomanSymbol -> RomanSymbol -> RomanSymbol)
-> Ord RomanSymbol
RomanSymbol -> RomanSymbol -> Bool
RomanSymbol -> RomanSymbol -> Ordering
RomanSymbol -> RomanSymbol -> RomanSymbol
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RomanSymbol -> RomanSymbol -> Ordering
compare :: RomanSymbol -> RomanSymbol -> Ordering
$c< :: RomanSymbol -> RomanSymbol -> Bool
< :: RomanSymbol -> RomanSymbol -> Bool
$c<= :: RomanSymbol -> RomanSymbol -> Bool
<= :: RomanSymbol -> RomanSymbol -> Bool
$c> :: RomanSymbol -> RomanSymbol -> Bool
> :: RomanSymbol -> RomanSymbol -> Bool
$c>= :: RomanSymbol -> RomanSymbol -> Bool
>= :: RomanSymbol -> RomanSymbol -> Bool
$cmax :: RomanSymbol -> RomanSymbol -> RomanSymbol
max :: RomanSymbol -> RomanSymbol -> RomanSymbol
$cmin :: RomanSymbol -> RomanSymbol -> RomanSymbol
min :: RomanSymbol -> RomanSymbol -> RomanSymbol
Ord
, Int -> RomanSymbol -> ShowS
[RomanSymbol] -> ShowS
RomanSymbol -> String
(Int -> RomanSymbol -> ShowS)
-> (RomanSymbol -> String)
-> ([RomanSymbol] -> ShowS)
-> Show RomanSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RomanSymbol -> ShowS
showsPrec :: Int -> RomanSymbol -> ShowS
$cshow :: RomanSymbol -> String
show :: RomanSymbol -> String
$cshowList :: [RomanSymbol] -> ShowS
showList :: [RomanSymbol] -> ShowS
Show
, Int -> RomanSymbol
RomanSymbol -> Int
RomanSymbol -> [RomanSymbol]
RomanSymbol -> RomanSymbol
RomanSymbol -> RomanSymbol -> [RomanSymbol]
RomanSymbol -> RomanSymbol -> RomanSymbol -> [RomanSymbol]
(RomanSymbol -> RomanSymbol)
-> (RomanSymbol -> RomanSymbol)
-> (Int -> RomanSymbol)
-> (RomanSymbol -> Int)
-> (RomanSymbol -> [RomanSymbol])
-> (RomanSymbol -> RomanSymbol -> [RomanSymbol])
-> (RomanSymbol -> RomanSymbol -> [RomanSymbol])
-> (RomanSymbol -> RomanSymbol -> RomanSymbol -> [RomanSymbol])
-> Enum RomanSymbol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RomanSymbol -> RomanSymbol
succ :: RomanSymbol -> RomanSymbol
$cpred :: RomanSymbol -> RomanSymbol
pred :: RomanSymbol -> RomanSymbol
$ctoEnum :: Int -> RomanSymbol
toEnum :: Int -> RomanSymbol
$cfromEnum :: RomanSymbol -> Int
fromEnum :: RomanSymbol -> Int
$cenumFrom :: RomanSymbol -> [RomanSymbol]
enumFrom :: RomanSymbol -> [RomanSymbol]
$cenumFromThen :: RomanSymbol -> RomanSymbol -> [RomanSymbol]
enumFromThen :: RomanSymbol -> RomanSymbol -> [RomanSymbol]
$cenumFromTo :: RomanSymbol -> RomanSymbol -> [RomanSymbol]
enumFromTo :: RomanSymbol -> RomanSymbol -> [RomanSymbol]
$cenumFromThenTo :: RomanSymbol -> RomanSymbol -> RomanSymbol -> [RomanSymbol]
enumFromThenTo :: RomanSymbol -> RomanSymbol -> RomanSymbol -> [RomanSymbol]
Enum
)
instance Roman RomanSymbol where
fromRoman :: forall b. Integral b => RomanSymbol -> b
fromRoman RomanSymbol
Nulla =
b
0
fromRoman RomanSymbol
N =
b
0
fromRoman RomanSymbol
I =
b
1
fromRoman RomanSymbol
V =
b
5
fromRoman RomanSymbol
X =
b
10
fromRoman RomanSymbol
L =
b
50
fromRoman RomanSymbol
C =
b
100
fromRoman RomanSymbol
D =
b
500
fromRoman RomanSymbol
M =
b
1000
instance Read RomanSymbol where
readsPrec :: Int -> ReadS RomanSymbol
readsPrec Int
_ (Char
a : []) =
case Char -> Char
toUpper Char
a of
Char
'N' ->
[(RomanSymbol
N, [])]
Char
'I' ->
[(RomanSymbol
I, [])]
Char
'V' ->
[(RomanSymbol
V, [])]
Char
'X' ->
[(RomanSymbol
X, [])]
Char
'L' ->
[(RomanSymbol
L, [])]
Char
'C' ->
[(RomanSymbol
C, [])]
Char
'D' ->
[(RomanSymbol
D, [])]
Char
'M' ->
[(RomanSymbol
M, [])]
Char
_ ->
ReadS RomanSymbol
forall a. HasCallStack => String -> a
error String
"Data.Roman: Parse Error"
readsPrec Int
_ (Char
x:String
xs) =
case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) of
String
"NULLA" ->
[(RomanSymbol
N, [])]
String
_ ->
ReadS RomanSymbol
forall a. HasCallStack => String -> a
error String
"Data.Roman: Parse Error"
readsPrec Int
_ String
_ =
ReadS RomanSymbol
forall a. HasCallStack => String -> a
error String
"Data.Roman: Parse Error"
type RomanNumeral =
[RomanSymbol]
instance Roman RomanNumeral where
fromRoman :: forall b. Integral b => [RomanSymbol] -> b
fromRoman =
[b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([b] -> b) -> ([RomanSymbol] -> [b]) -> [RomanSymbol] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [b]
forall a. (Num a, Ord a) => [a] -> [a]
negateSubs ([b] -> [b]) -> ([RomanSymbol] -> [b]) -> [RomanSymbol] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[RomanSymbol]] -> [b]
fromSplit ([[RomanSymbol]] -> [b])
-> ([RomanSymbol] -> [[RomanSymbol]]) -> [RomanSymbol] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RomanSymbol] -> [[RomanSymbol]]
splitRn
where
negateSubs :: (Num a, Ord a) => [a] -> [a]
negateSubs :: forall a. (Num a, Ord a) => [a] -> [a]
negateSubs (a
x:a
y:[a]
ys)
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y =
a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. (Num a, Ord a) => [a] -> [a]
negateSubs (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y =
[a -> a
forall a. Num a => a -> a
negate a
x, a
y] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. (Num a, Ord a) => [a] -> [a]
negateSubs [a]
ys
negateSubs [a
x] =
[a
x]
negateSubs [a]
_ =
[]
fromSplit :: [[RomanSymbol]] -> [b]
fromSplit =
([RomanSymbol] -> b) -> [[RomanSymbol]] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([b] -> b) -> ([RomanSymbol] -> [b]) -> [RomanSymbol] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RomanSymbol -> b) -> [RomanSymbol] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RomanSymbol -> b
forall b. Integral b => RomanSymbol -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman)
splitRn :: [RomanSymbol] -> [[RomanSymbol]]
splitRn [RomanSymbol]
rn =
[[RomanSymbol] -> [[RomanSymbol]]]
-> [[RomanSymbol]] -> [[RomanSymbol]]
forall {m :: * -> *} {b}. Monad m => [b -> m b] -> m b -> m b
splitRn' ([[RomanSymbol] -> [[RomanSymbol]]]
-> [[RomanSymbol] -> [[RomanSymbol]]]
forall a. HasCallStack => [a] -> [a]
tail [[RomanSymbol] -> [[RomanSymbol]]]
splitters) ([[RomanSymbol] -> [[RomanSymbol]]]
-> [RomanSymbol] -> [[RomanSymbol]]
forall a. HasCallStack => [a] -> a
head [[RomanSymbol] -> [[RomanSymbol]]]
splitters [RomanSymbol]
rn)
where
splitRn' :: [b -> m b] -> m b -> m b
splitRn' [] m b
r =
m b
r
splitRn' [b -> m b]
sptr m b
r =
[b -> m b] -> m b -> m b
splitRn' ([b -> m b] -> [b -> m b]
forall a. HasCallStack => [a] -> [a]
tail [b -> m b]
sptr) ( [b -> m b] -> b -> m b
forall a. HasCallStack => [a] -> a
head [b -> m b]
sptr (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b
r)
splitters :: [[RomanSymbol] -> [[RomanSymbol]]]
splitters =
(Splitter RomanSymbol -> [RomanSymbol] -> [[RomanSymbol]])
-> [Splitter RomanSymbol] -> [[RomanSymbol] -> [[RomanSymbol]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Splitter RomanSymbol -> [RomanSymbol] -> [[RomanSymbol]]
forall a. Splitter a -> [a] -> [[a]]
split (Splitter RomanSymbol -> [RomanSymbol] -> [[RomanSymbol]])
-> (Splitter RomanSymbol -> Splitter RomanSymbol)
-> Splitter RomanSymbol
-> [RomanSymbol]
-> [[RomanSymbol]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter RomanSymbol -> Splitter RomanSymbol
forall {a}. Splitter a -> Splitter a
opts) [Splitter RomanSymbol]
delims
opts :: Splitter a -> Splitter a
opts =
Splitter a -> Splitter a
forall {a}. Splitter a -> Splitter a
dropBlanks (Splitter a -> Splitter a)
-> (Splitter a -> Splitter a) -> Splitter a -> Splitter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter a -> Splitter a
forall {a}. Splitter a -> Splitter a
condense
delims :: [Splitter RomanSymbol]
delims =
([RomanSymbol] -> Splitter RomanSymbol)
-> [[RomanSymbol]] -> [Splitter RomanSymbol]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RomanSymbol] -> Splitter RomanSymbol
forall a. Eq a => [a] -> Splitter a
oneOf [[RomanSymbol
I],[RomanSymbol
V],[RomanSymbol
X],[RomanSymbol
L],[RomanSymbol
C],[RomanSymbol
D],[RomanSymbol
L]]
instance Num RomanNumeral where
+ :: [RomanSymbol] -> [RomanSymbol] -> [RomanSymbol]
(+) [RomanSymbol]
a [RomanSymbol]
b =
Integer -> [RomanSymbol]
forall a. Num a => Integer -> a
fromInteger (Integer -> [RomanSymbol]) -> Integer -> [RomanSymbol]
forall a b. (a -> b) -> a -> b
$ [RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ [RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
b
(-) [RomanSymbol]
a [RomanSymbol]
b
| [RomanSymbol]
a [RomanSymbol] -> [RomanSymbol] -> Bool
forall a. Ord a => a -> a -> Bool
>= [RomanSymbol]
b =
Integer -> [RomanSymbol]
forall a. Num a => Integer -> a
fromInteger (Integer -> [RomanSymbol]) -> Integer -> [RomanSymbol]
forall a b. (a -> b) -> a -> b
$ [RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- [RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
b
| Bool
otherwise =
ArithException -> [RomanSymbol]
forall a e. Exception e => e -> a
throw ( ArithException
Underflow :: ArithException )
* :: [RomanSymbol] -> [RomanSymbol] -> [RomanSymbol]
(*) [RomanSymbol]
a [RomanSymbol]
b =
Integer -> [RomanSymbol]
forall a. Num a => Integer -> a
fromInteger (Integer -> [RomanSymbol]) -> Integer -> [RomanSymbol]
forall a b. (a -> b) -> a -> b
$ [RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* [RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
b
negate :: [RomanSymbol] -> [RomanSymbol]
negate = ArithException -> [RomanSymbol] -> [RomanSymbol]
forall a e. Exception e => e -> a
throw ( ArithException
Underflow :: ArithException )
abs :: [RomanSymbol] -> [RomanSymbol]
abs = [RomanSymbol] -> [RomanSymbol]
forall a. a -> a
id
signum :: [RomanSymbol] -> [RomanSymbol]
signum [RomanSymbol]
_ = [RomanSymbol]
1
fromInteger :: Integer -> [RomanSymbol]
fromInteger Integer
0 =
[RomanSymbol
N]
fromInteger Integer
r =
Integer -> [RomanSymbol]
forall {a}. (Ord a, Num a) => a -> [RomanSymbol]
fromInteger' Integer
r
where
fromInteger' :: a -> [RomanSymbol]
fromInteger' a
a
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1000 =
RomanSymbol
M RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
1000)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
900 =
RomanSymbol
C RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: RomanSymbol
M RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
900)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
500 =
RomanSymbol
D RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
500)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
400 =
RomanSymbol
C RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: RomanSymbol
D RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
400)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100 =
RomanSymbol
C RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
100)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
90 =
RomanSymbol
X RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: RomanSymbol
C RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
90)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
50 =
RomanSymbol
L RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
50)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
40 =
RomanSymbol
X RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: RomanSymbol
L RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
40)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10 =
RomanSymbol
X RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
10)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
9 =
RomanSymbol
I RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: RomanSymbol
X RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
9)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
5 =
RomanSymbol
V RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
5)
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
4 =
RomanSymbol
I RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: RomanSymbol
V RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
4)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1 =
RomanSymbol
I RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: a -> [RomanSymbol]
fromInteger' (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 =
[]
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 =
a -> [RomanSymbol]
fromInteger' (a -> a
forall a. Num a => a -> a
negate a
a)
| Bool
otherwise =
String -> [RomanSymbol]
forall a. HasCallStack => String -> a
error String
"Data.Roman: why?"
instance {-# OVERLAPPING #-} Read RomanNumeral where
readsPrec :: Int -> ReadS [RomanSymbol]
readsPrec Int
_ String
a
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"NULLA" =
[([RomanSymbol
N], [])]
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"N" =
[([RomanSymbol
N], [])]
| Bool
otherwise =
[(String -> [RomanSymbol]
parseRoman String
a, [])]
where
parseRoman :: String -> RomanNumeral
parseRoman :: String -> [RomanSymbol]
parseRoman (Char
x:String
xs) =
(String -> RomanSymbol
forall a. Read a => String -> a
read [Char
x] :: RomanSymbol) RomanSymbol -> [RomanSymbol] -> [RomanSymbol]
forall a. a -> [a] -> [a]
: (String -> [RomanSymbol]
parseRoman String
xs)
parseRoman [] =
[]
instance {-# OVERLAPPING #-} Show RomanNumeral where
show :: [RomanSymbol] -> String
show (RomanSymbol
x:[RomanSymbol]
xs) =
RomanSymbol -> String
forall a. Show a => a -> String
show RomanSymbol
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ [RomanSymbol] -> String
forall a. Show a => a -> String
show [RomanSymbol]
xs
show [] =
[]
instance {-# OVERLAPPING #-} Ord RomanNumeral where
compare :: [RomanSymbol] -> [RomanSymbol] -> Ordering
compare [RomanSymbol]
x [RomanSymbol]
y=
Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([RomanSymbol] -> Integer
forall a. Integral a => a -> Integer
toInteger [RomanSymbol]
x) ([RomanSymbol] -> Integer
forall a. Integral a => a -> Integer
toInteger [RomanSymbol]
y)
<= :: [RomanSymbol] -> [RomanSymbol] -> Bool
(<=) [RomanSymbol]
x [RomanSymbol]
y=
Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ([RomanSymbol] -> Integer
forall a. Integral a => a -> Integer
toInteger [RomanSymbol]
x) ([RomanSymbol] -> Integer
forall a. Integral a => a -> Integer
toInteger [RomanSymbol]
y)
instance Real RomanNumeral where
toRational :: [RomanSymbol] -> Rational
toRational [RomanSymbol]
a =
Integer -> Rational
forall a. Real a => a -> Rational
toRational ([RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
a :: Integer)
instance Integral RomanNumeral where
quotRem :: [RomanSymbol] -> [RomanSymbol] -> ([RomanSymbol], [RomanSymbol])
quotRem [RomanSymbol]
x [RomanSymbol]
y =
(Integer, Integer) -> ([RomanSymbol], [RomanSymbol])
forall a. Integral a => (a, a) -> ([RomanSymbol], [RomanSymbol])
tupleConv ((Integer, Integer) -> ([RomanSymbol], [RomanSymbol]))
-> (Integer, Integer) -> ([RomanSymbol], [RomanSymbol])
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem ([RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
x :: Integer) ([RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman [RomanSymbol]
y :: Integer)
where
tupleConv :: Integral a => (a, a) ->(RomanNumeral, RomanNumeral)
tupleConv :: forall a. Integral a => (a, a) -> ([RomanSymbol], [RomanSymbol])
tupleConv (a
m, a
n) =
(a -> [RomanSymbol]
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
m, a -> [RomanSymbol]
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
toInteger :: [RomanSymbol] -> Integer
toInteger =
[RomanSymbol] -> Integer
forall b. Integral b => [RomanSymbol] -> b
forall r b. (Roman r, Integral b) => r -> b
fromRoman
instance Enum RomanNumeral where
toEnum :: Int -> [RomanSymbol]
toEnum =
Int -> [RomanSymbol]
forall a b. (Integral a, Num b) => a -> b
fromIntegral
fromEnum :: [RomanSymbol] -> Int
fromEnum =
[RomanSymbol] -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral