{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, Safe #-}

{-|
Module      : Data.Char.Number.Roman
Description : A module to print Roman numerals both in upper case and lower case.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

This module aims to convert Roman numerals to a String of unicode characters that
represent the corresponding Roman number.

One can convert numbers to Roman numerals in upper case and lower case, and in 'Additive' and 'Subtractive' style.
-}

module Data.Char.Number.Roman (
    -- * Data types to represent Roman numerals
    RomanLiteral(I, II, III, IV, V, VI, VII, VIII, IX, X, XI, XII, L, C, D, M)
  , RomanStyle(Additive, Subtractive)
    -- * Convert a number to Roman literals
  , toLiterals
  , romanLiteral, romanLiteral'
    -- * Convert a number to text
  , romanNumeral, romanNumeral', romanNumeralCase
  , romanNumber,  romanNumber',  romanNumberCase
  ) where

import Control.DeepSeq(NFData)

import Data.Bits((.|.))
import Data.Char(chr)
import Data.Char.Core(UnicodeCharacter(toUnicodeChar, fromUnicodeChar, fromUnicodeChar'), UnicodeText, LetterCase, Ligate, ligateF, mapFromEnum, mapToEnum, mapToEnumSafe, splitLetterCase)
import Data.Data(Data)
import Data.Default(Default(def))
import Data.Hashable(Hashable)
import Data.Text(Text, cons, empty)

import GHC.Generics(Generic)

import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), arbitraryBoundedEnum)

-- | The style to convert a number to a Roman numeral. The 'UnicodeCharacter'
-- instance maps on the uppercase Roman literals.
data RomanStyle
  = Additive  -- ^ The additive style converts four to ⅠⅠⅠⅠ.
  | Subtractive  -- ^ The subtractive style converts four to ⅠⅤ.
  deriving (RomanStyle
RomanStyle -> RomanStyle -> Bounded RomanStyle
forall a. a -> a -> Bounded a
maxBound :: RomanStyle
$cmaxBound :: RomanStyle
minBound :: RomanStyle
$cminBound :: RomanStyle
Bounded, Typeable RomanStyle
DataType
Constr
Typeable RomanStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RomanStyle -> c RomanStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RomanStyle)
-> (RomanStyle -> Constr)
-> (RomanStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RomanStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RomanStyle))
-> ((forall b. Data b => b -> b) -> RomanStyle -> RomanStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RomanStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RomanStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> RomanStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RomanStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle)
-> Data RomanStyle
RomanStyle -> DataType
RomanStyle -> Constr
(forall b. Data b => b -> b) -> RomanStyle -> RomanStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanStyle -> c RomanStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanStyle
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RomanStyle -> u
forall u. (forall d. Data d => d -> u) -> RomanStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RomanStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RomanStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanStyle -> c RomanStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RomanStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RomanStyle)
$cSubtractive :: Constr
$cAdditive :: Constr
$tRomanStyle :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
gmapMp :: (forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
gmapM :: (forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RomanStyle -> m RomanStyle
gmapQi :: Int -> (forall d. Data d => d -> u) -> RomanStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RomanStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> RomanStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RomanStyle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RomanStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RomanStyle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RomanStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RomanStyle -> r
gmapT :: (forall b. Data b => b -> b) -> RomanStyle -> RomanStyle
$cgmapT :: (forall b. Data b => b -> b) -> RomanStyle -> RomanStyle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RomanStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RomanStyle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RomanStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RomanStyle)
dataTypeOf :: RomanStyle -> DataType
$cdataTypeOf :: RomanStyle -> DataType
toConstr :: RomanStyle -> Constr
$ctoConstr :: RomanStyle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanStyle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanStyle -> c RomanStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanStyle -> c RomanStyle
$cp1Data :: Typeable RomanStyle
Data, Int -> RomanStyle
RomanStyle -> Int
RomanStyle -> [RomanStyle]
RomanStyle -> RomanStyle
RomanStyle -> RomanStyle -> [RomanStyle]
RomanStyle -> RomanStyle -> RomanStyle -> [RomanStyle]
(RomanStyle -> RomanStyle)
-> (RomanStyle -> RomanStyle)
-> (Int -> RomanStyle)
-> (RomanStyle -> Int)
-> (RomanStyle -> [RomanStyle])
-> (RomanStyle -> RomanStyle -> [RomanStyle])
-> (RomanStyle -> RomanStyle -> [RomanStyle])
-> (RomanStyle -> RomanStyle -> RomanStyle -> [RomanStyle])
-> Enum RomanStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RomanStyle -> RomanStyle -> RomanStyle -> [RomanStyle]
$cenumFromThenTo :: RomanStyle -> RomanStyle -> RomanStyle -> [RomanStyle]
enumFromTo :: RomanStyle -> RomanStyle -> [RomanStyle]
$cenumFromTo :: RomanStyle -> RomanStyle -> [RomanStyle]
enumFromThen :: RomanStyle -> RomanStyle -> [RomanStyle]
$cenumFromThen :: RomanStyle -> RomanStyle -> [RomanStyle]
enumFrom :: RomanStyle -> [RomanStyle]
$cenumFrom :: RomanStyle -> [RomanStyle]
fromEnum :: RomanStyle -> Int
$cfromEnum :: RomanStyle -> Int
toEnum :: Int -> RomanStyle
$ctoEnum :: Int -> RomanStyle
pred :: RomanStyle -> RomanStyle
$cpred :: RomanStyle -> RomanStyle
succ :: RomanStyle -> RomanStyle
$csucc :: RomanStyle -> RomanStyle
Enum, RomanStyle -> RomanStyle -> Bool
(RomanStyle -> RomanStyle -> Bool)
-> (RomanStyle -> RomanStyle -> Bool) -> Eq RomanStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RomanStyle -> RomanStyle -> Bool
$c/= :: RomanStyle -> RomanStyle -> Bool
== :: RomanStyle -> RomanStyle -> Bool
$c== :: RomanStyle -> RomanStyle -> Bool
Eq, (forall x. RomanStyle -> Rep RomanStyle x)
-> (forall x. Rep RomanStyle x -> RomanStyle) -> Generic RomanStyle
forall x. Rep RomanStyle x -> RomanStyle
forall x. RomanStyle -> Rep RomanStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RomanStyle x -> RomanStyle
$cfrom :: forall x. RomanStyle -> Rep RomanStyle x
Generic, Eq RomanStyle
Eq RomanStyle
-> (RomanStyle -> RomanStyle -> Ordering)
-> (RomanStyle -> RomanStyle -> Bool)
-> (RomanStyle -> RomanStyle -> Bool)
-> (RomanStyle -> RomanStyle -> Bool)
-> (RomanStyle -> RomanStyle -> Bool)
-> (RomanStyle -> RomanStyle -> RomanStyle)
-> (RomanStyle -> RomanStyle -> RomanStyle)
-> Ord RomanStyle
RomanStyle -> RomanStyle -> Bool
RomanStyle -> RomanStyle -> Ordering
RomanStyle -> RomanStyle -> RomanStyle
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
min :: RomanStyle -> RomanStyle -> RomanStyle
$cmin :: RomanStyle -> RomanStyle -> RomanStyle
max :: RomanStyle -> RomanStyle -> RomanStyle
$cmax :: RomanStyle -> RomanStyle -> RomanStyle
>= :: RomanStyle -> RomanStyle -> Bool
$c>= :: RomanStyle -> RomanStyle -> Bool
> :: RomanStyle -> RomanStyle -> Bool
$c> :: RomanStyle -> RomanStyle -> Bool
<= :: RomanStyle -> RomanStyle -> Bool
$c<= :: RomanStyle -> RomanStyle -> Bool
< :: RomanStyle -> RomanStyle -> Bool
$c< :: RomanStyle -> RomanStyle -> Bool
compare :: RomanStyle -> RomanStyle -> Ordering
$ccompare :: RomanStyle -> RomanStyle -> Ordering
$cp1Ord :: Eq RomanStyle
Ord, ReadPrec [RomanStyle]
ReadPrec RomanStyle
Int -> ReadS RomanStyle
ReadS [RomanStyle]
(Int -> ReadS RomanStyle)
-> ReadS [RomanStyle]
-> ReadPrec RomanStyle
-> ReadPrec [RomanStyle]
-> Read RomanStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RomanStyle]
$creadListPrec :: ReadPrec [RomanStyle]
readPrec :: ReadPrec RomanStyle
$creadPrec :: ReadPrec RomanStyle
readList :: ReadS [RomanStyle]
$creadList :: ReadS [RomanStyle]
readsPrec :: Int -> ReadS RomanStyle
$creadsPrec :: Int -> ReadS RomanStyle
Read, Int -> RomanStyle -> ShowS
[RomanStyle] -> ShowS
RomanStyle -> String
(Int -> RomanStyle -> ShowS)
-> (RomanStyle -> String)
-> ([RomanStyle] -> ShowS)
-> Show RomanStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RomanStyle] -> ShowS
$cshowList :: [RomanStyle] -> ShowS
show :: RomanStyle -> String
$cshow :: RomanStyle -> String
showsPrec :: Int -> RomanStyle -> ShowS
$cshowsPrec :: Int -> RomanStyle -> ShowS
Show)

