Tries

trie.hs

import Data.List (insertBy)
import Data.Ord (comparing)

data Trie = Trie {final :: Bool, children::[(Char,Trie)]}
    deriving Show


empty :: Trie
empty = Trie {final=False, children=[]}


add_child :: Char -> Trie -> Trie
add_child c t = t {children = insertBy (comparing fst) (c, empty) (children t)}


update_alist :: Eq a => a -> [(a,b)] -> b -> [(a,b)]
update_alist k alist v =  h ++ (k, v):xs
    where (h, (_:xs)) = break (\e -> fst e == k) alist


insert :: Trie -> String -> Trie
insert t [] = t {final = True}
insert t str@(c:cs) = case lookup c children' of
        Nothing ->  insert (add_child c t) str
        Just child -> t {children = update_alist c children' (insert child cs)}
    where
        children' = children t


from_words :: [String] -> Trie
from_words = foldl insert empty


tree_to_list :: [String] -> String -> Trie -> [String]
tree_to_list result accu t
        | final t = (reverse accu):result ++ concatMap node_to_list children'
        | otherwise = concatMap node_to_list children'
        where
        children' = children t
        node_to_list (c, t') = tree_to_list result (c:accu) t'
   

main :: IO ()                   
main = do
    let t = from_words [ "bonjour", "grue", "gruik", "bonbon", "bob", "bon","bonsoir"]
    print $ tree_to_list [] "" t