content: {-# LANGUAGE RecursiveDo #-}
  module Main where
  
  import Control.Applicative ((<|>), (<**>))
  import System.Environment (getArgs)
  import Text.Earley
  
  numeral :: String -> Int -> Prod r String Char Int
  numeral str n = n <$ list str
  
  romanNumeralsGrammar :: Grammar r (Prod r String Char Int)
  romanNumeralsGrammar = mdo
  
    thousands <- rule
      $ pure 0
      <|> numeral "M" 1000 <**> fmap (+) thousands
  
    le300 <- rule
      $ pure 0
      <|> numeral "C" 100
      <|> numeral "CC" 200
      <|> numeral "CCC" 300
  
    hundreds <- rule
      $ le300
      <|> numeral "CD" 400
      <|> numeral "D" 500 <**> fmap (+) le300
      <|> numeral "CM" 900
  
    le30 <- rule
      $ pure 0
      <|> numeral "X" 10
      <|> numeral "XX" 20
      <|> numeral "XXX" 30
  
    tens <- rule 
      $ le30
      <|> numeral "XL" 40
      <|> numeral "L" 50 <**> fmap (+) le30
      <|> numeral "XC" 90
  
    le3 <- rule
      $ pure 0
      <|> numeral "I" 1
      <|> numeral "II" 2
      <|> numeral "III" 3
  
    units <- rule
      $ le3
      <|> numeral "IV" 4
      <|> numeral "V" 5 <**> fmap (+) le3
      <|> numeral "IX" 9
  
    return
      $ thousands
      <**> fmap (+) hundreds
      <**> fmap (+) tens
      <**> fmap (+) units
  
  
  main :: IO ()
  main = do
    x:_ <- getArgs
    print $ fullParses (parser romanNumeralsGrammar) x
  