integer <-----> roman numeral

I2r.hs

module I2r ( integer2roman ) where
import Data.Char

--  integer ----> roman numeral
-- https://gist.github.com/yamasushi/2cdcf3e33dd96451870bf1e979c484cc

--- Compilers 1st ed. ex. P2.1 (p. 81)
--- Compilers 2nd ed. ex. 2.3.3 (p. 60)

-- -----------------------------------------------
--  integer --> roman numeral
-- -----------------------------------------------
--  N -> N D | D

-- N -> D R1 { N.s = n->roman(R1.k , D.d ) + R1.s }
-- R -> D R1 { R.k = R1.k +　1 , R.s = n->roman(R1.k , D.d ) + R1.s }
-- R -> ε { R.k = 0 , R.s= "" }

integer2roman :: Int->String
integer2roman i = integerStr2roman . show $ i

integerStr2roman :: String -> String
integerStr2roman s = let (rn,_)=n(s) in rn

num_table :: [[String]]
num_table = [
    ["I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX"], --   1 ~    9
    ["X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC"], --  10 ~   90
    ["C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM"], -- 100 ~  900
    ["M", "MM", "MMM" ] ] -- 1000 ~ 3000

n2roman :: Int->Int->String
n2roman t n
  | n <= 0 = ""
  | otherwise = (num_table !! t) !! (n-1)

n :: String -> (String,String)
n(hd:tl)
  | (isNumber hd) =
    let d=(digitToInt hd) ; (k,s,xs)=r(tl) in ( (n2roman k d)++s , xs )

r :: String -> (Int,String,String)
r [] = (0,[],[]) -- ε
r (hd:tl)
  | (isNumber hd) =
    let d=(digitToInt hd) ; (k,s,xs)=r(tl) in ( k+1 , (n2roman k d)++s , xs)
r(xs) = (0,"",xs) -- ε

R2i.hs

module R2i(roman2integer) where
-- roman numeral ---> integer
-- Compilers 2nd ed. ex. 2.3.4 (p. 60)
-- https://gist.github.com/yamasushi/2cdcf3e33dd96451870bf1e979c484cc

-- -----------------------------------------------
--  roman numeral ---> integer
-- -----------------------------------------------

roman2integer :: String -> Int
roman2integer str =
  let(num,_)=n str in num

n :: String -> (Int,String)
n xs =
  let (n3,xs0) = m3 xs  in
  let (n2,xs1) = m2 xs0 in
  let (n1,xs2) = m1 xs1 in
  let (n0,xs3) = m0 xs2 in
    (n3*1000 + n2*100 + n1*10 + n0 , xs3)

m0 :: String -> (Int,String)
m0 = m 'I' 'V' 'X'

m1 :: String -> (Int,String)
m1 = m 'X' 'L' 'C'

m2 :: String -> (Int,String)
m2 = m 'C' 'D' 'M'

m3 :: String -> (Int,String)
m3 = m 'M' '_' '_'
  
m :: Char -> Char -> Char -> String -> (Int,String)
m i v x roman_num = 
  -- R  -> I { R.n = 1 }
  --     | ε { R.n = 0 }
  let r = \ xs -> case xs of
        (hd:xs0)|hd==i -> ( 1 , xs0)
        _              -> ( 0 , xs ) -- ε
  in
  -- P  -> I R { P.n = 1 + R.n }
  --     | V { P.n = 3 }
  --     | X { P.n = 8 }
  --     | ε { P.n = 0 }
  let p = \ xs -> case xs of
        (hd:xs0)|hd==i -> let (num,xs1)=r xs0 in ( num+1 , xs1 )
        (hd:xs0)|hd==v -> ( 3 , xs0 )
        (hd:xs0)|hd==x -> ( 8 , xs0 )
        _              -> ( 0 , xs  ) -- ε
  in
  -- S  -> I R {S.n = 1 + R.n} 
  --     | ε {S.n = 0}
  let s = \ xs -> case xs of
        (hd:xs0)|hd==i -> let (num,xs1)=r xs0 in (num+1 , xs1)
        _              -> ( 0 , xs ) -- ε
  in
  -- Q  -> I S {Q.n = 1 + S.n}
  --     | ε {Q.n = 0}
  let q = \ xs -> case xs of
        (hd:xs0)|hd==i -> let (num,xs1) = s xs0 in (num+1 , xs1)
        _              -> (0,xs) -- ε
  in
  -- M -> I P {M.n = 1 + P.n } 
  --    | V Q {M.n = 5 + Q.n } 
  --    | ε M.n = 0
  case roman_num of
    (hd:xs0)|hd==i -> let (num,xs1) = p xs0 in ( num+1 , xs1 )
    (hd:xs0)|hd==v -> let (num,xs1) = q xs0 in (num+5  , xs1 )
    xs             -> (0,xs) -- ε

Roman.hs

-- https://gist.github.com/yamasushi/2cdcf3e33dd96451870bf1e979c484cc

module Roman (test) where
import I2r
import R2i

test :: Int ->IO()
test max = test_ max 0

test_ :: Int -> Int -> IO()
test_ max n =
  let roman = integer2roman n in
  let m     = roman2integer roman in
  if n /= m
  then
    error ("error n=" ++ (show n) ++
           " roman"   ++ roman    ++
           " m="      ++ (show m) )
  else
    do
      putStrLn ((show n) ++ " -- i2r--> " ++
                roman ++ " --r2i--> " ++
                (show m) ) 
      if n < max then test_ max (n+1) else return()