diff --git a/Text/Numeral/Roman.hs b/Text/Numeral/Roman.hs --- a/Text/Numeral/Roman.hs +++ b/Text/Numeral/Roman.hs @@ -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 diff --git a/roman-numerals.cabal b/roman-numerals.cabal --- a/roman-numerals.cabal +++ b/roman-numerals.cabal @@ -1,5 +1,5 @@ name: roman-numerals -version: 0.3 +version: 0.4 cabal-version: >= 1.6 build-type: Simple stability: stable