-------------------------------------------------------------------------
--  
--         CodeTable.hs                         
--                              
--         Converting a Huffman tree to a ord table.            
--                              
--         (c) Addison-Wesley, 1996-2011.                   
--                              
-------------------------------------------------------------------------

module CodeTable ( codeTable ) where

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

-- Making a table from a Huffman tree.              

codeTable :: Tree -> Table

codeTable :: Tree -> Table
codeTable = HCode -> Tree -> Table
convert []

-- Auxiliary function used in conversion to a table. The first argument is
-- the HCode which codes the path in the tree to the current Node, and so
-- codeTable is initialised with an empty such sequence.        

convert :: HCode -> Tree -> Table

convert :: HCode -> Tree -> Table
convert HCode
cd (Leaf Char
c Int
n) =  [(Char
c,HCode
cd)]
convert HCode
cd (Node Int
n Tree
t1 Tree
t2)
    = (HCode -> Tree -> Table
convert (HCode
cdHCode -> HCode -> HCode
forall a. [a] -> [a] -> [a]
++[Bit
L]) Tree
t1) Table -> Table -> Table
forall a. [a] -> [a] -> [a]
++ (HCode -> Tree -> Table
convert (HCode
cdHCode -> HCode -> HCode
forall a. [a] -> [a] -> [a]
++[Bit
R]) Tree
t2)


-- Show functions                       
-- ^^^^^^^^^^^^^^

-- Show a tree, using indentation to show structure.        
--                              
showTree :: Tree -> String

showTree :: Tree -> String
showTree Tree
t = Int -> Tree -> String
showTreeIndent Int
0 Tree
t

-- The auxiliary function showTreeIndent has a second, current 
-- level of indentation, as a parameter.                            

showTreeIndent :: Int -> Tree -> String

showTreeIndent :: Int -> Tree -> String
showTreeIndent Int
m (Leaf Char
c Int
n) 
  = Int -> String
spaces Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
showTreeIndent Int
m (Node Int
n Tree
t1 Tree
t2)
  = Int -> Tree -> String
showTreeIndent (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Tree
t1 String -> String -> String
forall a. [a] -> [a] -> [a]
++
    Int -> String
spaces Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    Int -> Tree -> String
showTreeIndent (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Tree
t2

-- A String of n spaces.

spaces :: Int -> String

spaces :: Int -> String
spaces Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '

-- To show a sequence of Bits.                  

showCode :: HCode -> String
showCode :: HCode -> String
showCode = (Bit -> Char) -> HCode -> String
forall a b. (a -> b) -> [a] -> [b]
map Bit -> Char
conv
       where
       conv :: Bit -> Char
conv Bit
R = Char
'R'
       conv Bit
L = Char
'L'

-- To show a table of codes.

showTable :: Table -> String                        
showTable :: Table -> String
showTable 
  = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Table -> [String]) -> Table -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, HCode) -> String) -> Table -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char, HCode) -> String
showPair
    where
    showPair :: (Char, HCode) -> String
showPair (Char
ch,HCode
co) = [Char
ch] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HCode -> String
showCode HCode
co String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"