instance Arbitrary RomanStyle where
    arbitrary :: Gen RomanStyle
arbitrary = Gen RomanStyle
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary RomanLiteral where
    arbitrary :: Gen RomanLiteral
arbitrary = Gen RomanLiteral
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Default RomanStyle where
    def :: RomanStyle
def = RomanStyle
Subtractive

instance Hashable RomanStyle

instance NFData RomanStyle

instance UnicodeCharacter RomanLiteral where
    toUnicodeChar :: RomanLiteral -> Char
toUnicodeChar = Int -> RomanLiteral -> Char
forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_romanUppercaseOffset
    fromUnicodeChar :: Char -> Maybe RomanLiteral
fromUnicodeChar = Int -> Char -> Maybe RomanLiteral
forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_romanUppercaseOffset
    fromUnicodeChar' :: Char -> RomanLiteral
fromUnicodeChar' = Int -> Char -> RomanLiteral
forall a. Enum a => Int -> Char -> a
mapToEnum Int
_romanUppercaseOffset

instance UnicodeText RomanLiteral

-- | Roman numerals for which a unicode character exists.
data RomanLiteral
  = I  -- ^ The unicode character for the Roman numeral /one/: Ⅰ.
  | II  -- ^ The unicode character for the Roman numeral /two/: Ⅱ.
  | III  -- ^ The unicode character for the Roman numeral /three/: Ⅲ.
  | IV  -- ^ The unicode character for the Roman numeral /four/: Ⅳ.
  | V  -- ^ The unicode character for the Roman numeral /five/: Ⅴ.
  | VI  -- ^ The unicode character for the Roman numeral /six/: Ⅵ.
  | VII  -- ^ The unicode character for the Roman numeral /seven/: Ⅶ.
  | VIII  -- ^ The unicode character for the Roman numeral /eight/: Ⅷ.
  | IX  -- ^ The unicode character for the Roman numeral /nine/: Ⅸ.
  | X  -- ^ The unicode character for the Roman numeral /ten/: Ⅹ.
  | XI  -- ^ The unicode character for the Roman numeral /eleven/: Ⅺ.
  | XII  -- ^ The unicode character for the Roman numeral /twelve/: Ⅻ.
  | L  -- ^ The unicode character for the Roman numeral /fifty/: Ⅼ.
  | C  -- ^ The unicode character for the Roman numeral /hundred/: Ⅽ.
  | D  -- ^ The unicode character for the Roman numeral /five hundred/: Ⅾ.
  | M  -- ^ The unicode character for the Roman numeral /thousand/: Ⅿ.
  deriving (RomanLiteral
RomanLiteral -> RomanLiteral -> Bounded RomanLiteral
forall a. a -> a -> Bounded a
maxBound :: RomanLiteral
$cmaxBound :: RomanLiteral
minBound :: RomanLiteral
$cminBound :: RomanLiteral
Bounded, Typeable RomanLiteral
DataType
Constr
Typeable RomanLiteral
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RomanLiteral -> c RomanLiteral)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RomanLiteral)
-> (RomanLiteral -> Constr)
-> (RomanLiteral -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RomanLiteral))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RomanLiteral))
-> ((forall b. Data b => b -> b) -> RomanLiteral -> RomanLiteral)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r)
-> (forall u. (forall d. Data d => d -> u) -> RomanLiteral -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RomanLiteral -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral)
-> Data RomanLiteral
RomanLiteral -> DataType
RomanLiteral -> Constr
(forall b. Data b => b -> b) -> RomanLiteral -> RomanLiteral
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanLiteral -> c RomanLiteral
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanLiteral
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RomanLiteral -> u
forall u. (forall d. Data d => d -> u) -> RomanLiteral -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanLiteral
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanLiteral -> c RomanLiteral
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RomanLiteral)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RomanLiteral)
$cM :: Constr
$cD :: Constr
$cC :: Constr
$cL :: Constr
$cXII :: Constr
$cXI :: Constr
$cX :: Constr
$cIX :: Constr
$cVIII :: Constr
$cVII :: Constr
$cVI :: Constr
$cV :: Constr
$cIV :: Constr
$cIII :: Constr
$cII :: Constr
$cI :: Constr
$tRomanLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
gmapMp :: (forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
gmapM :: (forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RomanLiteral -> m RomanLiteral
gmapQi :: Int -> (forall d. Data d => d -> u) -> RomanLiteral -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RomanLiteral -> u
gmapQ :: (forall d. Data d => d -> u) -> RomanLiteral -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RomanLiteral -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RomanLiteral -> r
gmapT :: (forall b. Data b => b -> b) -> RomanLiteral -> RomanLiteral
$cgmapT :: (forall b. Data b => b -> b) -> RomanLiteral -> RomanLiteral
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RomanLiteral)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RomanLiteral)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RomanLiteral)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RomanLiteral)
dataTypeOf :: RomanLiteral -> DataType
$cdataTypeOf :: RomanLiteral -> DataType
toConstr :: RomanLiteral -> Constr
$ctoConstr :: RomanLiteral -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanLiteral
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RomanLiteral
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanLiteral -> c RomanLiteral
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RomanLiteral -> c RomanLiteral
$cp1Data :: Typeable RomanLiteral
Data, Int -> RomanLiteral
RomanLiteral -> Int
RomanLiteral -> [RomanLiteral]
RomanLiteral -> RomanLiteral
RomanLiteral -> RomanLiteral -> [RomanLiteral]
RomanLiteral -> RomanLiteral -> RomanLiteral -> [RomanLiteral]
(RomanLiteral -> RomanLiteral)
-> (RomanLiteral -> RomanLiteral)
-> (Int -> RomanLiteral)
-> (RomanLiteral -> Int)
-> (RomanLiteral -> [RomanLiteral])
-> (RomanLiteral -> RomanLiteral -> [RomanLiteral])
-> (RomanLiteral -> RomanLiteral -> [RomanLiteral])
-> (RomanLiteral -> RomanLiteral -> RomanLiteral -> [RomanLiteral])
-> Enum RomanLiteral
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RomanLiteral -> RomanLiteral -> RomanLiteral -> [RomanLiteral]
$cenumFromThenTo :: RomanLiteral -> RomanLiteral -> RomanLiteral -> [RomanLiteral]
enumFromTo :: RomanLiteral -> RomanLiteral -> [RomanLiteral]
$cenumFromTo :: RomanLiteral -> RomanLiteral -> [RomanLiteral]
enumFromThen :: RomanLiteral -> RomanLiteral -> [RomanLiteral]
$cenumFromThen :: RomanLiteral -> RomanLiteral -> [RomanLiteral]
enumFrom :: RomanLiteral -> [RomanLiteral]
$cenumFrom :: RomanLiteral -> [RomanLiteral]
fromEnum :: RomanLiteral -> Int
$cfromEnum :: RomanLiteral -> Int
toEnum :: Int -> RomanLiteral
$ctoEnum :: Int -> RomanLiteral
pred :: RomanLiteral -> RomanLiteral
$cpred :: RomanLiteral -> RomanLiteral
succ :: RomanLiteral -> RomanLiteral
$csucc :: RomanLiteral -> RomanLiteral
Enum, RomanLiteral -> RomanLiteral -> Bool
(RomanLiteral -> RomanLiteral -> Bool)
-> (RomanLiteral -> RomanLiteral -> Bool) -> Eq RomanLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RomanLiteral -> RomanLiteral -> Bool
$c/= :: RomanLiteral -> RomanLiteral -> Bool
== :: RomanLiteral -> RomanLiteral -> Bool
$c== :: RomanLiteral -> RomanLiteral -> Bool
Eq, (forall x. RomanLiteral -> Rep RomanLiteral x)
-> (forall x. Rep RomanLiteral x -> RomanLiteral)
-> Generic RomanLiteral
forall x. Rep RomanLiteral x -> RomanLiteral
forall x. RomanLiteral -> Rep RomanLiteral x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RomanLiteral x -> RomanLiteral
$cfrom :: forall x. RomanLiteral -> Rep RomanLiteral x
Generic, Int -> RomanLiteral -> ShowS
[RomanLiteral] -> ShowS
RomanLiteral -> String
(Int -> RomanLiteral -> ShowS)
-> (RomanLiteral -> String)
-> ([RomanLiteral] -> ShowS)
-> Show RomanLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RomanLiteral] -> ShowS
$cshowList :: [RomanLiteral] -> ShowS
show :: RomanLiteral -> String
$cshow :: RomanLiteral -> String
showsPrec :: Int -> RomanLiteral -> ShowS
$cshowsPrec :: Int -> RomanLiteral -> ShowS
Show, ReadPrec [RomanLiteral]
ReadPrec RomanLiteral
Int -> ReadS RomanLiteral
ReadS [RomanLiteral]
(Int -> ReadS RomanLiteral)
-> ReadS [RomanLiteral]
-> ReadPrec RomanLiteral
-> ReadPrec [RomanLiteral]
-> Read RomanLiteral
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RomanLiteral]
$creadListPrec :: ReadPrec [RomanLiteral]
readPrec :: ReadPrec RomanLiteral
$creadPrec :: ReadPrec RomanLiteral
readList :: ReadS [RomanLiteral]
$creadList :: ReadS [RomanLiteral]
readsPrec :: Int -> ReadS RomanLiteral
$creadsPrec :: Int -> ReadS RomanLiteral
Read)

