オフラインリアルタイムどう書く第8回の参考問題を Haskell で解く

問題は http://nabetani.sakura.ne.jp/hena/ord8entco/

off-line08_ref.hs

import Data.Char
import Data.List

codeTable :: [(String, Char, Int)]
codeTable = [("000",     't', 3),
             ("0010",    's', 4),
             ("0011",    'n', 4),
             ("0100",    'i', 4),
             ("01010",   'd', 5),
             ("0101101", 'c', 7),
             ("010111",  'l', 6),
             ("0110",    'o', 4),
             ("0111",    'a', 4),
             ("10",      'e', 2),
             ("1100",    'r', 4),
             ("1101",    'h',4)]

-- ex : stringToBit "1a"  =>  "10000110"
stringToBit :: String -> String
stringToBit cs = concatMap digitToBit cs
  where
    digitToBit x = take 4 $ loop (digitToInt x) ++ repeat '0'
    loop n
      | n < 2 = [intToDigit n]
      | otherwise = (intToDigit $ rem n 2) : loop (div n 2)

-- ex : inputToString "16d9d4fbd"  =>  "ethanol:30"
inputToString :: String -> String
inputToString cs = loop (stringToBit cs) "" 0
  where
    loop "" _ _ = "*invalid*"
    loop bit str n
      | isPrefixOf "111" bit = (reverse str) ++ (':' : show (n + 3))
      | otherwise = search codeTable bit str n

    search [] _ _ _ = "*invalid*"
    search ((cd, c, m) : tbl) bit str n
      | isPrefixOf cd bit = loop (drop m bit) (c : str) (n + m)
      | otherwise = search tbl bit str n

main :: IO ()
main = do
  strs <- readFile "off-line08_ref_testData.txt"
  mapM_ f $ map words $ lines strs
    where f [n, i, o] = putStrLn (n ++ " " ++ (show $ inputToString i == o))

off-line08_ref_testData.txt

0	16d9d4fbd	ethanol:30
1	df	e:5
2	ad7	c:10
3	870dcb	t:6
4	880f63d	test:15
5	a57cbe56	cat:17
6	36abef2	roll:23
7	ad576cd8	chant:25
8	3e2a3db4fb9	rails:25
9	51aa3b4c2	eeeteee:18
10	ad5f1a07affe	charset:31
11	4ab8a86d7afb0f	slideshare:42
12	ac4b0b9faef	doctor:30
13	cafebabe	nlh:17
14	43e7	sra:15
15	53e7	eera:15
16	86cf	tera:16
17	b6cf	hon:15
18	0	*invalid*
19	c	*invalid*
20	d	*invalid*
21	e	*invalid*
22	babecafe	*invalid*
23	8d	*invalid*
24	ad	*invalid*
25	af	*invalid*
26	ab6e0	*invalid*
27	a4371	*invalid*
28	a4371	*invalid*
29	96e3	*invalid*
30	0dc71	*invalid*
31	2a9f51	*invalid*
32	a43fb2	*invalid*
33	ab6e75	*invalid*
34	a5dcfa	*invalid*
35	ca97	*invalid*
36	6822dcb	*invalid*