http://codingdojo.org/cgi-bin/wiki.pl?KataRomanCalculator

KataRomanCalculator.hs

module KataRomanCalculator
where

import Test.HUnit
import qualified Data.String.Utils as StringUtils

data RomanNumeral = RomanNumeral String
                    deriving (Show, Eq)

strip n (RomanNumeral s) = (RomanNumeral (drop n s))

romanValueMap :: [(String,Integer)]
romanValueMap = [ ("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) 
                ]

valueRomanMap = map (\(a,b) -> (b,a)) romanValueMap

-- ROMAN TO INTEGER

convertHelper :: RomanNumeral -> [(String,Integer)] -> Integer
convertHelper r@(RomanNumeral s) ((romanStr,romanValue):rMap)
    | null s = 0
    | StringUtils.startswith romanStr s = 
        romanValue + convertHelper (strip (length romanStr) r) romanValueMap
    | otherwise = convertHelper r rMap

convert :: RomanNumeral -> Integer
convert r@(RomanNumeral s) =
    convertHelper r romanValueMap
               
    -- | StringUtils.startswith "IX" s = 9 + (convert $ strip 2 r)
    -- | StringUtils.startswith "IV" s = 4 + (convert $ strip 2 r)
    -- | StringUtils.startswith "I" s = 1 + (convert $ strip 1 r)

-- INTEGER TO ROMAN

toRomanHelper :: Integer -> [(Integer, String)] -> String
toRomanHelper n ((romanValue,romanStr):rMap)
    | n == 0 = ""
    | n >= romanValue = romanStr ++ (toRomanHelper (n - romanValue) valueRomanMap)
    | otherwise = toRomanHelper n rMap

toRoman :: Integer -> RomanNumeral
toRoman n =
    RomanNumeral $ toRomanHelper n valueRomanMap

romanAdd :: RomanNumeral -> RomanNumeral -> RomanNumeral
romanAdd n1 n2 = 
    -- convert to int
    toRoman $ (convert n1) + (convert n2)
    -- convert to roman

checkToRoman name a e = 
    TestCase (assertEqual name e (toRoman a))

checkConvert name a e = 
    TestCase (assertEqual name e (convert a))

checkAdd name a1 a2 e =
    TestCase (assertEqual name e (romanAdd a1 a2))

toRomanTests = 
    [ checkToRoman "1 is I"
                   1 (RomanNumeral "I"),
      checkToRoman "2 is II"
                   2 (RomanNumeral "II"),
      checkToRoman "8 is VIII"
                   8 (RomanNumeral "VIII"),
      checkToRoman "14 is XIV"
                   14 (RomanNumeral "XIV")
    ]

convertTests =
    [ -- I is 1!
      checkConvert "I is 1"
                   (RomanNumeral "I") 1,
      checkConvert "II is 2"
                   (RomanNumeral "II") 2,
      checkConvert "VIII is 8"
                   (RomanNumeral "VIII") 8,
      checkConvert "XIV is 14"
                   (RomanNumeral "XIV") 14
    ]

addTests = 
    [ -- I + I = II
      checkAdd "one and one is two"
                   (RomanNumeral "I") (RomanNumeral "I") (RomanNumeral "II") ,
      -- IV + I = V
      checkAdd "four and one is five"
                   (RomanNumeral "IV") (RomanNumeral "I") (RomanNumeral "V"),
      checkAdd "XX + II = XXII"
                   (RomanNumeral "XX") (RomanNumeral "II") (RomanNumeral "XXII"),
      checkAdd "II + II = IV"
                   (RomanNumeral "II") (RomanNumeral "II") (RomanNumeral "IV"),
      checkAdd "D + D = M"
                   (RomanNumeral "D") (RomanNumeral "D") (RomanNumeral "M")
    ]



runTests = runTestTT (TestList (toRomanTests ++ convertTests ++ addTests))