-- Roman.hs

{- |
Module      :  $Header$
Description :  Roman Numerals
Copyright   :  (c) Alexander Hakki
License     :  BSD3

Maintainer  :  ahk@ahakki.xyz
Stability   :  experimental
Portability :  portable
-}

{-# 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) )

-- Type class Roman

{- |
A type class for all types that can represent roman numerals
-}
class Roman r where
    {- |
    The Class Roman implements a single Method, fromRoman, to convert to an
    Integral Type
    -}
    fromRoman :: Integral b => r -> b


-- Roman Symbols

{- |
RomanSymbols from I to M

Zero is represented as N for the latin word Nulla
-}
data RomanSymbol
    = Nulla     --Nulla is depreciated and now we use N

    | N         --Here it is!

    | 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 =       --Nulla is depreciated

        b
0
    fromRoman RomanSymbol
N =           --Now we use 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


{- |
Read is case insensitive
-}
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" ->                      --we still read NULLA correctly as N

            [(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"

{- |
Roman Numerals are represented as Lists of RomanSymbols
-}
type RomanNumeral =
    [RomanSymbol]

{- |
fromRoman on a RomanNumeral also returns the expected result, if the Roman
Number is not stricly "correct", such as XIIX -> 18.
-}
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]]

{- |
Be aware that, Roman Numerals can never be negative.
-}
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?"


{-|
Overlaps instance Read [a] with a specific version,
so that "xxi" -> [X, X, I]
-}
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