
Hi, I'm a newish Haskell hacker with way too much experience hacking Lisp. At first, I found my Haskell code looking very lisp-y. I think my code is becoming more idiomatic haskell. I would be very grateful to anyone who would take a glance at the code below and point out any un-idiomatic usages that jump out. It's a small module from a program which looks for palindromes in a list of words. Thanks very much. Cheers, David \begin{code} {-# OPTIONS -O2 -optc-O3 #-} module PrefixMap (PrefixMap,fromDistinctAscPairList,searchMap) where import Data.List import qualified Data.Map as Map import Test.HUnit \end{code} The PrefixMap datastructure implements a Prefix Tree which allows a key/value relationship. \begin{code} data PrefixMap k v = Node (Maybe v) (Map.Map k (PrefixMap k v)) deriving (Show) \end{code} A PrefixMap is built from an alphabet enumerating the possible constituents of keys and a list of pairs of keys and objects. A key is a string of elements of the alphabet. The list must be distinct and in ascending order. The constraint is not checked. \begin{code} fromDistinctAscPairList :: Ord k => [k]->[([k],v)]->PrefixMap k v fromDistinctAscPairList alphabet pairList = build alphabet Nothing (partList pairList alphabet) partList :: Ord k => [([k],v)]->[k]->[(k,[([k],v)])] partList pairs alphabet = reverse . fst $ foldl' f ([],pairs) alphabet where f (result,pairs) l = (result',rest) where (part,rest) = span ((==l) . head . fst) pairs result' = if null part then result else (l,part):result build :: Ord k => [k]->(Maybe v)->[(k,[([k],v)])]->(PrefixMap k v) build alphabet val pairs = Node val $ Map.fromDistinctAscList treePairs where treePairs = [(c,mkITree l)|(c,l)<-pairs] mkITree l = build alphabet x (partList l' alphabet) where (x,l') = findNode $ snipKeys l snipKeys :: Ord k => [([k],v)]->[([k],v)] snipKeys l = [(k,v) | (_:k,v) <- l] findNode :: Ord k => [([k], v)] -> (Maybe v, [([k], v)]) findNode l = if null suffix then (Nothing,l) else ((Just $ snd.head $ suffix),prefix++(tail suffix)) where (prefix,suffix) = span (not.null.fst) l \end{code} searchMap applies a function to each object in the PrefixTree that is on the path specified by the key and the subtree below it and returns a list of the results. \begin{code} searchMap :: Ord k => (v -> vv) -> [k] -> PrefixMap k v -> [vv] searchMap f [] t = walk f t [] searchMap f (k:ks) (Node v al) = maybe rest ((:rest) . f) v where rest = maybe [] (searchMap f ks) (Map.lookup k al) walk :: (a -> b) -> PrefixMap k a -> [b] -> [b] walk f (Node Nothing al) z = Map.fold (walk f) z al walk f (Node (Just x) al) z = Map.fold (walk f) (f x:z) al test1 = TestCase (do input <- readFile "words.txt" let dict = words input pairs = zip dict dict alpha = ['a'..'z'] ftree = fromDistinctAscPairList alpha pairs fAnswer = searchMap id "assert" ftree rtree = fromDistinctAscPairList alpha $ sort $ zip (map reverse dict) dict rAnswer = searchMap id "tressa" rtree assertEqual "forward search" ["as","ass","assertedly","asserted", "asserters","asserter","asserting", "assertions","assertion","assertively", "assertivenesses","assertiveness", "assertive","assertors","assertor", "asserts","assert"] fAnswer assertEqual "reverse search" ["reassert","overassert","assert"] rAnswer ) tests = TestList [TestLabel "Tree Test" test1] \end{code} \end{document} -------------------------------- David F. Place mailto:d@vidplace.com