Skip to content

Instantly share code, notes, and snippets.

@battermann
Last active December 3, 2015 09:51
Show Gist options
  • Save battermann/dd3ff1273e9dfc9ac11b to your computer and use it in GitHub Desktop.
Save battermann/dd3ff1273e9dfc9ac11b to your computer and use it in GitHub Desktop.
Parser for Roman Numerals
import Text.ParserCombinators.Parsec (char, many1, string, choice, try, parse)
import Text.Parsec.Prim (parserReturn, parserFail, ParsecT)
import Data.Functor
import Data.Functor.Identity
import Data.Either
import Test.Hspec
sat :: String -> (a -> Bool) -> ParsecT s u m a -> ParsecT s u m a
sat msg predicate parser = parser >>= (\x -> if predicate x then parserReturn x else parserFail msg)
strictDecr :: Ord a => ParsecT s u m [a] -> ParsecT s u m [a]
strictDecr =
sat msg (\xs -> and (zipWith (>) xs (drop 1 xs)))
where msg = "unexpected order of values\nexpected strictly decreasing values"
romPrimCombiVal :: ParsecT [Char] u Identity Integer
romPrimCombiVal =
choice [
(\_ -> 4) <$> (try $ string "IV"),
(\_ -> 9) <$> (try $ string "IX"),
(\_ -> 40) <$> (try $ string "XL"),
(\_ -> 90) <$> (try $ string "XC"),
(\_ -> 400) <$> (try $ string "CD"),
(\_ -> 900) <$> (try $ string "CM"),
sat "unexpected repetitions of symbol `I`\nexpected symbol to appear 3 times at most" (<= 3) $ sum <$> many1 ((\_ -> 1) <$> (char 'I')),
sat "unexpected repetitions of symbol `X`\nexpected symbol to appear 3 times at most" (<= 30) $ sum <$> many1 ((\_ -> 10) <$> (char 'X')),
sat "unexpected repetitions of symbol `C`\nexpected symbol to appear 3 times at most" (<= 300) $ sum <$> many1 ((\_ -> 100) <$> (char 'C')),
sum <$> many1 ((\_ -> 1000) <$> (char 'M')),
(\_ -> 5) <$> (char 'V'),
(\_ -> 50) <$> (char 'L'),
(\_ -> 500) <$> (char 'D')]
romNum :: ParsecT [Char] u Identity Integer
romNum = do
ns <- strictDecr $ many1 romPrimCombiVal
return $ sum ns
main :: IO()
main = hspec $ do
it "romNum parsers should succeed" $ do
parse romNum "" "I" `shouldBe` Right (1)
parse romNum "" "II" `shouldBe` Right (2)
parse romNum "" "III" `shouldBe` Right (3)
parse romNum "" "IX" `shouldBe` Right (9)
parse romNum "" "MLXVI" `shouldBe` Right (1066)
parse romNum "" "MCMLXXXIX" `shouldBe` Right (1989)
parse romNum "" "MMMMMMM" `shouldBe` Right (7000)
it "romNum parsers should fail" $ do
isLeft (parse romNum "" "IIII") `shouldBe` True
isLeft (parse romNum "" "VX") `shouldBe` True
isLeft (parse romNum "" "IVX") `shouldBe` True
isLeft (parse romNum "" "MDLVX") `shouldBe` True
isLeft (parse romNum "" "foo") `shouldBe` True
isLeft (parse romNum "" "") `shouldBe` True
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment