Project Euler Problem 089

import qualified Data.Map as M
import Data.List
import Control.Monad
import Data.Char
import System.IO.Unsafe
romans :: M.Map Char Integer
romans = M.fromList [('I',1),('V',5),('X',10),('L',50),('C',100),('D',500),('M',1000),('\013',0)]
dig :: [Integer]
dig = [1000,500,100,50,10,5,1]
dig2cnt :: (Num a1, Num a, Ord a1) => a1 -> a
dig2cnt n | n>=1000 = 1 + dig2cnt (n-1000)
           | n>=900 = 2 + dig2cnt (n-900)
           | n>=500 = 1 + dig2cnt (n-500)
           | n>=400 = 2 + dig2cnt (n-400)
           | n>=100 = 1 + dig2cnt (n-100)
           | n>=90 = 2 + dig2cnt (n-90)
           | n>=50 = 1 + dig2cnt ( n - 50)
           | n>=40 = 2 + dig2cnt ( n - 40)
           | n>=10 = 1 + dig2cnt ( n - 10)
           | n>=9 = 2 + dig2cnt ( n - 9)
           | n>=5 = 1 + dig2cnt (n-5)
           | n>=4 = 2 + dig2cnt (n-4)
           | n>=1 = 1 + dig2cnt (n-1)
           | n==0 = 0
                   
fromRoman :: String -> Int
fromRoman x = imp x
  where
    imp :: String -> Int
    imp ('I':'X':r) = 9 + imp r
    imp ('I':'V':r) = 4 + imp r
    imp ('X':'C':r) = 90 + imp r
    imp ('X':'L':r) = 40 + imp r
    imp ('C':'M':r) = 900 + imp r
    imp ('C':'D':r) = 400 + imp r
    imp ('I':r) = 1 + imp r
    imp ('V':r) = 5 + imp r
    imp ('X':r) = 10 + imp r
    imp ('L':r) = 50 + imp r
    imp ('C':r) = 100 + imp r
    imp ('D':r) = 500 + imp r
    imp ('M':r) = 1000 + imp r
    imp [] = 0
    imp _ = 0

trimlength :: [Char] -> Int
trimlength l | last l == '\r' = length l - 1
             | otherwise = length l
filedata :: String
filedata = unsafePerformIO $ readFile "089roman.txt"
lns :: [String]
lns = lines filedata
alls :: Int
alls = sum $ map trimlength lns
shorts :: Int
shorts = sum $ map (dig2cnt . fromRoman) lns
ans1 :: String
ans1 = show (alls - shorts)

-- 743
main :: IO ()
main = print ans1