diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2009 Roel van Dijk + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/Text/RomanNumerals.hs b/Text/RomanNumerals.hs new file mode 100644 --- /dev/null +++ b/Text/RomanNumerals.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE FlexibleContexts #-} + +{-| 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 + +import Control.Monad.Error +import qualified Data.List as L + +------------------------------------------------------------------------------- +-- 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) + $ L.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 new file mode 100644 --- /dev/null +++ b/roman-numerals.cabal @@ -0,0 +1,27 @@ +name: roman-numerals +version: 0.1 +cabal-version: >= 1.6 +build-type: Simple +stability: provisional +author: Roel van Dijk +maintainer: vandijk.roel@gmail.com +copyright: (c) 2009 Roel van Dijk +license: BSD3 +license-file: LICENSE +category: Numerical, Parsing +synopsis: Parsing and pretty printing of Roman numerals +description: + This library 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. + +library + build-depends: base, mtl ==1.1.* + exposed-modules: Text.RomanNumerals + extensions: FlexibleContexts + + +