Trie.hs

{-# LANGUAGE ViewPatterns #-}
import Data.List
import Data.Maybe

data Tree a = Node{value :: a, subtree :: [Tree a]}
  deriving (Eq, Show)
type Trie = Tree Char

toTrie :: String -> Trie
toTrie (reverse -> c : s) = foldl' (flip Node . (:[])) (Node c []) s

merge :: Trie -> Trie -> Trie
merge root@(Node val1 subs1) new@(Node val2 subs2)
  | isJust loc =
      root{subtree = (:delete loc' subs1) $ foldl' merge loc' subs2}
  | otherwise  = root{subtree = new : subs1} 
  where loc  = find ((==val2).value) subs1
        loc' = fromJust loc

build :: [String] -> Trie
build = foldl' merge (Node ' ' []) . map toTrie

contains :: String -> Trie -> Bool
contains (s:str) (Node _ trs) = maybe False (contains str) $ find ((==s).value) trs
contains [] _ = True

main = do
  trie <- (build . take 10000 . lines) `fmap` readFile "/usr/share/dict/words"
  print $ contains "aardvarks" trie