instance Hashable RomanLiteral

instance NFData RomanLiteral

_literals :: Integral i => RomanStyle -> [(i, [RomanLiteral] -> [RomanLiteral])]
_literals :: RomanStyle -> [(i, [RomanLiteral] -> [RomanLiteral])]
_literals RomanStyle
Additive = [
    (i
1000, (RomanLiteral
MRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
500, (RomanLiteral
DRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
100, (RomanLiteral
CRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
50, (RomanLiteral
LRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
10, (RomanLiteral
XRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
5, (RomanLiteral
VRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
1, (RomanLiteral
IRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  ]
_literals RomanStyle
Subtractive = [
    (i
1000, (RomanLiteral
MRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
900, ([RomanLiteral
C,RomanLiteral
M][RomanLiteral] -> [RomanLiteral] -> [RomanLiteral]
forall a. [a] -> [a] -> [a]
++))
  , (i
500, (RomanLiteral
DRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
400, ([RomanLiteral
C,RomanLiteral
D][RomanLiteral] -> [RomanLiteral] -> [RomanLiteral]
forall a. [a] -> [a] -> [a]
++))
  , (i
100, (RomanLiteral
CRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
90, ([RomanLiteral
X,RomanLiteral
C][RomanLiteral] -> [RomanLiteral] -> [RomanLiteral]
forall a. [a] -> [a] -> [a]
++))
  , (i
50, (RomanLiteral
LRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
40, ([RomanLiteral
X,RomanLiteral
L][RomanLiteral] -> [RomanLiteral] -> [RomanLiteral]
forall a. [a] -> [a] -> [a]
++))
  , (i
10, (RomanLiteral
XRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
9, ([RomanLiteral
I,RomanLiteral
X][RomanLiteral] -> [RomanLiteral] -> [RomanLiteral]
forall a. [a] -> [a] -> [a]
++))
  , (i
5, (RomanLiteral
VRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  , (i
4, ([RomanLiteral
I,RomanLiteral
V][RomanLiteral] -> [RomanLiteral] -> [RomanLiteral]
forall a. [a] -> [a] -> [a]
++))
  , (i
1, (RomanLiteral
IRomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:))
  ]

_ligate :: [RomanLiteral] -> [RomanLiteral]
_ligate :: [RomanLiteral] -> [RomanLiteral]
_ligate [] = []
_ligate (RomanLiteral
r:[RomanLiteral]
rs) = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
r [RomanLiteral]
rs
    where go :: RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
x [] = [RomanLiteral
x]
          go RomanLiteral
x (RomanLiteral
y:[RomanLiteral]
ys) = RomanLiteral -> RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
f RomanLiteral
x RomanLiteral
y [RomanLiteral]
ys
          f :: RomanLiteral -> RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
f RomanLiteral
I RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
II
          f RomanLiteral
II RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
skip RomanLiteral
III
          f RomanLiteral
I RomanLiteral
V = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
skip RomanLiteral
IV
          f RomanLiteral
V RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
VI
          f RomanLiteral
VI RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
VII
          f RomanLiteral
VII RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
skip RomanLiteral
VIII
          f RomanLiteral
X RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
XI
          f RomanLiteral
I RomanLiteral
X = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
skip RomanLiteral
IX
          f RomanLiteral
XI RomanLiteral
I = RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
XII
          f RomanLiteral
x RomanLiteral
y = (RomanLiteral
x RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
forall a. a -> [a] -> [a]
:) ([RomanLiteral] -> [RomanLiteral])
-> ([RomanLiteral] -> [RomanLiteral])
-> [RomanLiteral]
-> [RomanLiteral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
go RomanLiteral
y
          skip :: RomanLiteral -> [RomanLiteral] -> [RomanLiteral]
skip = (([RomanLiteral] -> [RomanLiteral])
-> ([RomanLiteral] -> [RomanLiteral])
-> [RomanLiteral]
-> [RomanLiteral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RomanLiteral] -> [RomanLiteral]
_ligate) (([RomanLiteral] -> [RomanLiteral])
 -> [RomanLiteral] -> [RomanLiteral])
-> (RomanLiteral -> [RomanLiteral] -> [RomanLiteral])
-> RomanLiteral
-> [RomanLiteral]
-> [RomanLiteral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)

-- | Convert the given number with the given 'RomanStyle' and 'Ligate' style
-- to a sequence of 'RomanLiteral's, given the number can be represented
-- with Roman numerals (is strictly larger than zero).
toLiterals :: Integral i
  => RomanStyle  -- ^ Specifies if the Numeral is 'Additive' or 'Subtractive' style.
  -> Ligate  -- ^ Specifies if characters like @ⅠⅤ@ are joined to @Ⅳ@.
  -> i  -- ^ The given number to convert.
  -> Maybe [RomanLiteral]  -- ^ A list of 'RomanLiteral's if the given number can be specified
                          -- with Roman numerals, 'Nothing' otherwise.
toLiterals :: RomanStyle -> Ligate -> i -> Maybe [RomanLiteral]
toLiterals RomanStyle
s Ligate
c i
k
    | i
k i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0 = ([RomanLiteral] -> [RomanLiteral])
-> Ligate -> Maybe [RomanLiteral] -> Maybe [RomanLiteral]
forall (f :: * -> *) a.
Functor f =>
(a -> a) -> Ligate -> f a -> f a
ligateF [RomanLiteral] -> [RomanLiteral]
_ligate Ligate
c (i
-> [(i, [RomanLiteral] -> [RomanLiteral])] -> Maybe [RomanLiteral]
forall t a. (Num t, Ord t) => t -> [(t, [a] -> [a])] -> Maybe [a]
go i
k (RomanStyle -> [(i, [RomanLiteral] -> [RomanLiteral])]
forall i.
Integral i =>
RomanStyle -> [(i, [RomanLiteral] -> [RomanLiteral])]
_literals RomanStyle
s))
    | Bool
otherwise = Maybe [RomanLiteral]
forall a. Maybe a
Nothing
    where go :: t -> [(t, [a] -> [a])] -> Maybe [a]
go t
0 [(t, [a] -> [a])]
_ = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
          go t
_ [] = Maybe [a]
forall a. Maybe a
Nothing
          go t
n va :: [(t, [a] -> [a])]
va@((t
m, [a] -> [a]
l):[(t, [a] -> [a])]
vs)
              | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
m = [a] -> [a]
l ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> [(t, [a] -> [a])] -> Maybe [a]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
m) [(t, [a] -> [a])]
va
              | Bool
otherwise = t -> [(t, [a] -> [a])] -> Maybe [a]
go t
n [(t, [a] -> [a])]
vs

_romanUppercaseOffset :: Int
_romanUppercaseOffset :: Int
_romanUppercaseOffset = Int
0x2160

_romanLowercaseOffset :: Int
_romanLowercaseOffset :: Int
_romanLowercaseOffset = Int
0x2170

_romanLiteral :: Int -> RomanLiteral -> Char
_romanLiteral :: Int -> RomanLiteral -> Char
_romanLiteral = (Int -> Char
chr (Int -> Char) -> (RomanLiteral -> Int) -> RomanLiteral -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((RomanLiteral -> Int) -> RomanLiteral -> Char)
-> (Int -> RomanLiteral -> Int) -> Int -> RomanLiteral -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Int) -> (RomanLiteral -> Int) -> RomanLiteral -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RomanLiteral -> Int
forall a. Enum a => a -> Int
fromEnum) ((Int -> Int) -> RomanLiteral -> Int)
-> (Int -> Int -> Int) -> Int -> RomanLiteral -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.)

-- | Convert the given 'RomanLiteral' object to a unicode character in
-- /upper case/.
romanLiteral
  :: RomanLiteral  -- ^ The given 'RomanLiteral' to convert.
  -> Char  -- ^ A unicode character that represents the given 'RomanLiteral'.
romanLiteral :: RomanLiteral -> Char
romanLiteral = Int -> RomanLiteral -> Char
_romanLiteral Int
_romanUppercaseOffset

-- | Convert the given 'RomanLiteral' object to a unicode character in
-- /lower case/.
romanLiteral'
  :: RomanLiteral  -- ^ The given 'RomanLiteral' to convert.
  -> Char  -- ^ A unicode character that represents the given 'RomanLiteral'.
romanLiteral' :: RomanLiteral -> Char
romanLiteral' = Int -> RomanLiteral -> Char
_romanLiteral Int
_romanLowercaseOffset

_romanNumeral :: (RomanLiteral -> Char) -> [RomanLiteral] -> Text
_romanNumeral :: (RomanLiteral -> Char) -> [RomanLiteral] -> Text
_romanNumeral = ((RomanLiteral -> Text -> Text) -> Text -> [RomanLiteral] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
`foldr` Text
empty) ((RomanLiteral -> Text -> Text) -> [RomanLiteral] -> Text)
-> ((RomanLiteral -> Char) -> RomanLiteral -> Text -> Text)
-> (RomanLiteral -> Char)
-> [RomanLiteral]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text -> Text
cons (Char -> Text -> Text)
-> (RomanLiteral -> Char) -> RomanLiteral -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Convert a sequence of 'RomanLiteral' objects to a 'Text' object that
-- contains a sequence of corresponding Unicode characters which are Roman
-- numberals in /upper case/.
romanNumeral
  :: [RomanLiteral]  -- ^ The given list of 'RomanLiteral' objects to convert to a Unicode equivalent.
  -> Text  -- ^ A 'Text' object that contains a sequence of unicode characters that represents the 'RomanLiteral's.
romanNumeral :: [RomanLiteral] -> Text
romanNumeral = (RomanLiteral -> Char) -> [RomanLiteral] -> Text
_romanNumeral RomanLiteral -> Char
romanLiteral


-- | Convert a sequence of 'RomanLiteral' objects to a 'Text' object that
-- contains a sequence of corresponding Unicode characters which are Roman
-- numberals in /lower case/.
romanNumeral'
  :: [RomanLiteral]  -- ^ The given list of 'RomanLiteral' objects to convert to a Unicode equivalent.
  -> Text  -- ^ A 'Text' object that contains a sequence of unicode characters that represents the 'RomanLiteral's.
romanNumeral' :: [RomanLiteral] -> Text
romanNumeral' = (RomanLiteral -> Char) -> [RomanLiteral] -> Text
_romanNumeral RomanLiteral -> Char
romanLiteral'

-- | Convert a sequence of 'RomanLiteral' objects to a 'Text' object that
-- contains a sequence of corresponding Unicode characters which are Roman
-- numberals in /upper case/ or /lower case/ depending on the 'LetterCase' value.
romanNumeralCase
  :: LetterCase  -- ^ The given 'LetterCase' to apply.
  -> [RomanLiteral]  -- ^ The given list of 'RomanLiteral' objects to convert to a Unicode equivalent.
  -> Text  -- ^ A 'Text' object that contains a sequence of unicode characters that represents the 'RomanLiteral's.
romanNumeralCase :: LetterCase -> [RomanLiteral] -> Text
romanNumeralCase = ([RomanLiteral] -> Text)
-> ([RomanLiteral] -> Text) -> LetterCase -> [RomanLiteral] -> Text
forall a. a -> a -> LetterCase -> a
splitLetterCase [RomanLiteral] -> Text
romanNumeral [RomanLiteral] -> Text
romanNumeral'

_romanNumber :: Integral i => ([RomanLiteral] -> a) -> RomanStyle -> Ligate -> i -> Maybe a
_romanNumber :: ([RomanLiteral] -> a) -> RomanStyle -> Ligate -> i -> Maybe a
_romanNumber [RomanLiteral] -> a
f RomanStyle
r Ligate
c = ([RomanLiteral] -> a) -> Maybe [RomanLiteral] -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RomanLiteral] -> a
f (Maybe [RomanLiteral] -> Maybe a)
-> (i -> Maybe [RomanLiteral]) -> i -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RomanStyle -> Ligate -> i -> Maybe [RomanLiteral]
forall i.
Integral i =>
RomanStyle -> Ligate -> i -> Maybe [RomanLiteral]
toLiterals RomanStyle
r Ligate
c

-- | Convert a given number to a 'Text' wrapped in a 'Just' data constructor,
-- given the number, given it can be represented. 'Nothing' in case it can not
-- be represented. The number is written in Roman numerals in /upper case/.
romanNumber :: Integral i
  => RomanStyle  -- ^ Specifies if the Numeral is 'Additive' or 'Subtractive' style.
  -> Ligate  -- ^ Specifies if characters like @ⅠⅤ@ are joined to @Ⅳ@.
  -> i  -- ^ The given number to convert.
  -> Maybe Text  -- ^ A 'Text' if the given number can be specified with Roman
                -- numerals wrapped in a 'Just', 'Nothing' otherwise.
romanNumber :: RomanStyle -> Ligate -> i -> Maybe Text
romanNumber = ([RomanLiteral] -> Text) -> RomanStyle -> Ligate -> i -> Maybe Text
forall i a.
Integral i =>
([RomanLiteral] -> a) -> RomanStyle -> Ligate -> i -> Maybe a
_romanNumber [RomanLiteral] -> Text
romanNumeral

-- | Convert a given number to a 'Text' wrapped in a 'Just' data constructor,
-- given the number, given it can be represented. 'Nothing' in case it can not
-- be represented. The number is written in Roman numerals in /lower case/.
romanNumber' :: Integral i
  => RomanStyle  -- ^ Specifies if the Numeral is 'Additive' or 'Subtractive' style.
  -> Ligate  -- ^ Specifies if characters like @ⅠⅤ@ are joined to @Ⅳ@.
  -> i  -- ^ The given number to convert.
  -> Maybe Text  -- ^ A 'Text' if the given number can be specified with Roman
                -- numerals wrapped in a 'Just', 'Nothing' otherwise.
romanNumber' :: RomanStyle -> Ligate -> i -> Maybe Text
romanNumber' = ([RomanLiteral] -> Text) -> RomanStyle -> Ligate -> i -> Maybe Text
forall i a.
Integral i =>
([RomanLiteral] -> a) -> RomanStyle -> Ligate -> i -> Maybe a
_romanNumber [RomanLiteral] -> Text
romanNumeral'

-- | Convert a given number to a 'Text' wrapped in a 'Just' data constructor,
-- given the number, given it can be represented. 'Nothing' in case it can not
-- be represented. The number is written in Roman numerals in /upper case/ or
-- /lower case/ depending on the 'LetterCase' value.
romanNumberCase :: Integral i
  => LetterCase
  -> RomanStyle
  -> Ligate
  -> i
  -> Maybe Text
romanNumberCase :: LetterCase -> RomanStyle -> Ligate -> i -> Maybe Text
romanNumberCase = (RomanStyle -> Ligate -> i -> Maybe Text)
-> (RomanStyle -> Ligate -> i -> Maybe Text)
-> LetterCase
-> RomanStyle
-> Ligate
-> i
-> Maybe Text
forall a. a -> a -> LetterCase -> a
splitLetterCase RomanStyle -> Ligate -> i -> Maybe Text
forall i. Integral i => RomanStyle -> Ligate -> i -> Maybe Text
romanNumber RomanStyle -> Ligate -> i -> Maybe Text
forall i. Integral i => RomanStyle -> Ligate -> i -> Maybe Text
romanNumber'