module Data.RomanNum (
      RomanNum(..)
    , nullus
    , plus
    , r
  ) where

import Data.Map (Map, (!))
import qualified Data.Map as Map (fromList)

newtype RomanNum = RomanNum Int

data RomanChar = I | V | X | L | C | D | M deriving (Bounded, Eq, Ord, Enum, Show, Read)

romanChars :: [RomanChar]
romanChars = [minBound .. maxBound]

base :: [(Int, [Char])]
base = base' 1 [] . concat $ show <$> romanChars where
  base' _ l "" = l
  base' size l chars =
    base' (size * 10) ((size, take 3 chars):l) (drop 2 chars)

values :: Map RomanChar Int
values = Map.fromList $
  zip romanChars (concat $ iterate (fmap (*10)) [1, 5])

instance Show RomanNum where
  show (RomanNum 0) = "nullus"
  show (RomanNum n) = show' n base where
    show' 0 _ = ""
    show' _ [] = error "Numeral system not fine-grained enough"
    show' k ((size, digits):others)
      | k < size = show' k others
      | otherwise =
        let decDigit = k `div` size in
        showDecDigit decDigit digits ++ show' (k `mod` size) others
    showDecDigit _ [] = error "no digits for conversion"
    showDecDigit k [digit] = k `times` digit
    showDecDigit k digits
      | k == 4 || (k == 9 && length digits > 2) =
        (head digits) : [head (drop (if k > 5 then 2 else 1) digits)]
      | k > 4 = head (drop 1 digits) : (showDecDigit (k-5) digits)
      | otherwise = k `times` (head digits)
    times count letter = take count $ repeat letter

r :: String -> RomanNum
r "" = nullus
r "nullus" = nullus
r n@[_] = RomanNum (values ! (read n))
r (digit:nextDigit:otherDigits) =
  let (rChar, nextRChar) = (read [digit], read [nextDigit]) in
  if rChar < nextRChar
  then RomanNum (values ! nextRChar - values ! rChar) `plus` r otherDigits
  else RomanNum (values ! rChar) `plus` r(nextDigit:otherDigits)

nullus :: RomanNum
nullus = RomanNum 0

plus :: RomanNum -> RomanNum -> RomanNum
plus (RomanNum a) (RomanNum b) = RomanNum (a + b)