-------------------------------------------------------------------------
--  
--         Coding.hs                            
--                              
--         Huffman coding in Haskell.                   
--         The top-level functions for coding and decoding.     
--                              
--         (c) Addison-Wesley, 1996-2011.                   
--  
-------------------------------------------------------------------------

module Coding ( codeMessage , decodeMessage ) where

import Types ( Tree(Leaf,Node), Bit(L,R), HCode, Table )

-- Code a message according to a table of codes.            

codeMessage :: Table -> [Char] -> HCode

codeMessage :: Table -> [Char] -> HCode
codeMessage Table
tbl = [HCode] -> HCode
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([HCode] -> HCode) -> ([Char] -> [HCode]) -> [Char] -> HCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> HCode) -> [Char] -> [HCode]
forall a b. (a -> b) -> [a] -> [b]
map (Table -> Char -> HCode
lookupTable Table
tbl)

-- lookupTable looks up the meaning of an individual char in
-- a Table.         

lookupTable :: Table -> Char -> HCode

lookupTable :: Table -> Char -> HCode
lookupTable [] Char
c = [Char] -> HCode
forall a. HasCallStack => [Char] -> a
error [Char]
"lookupTable"
lookupTable ((Char
ch,HCode
n):Table
tb) Char
c
  | (Char
chChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c)     = HCode
n         
  | Bool
otherwise   = Table -> Char -> HCode
lookupTable Table
tb Char
c  


-- Decode a message according to a tree.                
--                              
-- The first tree arguent is constant, being the tree of codes; 
-- the second represents the current position in the tree relative  
-- to the (partial) HCode read so far.               


decodeMessage :: Tree -> HCode -> String

decodeMessage :: Tree -> HCode -> [Char]
decodeMessage Tree
tr
  = Tree -> HCode -> [Char]
decodeByt Tree
tr
    where

    decodeByt :: Tree -> HCode -> [Char]
decodeByt (Node Int
n Tree
t1 Tree
t2) (Bit
L:HCode
rest)
      = Tree -> HCode -> [Char]
decodeByt Tree
t1 HCode
rest

    decodeByt (Node Int
n Tree
t1 Tree
t2) (Bit
R:HCode
rest)
      = Tree -> HCode -> [Char]
decodeByt Tree
t2 HCode
rest

    decodeByt (Leaf Char
c Int
n) HCode
rest
      = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Tree -> HCode -> [Char]
decodeByt Tree
tr HCode
rest

    decodeByt Tree
t [] = []