This must be fixed

Huffman.hs

import Data.List
 
-----------Freq type----------------------
data Freq = Freq {
	frequency :: Int,
	symbol :: Char
}deriving (Show)
 
instance Eq Freq where
	a == b = (frequency a) == (frequency b)
 
 
instance Ord Freq where
	a >  b  = (frequency a) >  (frequency	 b)
	a >= b  = (frequency a) >= (frequency b)
	a <  b  = (frequency a) <  (frequency b)
	a <= b  = (frequency a) <= (frequency b)
 
 
-----------Tree type----------------------
data Tree a = Node a (Tree a) (Tree a) | Leaf a
	deriving (Show)
 
 
instance Eq a => Eq (Tree a) where
	(==) a b = (node a) == (node b)
 
 
 
node x = case x of
	(Node n _ _) -> n
	(Leaf n) -> n
 
instance Ord a => Ord (Tree a) where
	left >= right =  (node left) >= (node right)
	left <  right =  (node left) < (node right)
	left >  right =  (node left) > (node right)
	left <= right =  (node left) <= (node right)
 
 
 
 
---------------Utilities for Trees--------------------------
merge:: Tree Freq -> Tree Freq -> Tree Freq 
merge a b
	| a <= b = Node (Freq ww '*') a b
	| otherwise = Node (Freq ww '*') b a
		where ww = (frequency (node a)) + (frequency (node a))
 
 
qsort::Ord a => [a] -> [a]
qsort (x:xs) = less ++ [x] ++ great 
	where
		less = qsort [y | y <- xs, y < x]
		great = qsort [y | y <- xs, y >= x]
qsort [] = []
 
 
 
 
---------------------Frequencies----------------------------
rmdups :: Eq a => [a] -> [a]
rmdups [] = []
rmdups (x:xs) = x : rmdups (filter(/= x) xs)
 
 
count :: Eq a => a -> [a] -> Int
count n [] = 0
count n (x:xs) 
	| n == x = 1 + count n xs
   	| otherwise = count n xs
 
 
toFreqs s =
	let unique = rmdups s in
		zipWith (\x y-> Freq x y) (map (\x-> count x s) unique) unique
 
 
 
 
-------------Functions-------------------------------
 
 
 
huffman :: [Tree Freq] -> [Tree Freq]
huffman(f1:f2:fs)
	| length fs /= 0 = huffman $ qsort $ (merge f1 f2):fs
	| otherwise = huffman $ [merge f1 f2]
huffman f = f
 
 
 
 
 
x `endsWith` y = (take (length y) (reverse x)) == (reverse y)
 
encode:: Tree Freq -> Freq -> String
encode (Node n left right) w = oneOf ('0':(encode left w)) ('1':(encode right w))
	where oneOf x y
		| y `endsWith` "WRONG-LEAF" = x
		| otherwise = y
encode (Leaf l) w
	| (symbol l) == (symbol w) = ""
	| otherwise = "WRONG-LEAF"
 
 
 
 
 
 
 
 
 
 
 
test = [
	(Freq 5 'A'),
	(Freq 2 'B'),
	(Freq 2 'R'),
	(Freq 1 'C'),
	(Freq 1 'D')
	]
 
getCode::[(Char, String)] -> Char -> String
getCode codes x = snd $ (filter (\(symb, code) -> symb == x) codes)!!0
 
 
 
main = do
	inp <- getLine 
	let test = toFreqs inp
 
	let huffTree = (huffman (map Leaf test)) !! 0
	let codes = map (encode  huffTree) test
 
	let codesTuples = zipWith (\x y-> (symbol x, y) ) test codes
	let letteredCodes = zipWith (\x y-> [(symbol x)] ++ ":" ++ y) test codes
 
	putStrLn $ foldr (++) "" $ map (\s->s ++ "\n") letteredCodes
	let encoded = map (getCode codesTuples) inp
	print $ foldr (++) "" encoded