import Data.Bifunctor (bimap)
import Data.List (isPrefixOf, mapAccumL)

romanValue :: String -> Int
romanValue =
  let tr s (k, v) =
        until
          (not . isPrefixOf k . fst)
          (bimap ((drop . length) k) (v +))
          (s, 0)
   in sum
        . snd
        . flip
          (mapAccumL tr)
          [ ("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)
          ]

main :: IO ()
main =
  mapM_
    (print . romanValue)
    [ "MDCLXVI",
      "MCMXC",
      "MMVIII",
      "MMXVI",
      "MMXVII"
    ]