1  --
   2  -- Homework #18: http://hvprogrammers.org/homework-18.html
   3  --   by Frank W.
   4  --
   5  
   6  module Main where
   7  
   8  data Tree = Node Tree Tree | Leaf Char
   9  
  10  -- Turn a pre-order traversal into a (tree, leftovers) pair
  11  parse :: String -> (Tree, String)
  12  parse ('*' : rest) = let (l, rest_l) = parse rest in
  13                       let (r, rest_r) = parse rest_l in
  14                       (Node l r, rest_r)
  15  parse (c : rest)   = (Leaf c, rest)
  16  
  17  -- Decode one character's worth of bits into a (char, leftovers) pair
  18  decode1 :: Tree -> String -> (Char, String)
  19  decode1 (Leaf c)   rest         = (c, rest)
  20  decode1 (Node l _) ('0' : rest) = decode1 l rest
  21  decode1 (Node _ r) ('1' : rest) = decode1 r rest
  22  
  23  -- Decode an entire bit string
  24  decode :: Tree -> String -> String
  25  decode _ "" = ""
  26  decode t bits = let (c, rest) = decode1 t bits in c : decode t rest
  27  
  28  -- Remove everything including and after the first newline
  29  trim :: String -> String
  30  trim = takeWhile (/= '\n')
  31  
  32  main :: IO ()
  33  main = do pre <- getLine
  34            bits <- getLine
  35            let (tree, "") = parse $ trim pre
  36            putStrLn $ decode tree $ trim bits