import Data.List (mapAccumR)
import qualified Data.Map.Strict as M
import Data.Maybe (maybe)

fromRoman :: String -> Maybe Int
fromRoman cs =
  let go l r
        | l > r = (- r, l)
        | otherwise = (r, l)
   in traverse (`M.lookup` mapRoman) cs
        >>= ( Just . sum . ((:) <$> fst <*> snd)
                . mapAccumR go 0
            )

mapRoman :: M.Map Char Int
mapRoman =
  M.fromList $
    zip
      "MDCLXVI "
      [ 1000,
        500,
        100,
        50,
        10,
        5,
        1,
        0
      ]

--------------------------- TEST -------------------------
main :: IO ()
main =
  putStrLn $
    fTable
      "Decoding Roman numbers:\n"
      show
      (maybe "Unrecognised character" show)
      fromRoman
      [ "MDCLXVI",
        "MCMXC",
        "MMVIII",
        "MMXVI",
        "MMXVIII",
        "MMXBIII"
      ]

------------------------ FORMATTING ----------------------
fTable ::
  String ->
  (a -> String) ->
  (b -> String) ->
  (a -> b) ->
  [a] ->
  String
fTable s xShow fxShow f xs =
  unlines $
    s :
    fmap
      ( ((<>) . rjust w ' ' . xShow)
          <*> ((" -> " <>) . fxShow . f)
      )
      xs
  where
    rjust n c = drop . length <*> (replicate n c <>)
    w = maximum (length . xShow <$> xs)