diff --git a/Text/Numeral/Roman.hs b/Text/Numeral/Roman.hs new file mode 100644 --- /dev/null +++ b/Text/Numeral/Roman.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE FlexibleContexts + , NoImplicitPrelude + , OverloadedStrings + , UnicodeSyntax + #-} + +{-| Parsing and pretty printing of Roman numerals. + +This module provides functions for parsing and pretty printing Roman +numerals. Because the notation of Roman numerals has varied through +the centuries this package allows for some customisation using a +configuration that is passed to the conversion functions. Exceptions +are dealt with by wrapping the results of conversions in the error +monad. + +Example: + +@ + \> 'toRoman' 1729 ∷ Either String String + Right \"MDCCXXIX\" +@ + +@ + \> 'fromRoman' \"MDCCXXIX\" ∷ Either String Integer + Right 1729 +@ + +@ + \> 'convertTo' 'simpleRoman' 1729 ∷ Either String String + Right \"MDCCXXVIIII\" +@ + +@ + \> 'fromRoman' \"Bla\" ∷ Either String Integer + Left \"Roman.convertFrom: can't parse\" +@ + +-} +module Text.Numeral.Roman + ( -- * Types + NumeralConfig(..) + + -- * Standard configurations + , modernRoman + , simpleRoman + + -- * Pretty printing + , convertTo + , unsafeConvertTo + , toRoman + , unsafeToRoman + + -- * Parsing + , StripPrefix(..) + + , convertFrom + , fromRoman + , unsafeConvertFrom + , unsafeFromRoman + ) where + + +------------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------------- + +-- base +import Data.Bool ( Bool(False, True), otherwise ) +import Data.Char ( String ) +import Data.Either ( either ) +import Data.Eq ( Eq, (==) ) +import Data.Function ( ($), id, const ) +import Data.Maybe ( Maybe(Nothing, Just), maybe ) +import Data.Monoid ( Monoid ) +import Data.Ord ( Ord, (>), (<) ) +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 ) + +-- base-unicode-symbols +import Data.Eq.Unicode ( (≡) ) +import Data.Function.Unicode ( (∘) ) +import Data.Ord.Unicode ( (≥) ) +import Data.Monoid.Unicode ( (∅), (⊕) ) + +-- bytestring +import qualified Data.ByteString as BS + +-- monads-fd +import Control.Monad.Error ( MonadError, throwError ) + + +------------------------------------------------------------------------------- +-- Types +------------------------------------------------------------------------------- + +-- |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 + -- |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' + -- will be ⊥. If any symbol in this table is associated + -- with the value 0 both the 'convertTo' and 'convertFrom' + -- function will be ⊥. + , 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) + ] + } + +------------------------------------------------------------------------------- +-- Pretty printing +------------------------------------------------------------------------------- + +-- |Converts a number to a Roman numeral according to the given +-- configuration. Numbers which are out of bounds will cause +-- exceptions to be thrown. An exception will also be raised if no +-- 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) + | otherwise = go n $ ncTable nc + where maxN = ncMax nc + + go 0 _ = return (∅) + go _ [] = errMsg "out of symbols" + go i tab@(~(sym, val) : ts) + | n ≥ val = liftM2 (⊕) (return 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 + +instance Eq α ⇒ StripPrefix [α] where + null = L.null + stripPrefix = L.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 + +-- |Parses a string as a Roman numeral according to the given +-- configuration. An exception will be raised 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 + | otherwise = do n ← (go 0 (ncTable nc) s) + s' ← convertTo nc n + if s ≡ s' + then return n + else errMsg "invalid Roman numeral" + where go n _ x | null 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 + 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 + +-- |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 + +------------------------------------------------------------------------------- +-- Properties +------------------------------------------------------------------------------- + +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 + +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 diff --git a/Text/RomanNumerals.hs b/Text/RomanNumerals.hs deleted file mode 100644 --- a/Text/RomanNumerals.hs +++ /dev/null @@ -1,221 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE UnicodeSyntax #-} - -{-| Parsing and pretty printing of Roman numerals. - - This module provides functions for parsing and pretty printing Roman - numerals. Because the notation of Roman numerals has varied through - the centuries this package allows for some customisation using a - configuration that is passed to the conversion functions. Exceptions - are dealt with by wrapping the results of conversions in the error - monad. --} -module Text.RomanNumerals - ( -- * Types - NumeralConfig(..) - -- * Sample configurations - , modernRoman - , simpleRoman - -- * Pretty printing - , convertTo - , unsafeConvertTo - , toRoman - , unsafeToRoman - -- * Parsing - , convertFrom - , fromRoman - , unsafeConvertFrom - , unsafeFromRoman - ) where - - -------------------------------------------------------------------------------- --- Imports -------------------------------------------------------------------------------- - --- base -import Control.Monad ( (>>=), (>>), fail, liftM2, return ) -import Data.Bool ( Bool(False, True), otherwise ) -import Data.Char ( String ) -import Data.Either ( either ) -import Data.Eq ( (==) {- needed for desugaring -} ) -import Data.Function ( ($), const, id ) -import Data.List ( stripPrefix, take ) -import Data.Maybe ( Maybe(Just), maybe ) -import Data.Ord ( Ord, (<), (>) ) -import Prelude ( Num, (-), (+), error, fromInteger ) -import Text.Show ( show ) - --- base-unicode-symbols -import Data.Eq.Unicode ( (≡) ) -import Data.Function.Unicode ( (∘) ) -import Data.Monoid.Unicode ( (⊕) ) -import Data.Ord.Unicode ( (≥) ) - --- mtl -import Control.Monad.Error ( MonadError, throwError ) - -------------------------------------------------------------------------------- --- Types -------------------------------------------------------------------------------- - --- |A configuration with which the 'convertTo' and 'convertFrom' --- functions can be parameterized. -data (Ord n, Num n) ⇒ - NumeralConfig 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 String - -- |A table of symbols and their numerical - -- values. The table must be ordered with - -- the largest symbols appearing - -- first. If any symbol is the empty - -- string then 'convertFrom' will be - -- undefined. If any symbol in this table - -- is associated with the value 0 both - -- the convertTo and 'convertFrom' - -- function will be undefined. - , ncTable ∷ [(String, n)] - } - -------------------------------------------------------------------------------- --- Default tables -------------------------------------------------------------------------------- - --- |Configuration for Roman numerals as they are commenly 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 ∷ (Ord n, Num n) ⇒ NumeralConfig 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 ∷ (Ord n, Num n) ⇒ NumeralConfig n -simpleRoman = NC { ncMax = 3999 - , ncZero = Just "" - , ncTable = [ ("M", 1000) - , ("D", 500) - , ("C", 100) - , ("L", 50) - , ("X", 10) - , ("V", 5) - , ("I", 1) - ] - } - - -------------------------------------------------------------------------------- --- Pretty printing -------------------------------------------------------------------------------- - - --- |Converts a number to a Roman numeral according to the given --- configuration. Numbers which are out of bounds will cause --- exceptions to be thrown. An exception will also be raised if no --- 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 ∷ (Ord n, Num n, MonadError String m) - ⇒ NumeralConfig n → n → m String -convertTo nc n | n < 0 = throwError "Roman.convertTo: can't represent negative numbers" - | n > maxN = throwError $ "Roman.convertTo: too large (max = " ⊕ (show maxN) ⊕ ")" - | n ≡ 0 = maybe (throwError "Roman.convertTo: no symbol for zero") - return - $ ncZero nc - | otherwise = go n $ ncTable nc - where maxN = ncMax nc - go 0 _ = return "" - go _ [] = throwError "Roman.convertTo: out of symbols" - go n tab@(~(sym, val) : ts) | n ≥ val = liftM2 (⊕) (return sym) $ go (n - val) tab - | otherwise = go n ts - --- |Like 'convertTo', but exceptions are promoted to errors. -unsafeConvertTo ∷ (Ord n, Num n) ⇒ NumeralConfig n → n → String -unsafeConvertTo nc = either error id ∘ convertTo nc - --- |Converts a number to a modern Roman numeral. See 'convertTo' for --- possible exceptions. -toRoman ∷ (Ord n, Num n, MonadError String m) ⇒ n → m String -toRoman = convertTo modernRoman - --- |Like 'toRoman', but exceptions are promoted to errors. -unsafeToRoman ∷ (Ord n, Num n) ⇒ n → String -unsafeToRoman = unsafeConvertTo modernRoman - -------------------------------------------------------------------------------- --- Parsing -------------------------------------------------------------------------------- - --- convertFrom nc xs ≡ undefined when any symbol in the NumeralConfig --- nc is associated with the value 0. - --- |Parses a string as a Roman numeral according to the given --- configuration. An exception will be raised if the input is not a --- valid numeral. -convertFrom ∷ (Ord n, Num n, MonadError String m) ⇒ NumeralConfig n → String → m n -convertFrom nc xs | maybe False (≡ xs) (ncZero nc) = return 0 - | otherwise = do n ← (go 0 (ncTable nc) xs) - xs' ← convertTo nc n - if xs ≡ xs' - then return n - else throwError "Roman.convertFrom: invalid Roman numeral" - where go n _ [] = return n - go _ [] xs = throwError $ "Roman.convertFrom: can't parse: '" ⊕ (take 5 xs) ⊕ "'" - go n tab@((sym, val) : ts) xs = maybe (go n ts xs) - (go (n + val) tab) - $ stripPrefix sym xs - --- |Like 'convertFrom', but exceptions are promoted to errors. -unsafeConvertFrom ∷ (Ord n, Num n) ⇒ NumeralConfig n → String → n -unsafeConvertFrom nc = either error id ∘ convertFrom nc - --- |Parses a string as a modern Roman numeral. See 'convertFrom' for --- possible exceptions. -fromRoman ∷ (Ord n, Num n, MonadError String m) ⇒ String → m n -fromRoman = convertFrom modernRoman - --- |Like 'fromRoman', but exceptions are promoted to errors. -unsafeFromRoman ∷ (Ord n, Num n) ⇒ String → n -unsafeFromRoman = unsafeConvertFrom modernRoman - -------------------------------------------------------------------------------- --- Properties -------------------------------------------------------------------------------- - -printParseIsId ∷ (Ord n, Num n) ⇒ NumeralConfig n → String → Bool -printParseIsId nc xs = either (const True) id - $ do n ← convertFrom nc xs - xs' ← convertTo nc n - return $ xs' ≡ xs - -parsePrintIsId ∷ (Ord n, Num n) ⇒ NumeralConfig n → n → Bool -parsePrintIsId nc n = either (const True) id - $ do xs ← convertTo nc n - n' ← convertFrom nc xs - return $ n' ≡ n diff --git a/roman-numerals.cabal b/roman-numerals.cabal --- a/roman-numerals.cabal +++ b/roman-numerals.cabal @@ -1,11 +1,11 @@ name: roman-numerals -version: 0.1.0.1 +version: 0.3 cabal-version: >= 1.6 build-type: Simple stability: stable -author: Roel van Dijk -maintainer: vandijk.roel@gmail.com -copyright: (c) 2009 Roel van Dijk +author: Roel van Dijk +maintainer: Roel van Dijk +copyright: (c) 2009–2010 Roel van Dijk license: BSD3 license-file: LICENSE category: Numerical, Parsing @@ -24,9 +24,11 @@ library build-depends: base >= 3.0.3.1 && < 4.3 - , base-unicode-symbols >= 0.1.1 && < 0.2 - , mtl == 1.1.* - exposed-modules: Text.RomanNumerals + , base-unicode-symbols >= 0.1.1 && < 0.3 + , bytestring >= 0.9.1 && < 0.10 + , monads-fd >= 0.1 && < 0.2 + exposed-modules: Text.Numeral.Roman + ghc-options: -Wall