roman-numerals 0.3 → 0.4
raw patch · 2 files changed
+118/−154 lines, 2 files
Files
- Text/Numeral/Roman.hs +117/−153
- roman-numerals.cabal +1/−1
Text/Numeral/Roman.hs view
@@ -16,8 +16,8 @@ Example: @- \> 'toRoman' 1729 ∷ Either String String- Right \"MDCCXXIX\"+ \> 'toRoman' 1729 ∷ String+ \"MDCCXXIX\" @ @@@ -26,8 +26,8 @@ @ @- \> 'convertTo' 'simpleRoman' 1729 ∷ Either String String- Right \"MDCCXXVIIII\"+ \> 'convertTo' 'simpleRoman' 1729 ∷ String+ \"MDCCXXVIIII\" @ @@@ -38,57 +38,53 @@ -} module Text.Numeral.Roman ( -- * Types- NumeralConfig(..)-- -- * Standard configurations- , modernRoman- , simpleRoman+ NumeralConfig+ , mkNumConfig -- * Pretty printing , convertTo- , unsafeConvertTo- , toRoman- , unsafeToRoman -- * Parsing , StripPrefix(..)- , convertFrom++ -- * Default Configurations+ , modernRoman+ , simpleRoman++ -- * Utility+ , toRoman , fromRoman- , unsafeConvertFrom- , unsafeFromRoman ) where - ------------------------------------------------------------------------------- -- Imports ------------------------------------------------------------------------------- --- base-import Data.Bool ( Bool(False, True), otherwise )+-- from base:+import Data.Bool ( Bool, otherwise ) import Data.Char ( String )-import Data.Either ( either )-import Data.Eq ( Eq, (==) )-import Data.Function ( ($), id, const )+import Data.Eq ( Eq )+import Data.Function ( ($), flip, on )+import Data.List ( sortBy, null, stripPrefix ) import Data.Maybe ( Maybe(Nothing, Just), maybe ) import Data.Monoid ( Monoid )-import Data.Ord ( Ord, (>), (<) )+import Data.Ord ( Ord, compare ) import Data.String ( IsString, fromString )-import qualified Data.List as L ( null, stripPrefix )-import Control.Monad ( (>>=), (>>), return, fail, liftM2 )-import Prelude ( Num, (+), (-), Integer, fromInteger, error )-import Text.Show ( show )+import Data.Tuple ( snd )+import Control.Monad ( (>>=), (>>), return, fail )+import Prelude ( Num, (+), (-), fromInteger, error ) --- base-unicode-symbols+-- from base-unicode-symbols: import Data.Eq.Unicode ( (≡) ) import Data.Function.Unicode ( (∘) )-import Data.Ord.Unicode ( (≥) )+import Data.Ord.Unicode ( (≥), (≤) ) import Data.Monoid.Unicode ( (∅), (⊕) ) --- bytestring+-- from bytestring: import qualified Data.ByteString as BS --- monads-fd+-- from monads-fd: import Control.Monad.Error ( MonadError, throwError ) @@ -98,14 +94,9 @@ -- |A configuration with which the 'convertTo' and 'convertFrom' -- functions can be parameterized.-data NumeralConfig s n = NC - { -- |The largest value that can be represented using this- -- configuration.- ncMax ∷ n- -- |Symbol to represent the value 0. The Romans did not have a- -- symbol for zero. If set to Nothing a 'convertFrom' 0 will- -- throw an error.- , ncZero ∷ Maybe s+data NumeralConfig s n = NC+ { -- |Symbol to represent the value 0.+ ncZero ∷ s -- |A table of symbols and their numerical values. The table -- must be ordered in descending order of the value of the -- symbols. If any symbol is the empty string then 'convertFrom'@@ -115,51 +106,16 @@ , ncTable ∷ [(s, n)] } ----------------------------------------------------------------------------------- Default tables------------------------------------------------------------------------------------ |Configuration for Roman numerals as they are commonly used--- today. The value 0 is represented by the empty string. It can be--- interpreted as not writing down a number. This configuration is--- limited to the range [1..3999]. Larger numbers can be represented--- using Roman numerals but you will need notations that are hard or--- impossible to express using strings.-modernRoman ∷ (IsString s, Ord n, Num n) ⇒ NumeralConfig s n-modernRoman = NC { ncMax = 3999- , ncZero = Just ""- , ncTable = [ ("M", 1000)- , ("CM", 900)- , ("D", 500)- , ("CD", 400)- , ("C", 100)- , ("XC", 90)- , ("L", 50)- , ("XL", 40)- , ("X", 10)- , ("IX", 9)- , ("V", 5)- , ("IV", 4)- , ("I", 1)- ]- }---- |Configuration for Roman numerals that do not use the rule that a--- lower rank symbol can be placed before a higher rank symbol to--- denote the difference between them. Thus a numeral like \"IV\" will--- not be accepted or generated by this configuration.-simpleRoman ∷ (IsString s, Ord n, Num n) ⇒ NumeralConfig s n-simpleRoman = NC { ncMax = 3999- , ncZero = Just ""- , ncTable = [ ("M", 1000)- , ("D", 500)- , ("C", 100)- , ("L", 50)- , ("X", 10)- , ("V", 5)- , ("I", 1)- ]- }+-- |Smart constructor for a 'NumeralConfig'.+mkNumConfig ∷ (Ord n, Num n)+ ⇒ s -- ^Symbol for zero+ → s -- ^Symbol for one+ → [(s, n)] -- ^ Symbol-value table.+ → NumeralConfig s n+mkNumConfig z o tab =+ NC { ncZero = z+ , ncTable = sortBy (flip compare `on` snd) ((o, 1) : tab)+ } ------------------------------------------------------------------------------- -- Pretty printing@@ -171,107 +127,115 @@ -- representation is possible with the given configuration. If the -- value of any symbol in the configuration is equal to 0 or a symbol -- is the empty string this function is undefined.-convertTo ∷ (Monoid s, Ord n, Num n, MonadError String m)- ⇒ NumeralConfig s n → n → m s-convertTo nc n - | n < 0 = errMsg $ "can't represent negative numbers"- | n > maxN = errMsg $ "too large (max = " ⊕ (show maxN) ⊕ ")"- | n ≡ 0 = maybe (errMsg "no symbol for zero")- return- (ncZero nc)+convertTo ∷ Monoid s ⇒ Ord n ⇒ Num n ⇒ NumeralConfig s n → n → s+convertTo nc n+ | n ≡ 0 = ncZero nc | otherwise = go n $ ncTable nc- where maxN = ncMax nc-- go 0 _ = return (∅)- go _ [] = errMsg "out of symbols"+ where go _ [] = error "Roman.convertTo: out of symbols (BUG)" go i tab@(~(sym, val) : ts)- | n ≥ val = liftM2 (⊕) (return sym) $ go (i - val) tab+ | i ≤ 0 = (∅)+ | i ≥ val = sym ⊕ go (i - val) tab | otherwise = go i ts - errMsg = throwError ∘ ("Roman.convertTo: " ⊕) --- |Like 'convertTo', but exceptions are promoted to errors.-unsafeConvertTo ∷ (Monoid s, Ord n, Num n) ⇒ NumeralConfig s n → n → s-unsafeConvertTo nc = either error id ∘ convertTo nc---- |Converts a number to a modern Roman numeral. See 'convertTo' for--- possible exceptions.-toRoman ∷ (IsString s, Monoid s, Ord n, Num n, MonadError String m)- ⇒ n → m s-toRoman = convertTo modernRoman---- |Like 'toRoman', but exceptions are promoted to errors.-unsafeToRoman ∷ (IsString s, Monoid s, Ord n, Num n) ⇒ n → s-unsafeToRoman = unsafeConvertTo modernRoman- ------------------------------------------------------------------------------- -- Parsing ------------------------------------------------------------------------------- -- |Class used to overload the input of the parsing functions. class StripPrefix s where- null ∷ s → Bool- stripPrefix ∷ s → s → Maybe s+ spNull ∷ s → Bool+ spStripPrefix ∷ s → s → Maybe s instance Eq α ⇒ StripPrefix [α] where- null = L.null- stripPrefix = L.stripPrefix+ spNull = null+ spStripPrefix = stripPrefix instance StripPrefix BS.ByteString where- null = BS.null- stripPrefix p s = let (h, t) = BS.breakSubstring p s- in if null h- then Just $ BS.drop (BS.length p) t- else Nothing+ spNull = BS.null+ spStripPrefix p s = let (h, t) = BS.breakSubstring p s+ in if spNull h+ then Just $ BS.drop (BS.length p) t+ else Nothing -- |Parses a string as a Roman numeral according to the given--- configuration. An exception will be raised if the input is not a+-- configuration. An exception will be thrown if the input is not a -- valid numeral. convertFrom ∷ (Monoid s, StripPrefix s, Eq s, Ord n, Num n, MonadError String m) ⇒ NumeralConfig s n → s → m n-convertFrom nc s | maybe False (≡ s) (ncZero nc) = return 0+convertFrom nc s | ncZero nc ≡ s = return 0 | otherwise = do n ← (go 0 (ncTable nc) s)- s' ← convertTo nc n- if s ≡ s'+ if s ≡ convertTo nc n then return n else errMsg "invalid Roman numeral"- where go n _ x | null x = return n- go _ [] _ = errMsg "can't parse"+ where go n _ x | spNull x = return n+ go _ [] _ = errMsg "can't parse" go n tab@((sym, val) : ts) x = maybe (go n ts x) (go (n + val) tab)- $ stripPrefix sym x+ $ spStripPrefix sym x errMsg = throwError ∘ ("Roman.convertFrom: " ⊕) --- |Like 'convertFrom', but exceptions are promoted to errors.-unsafeConvertFrom ∷ (Monoid s, StripPrefix s, Eq s, Ord n, Num n)- ⇒ NumeralConfig s n → s → n-unsafeConvertFrom nc = either error id ∘ convertFrom nc --- |Parses a string as a modern Roman numeral. See 'convertFrom' for--- possible exceptions.-fromRoman ∷ ( IsString s, Monoid s, StripPrefix s, Eq s- , Ord n, Num n, MonadError String m- ) ⇒ s → m n-fromRoman = convertFrom modernRoman+-------------------------------------------------------------------------------+-- Default Configurations+------------------------------------------------------------------------------- --- |Like 'fromRoman', but exceptions are promoted to errors.-unsafeFromRoman ∷ ( IsString s, Monoid s, StripPrefix s, Eq s- , Ord n, Num n- ) ⇒ s → n-unsafeFromRoman = unsafeConvertFrom modernRoman+-- |Configuration for Roman numerals as they are commonly used+-- today. The value 0 is represented by the empty string. It can be+-- interpreted as not writing down a number. This configuration is+-- practically limited to the range [1..3999]. Smaller numbers will+-- result in empty string. Larger numbers will result in repeated use+-- of the \'M\' symbol.+modernRoman ∷ (IsString s, Ord n, Num n) ⇒ NumeralConfig s n+modernRoman =+ mkNumConfig ""+ "I"+ [ ("IV", 4)+ , ("V", 5)+ , ("IX", 9)+ , ("X", 10)+ , ("XL", 40)+ , ("L", 50)+ , ("XC", 90)+ , ("C", 100)+ , ("CD", 400)+ , ("D", 500)+ , ("CM", 900)+ , ("M", 1000)+ ] +-- |Configuration for Roman numerals that do not use the rule that a+-- lower rank symbol can be placed before a higher rank symbol to+-- denote the difference between them. Thus a numeral like \"IV\" will+-- not be accepted or generated by this configuration. This+-- configuration is practically limited to the range [1..3999]. Larger+-- numbers will result in repeated use of the \'M\' symbol.+simpleRoman ∷ (IsString s, Ord n, Num n) ⇒ NumeralConfig s n+simpleRoman =+ mkNumConfig ""+ "I"+ [ ("V", 5)+ , ("X", 10)+ , ("L", 50)+ , ("C", 100)+ , ("D", 500)+ , ("M", 1000)+ ]++ ---------------------------------------------------------------------------------- Properties+-- Utility ------------------------------------------------------------------------------- -prop_printParseIsId ∷ NumeralConfig String Integer → String → Bool-prop_printParseIsId nc xs = either (const True) id- $ do n ← convertFrom nc xs- xs' ← convertTo nc n- return $ xs' ≡ xs+-- |Converts a number to a modern Roman numeral. See 'convertTo' for+-- possible exceptions.+toRoman ∷ (IsString s, Monoid s, Ord n, Num n) ⇒ n → s+toRoman = convertTo modernRoman -prop_parsePrintIsId ∷ NumeralConfig String Integer → Integer → Bool-prop_parsePrintIsId nc n = either (const True) id- $ do xs ← convertTo nc n- n' ← convertFrom nc xs- return $ n' ≡ n++-- |Parses a string as a modern Roman numeral. See 'convertFrom' for+-- possible exceptions.+fromRoman ∷ ( IsString s, Monoid s, StripPrefix s, Eq s+ , Ord n, Num n, MonadError String m+ ) ⇒ s → m n+fromRoman = convertFrom modernRoman
roman-numerals.cabal view
@@ -1,5 +1,5 @@ name: roman-numerals-version: 0.3+version: 0.4 cabal-version: >= 1.6 build-type: Simple stability: stable