module CreateTree where import qualified Data.Map as M import Data.List import WURFLTypes test = [("CDM_8150",1),("CDM_8150_ver2",2),("CDM_8300",3),("d",4),("de",5),("def",6),("defg",7),("abcd",8),("abce",9)] --test = [ ("CHTML Generic",1) -- , ("Mozilla/5.0 (iPhone;",2) -- ,("Nokia",3) -- ,("Nokia 20",4) -- ,("Nokia 30",5) -- ] --data MyTree a = MyNode String (Maybe a) [MyTree a] deriving(Show) analyze :: [(String,a)] -> [Tree a] analyze l = map asTree . M.toList . foldr addElem M.empty $ l where asTree :: (String,[(String,a)]) -> Tree a asTree (r,a:[]) = Node (r ++ fst a) (Just . snd $ a) [] asTree (r,l) = let (children,node) = partition ((/=) "" . fst ) l in if length node == 1 then Node r (Just . snd . head $ node) (analyze children) else Node r Nothing (analyze children) addElem :: (String,a) -> M.Map String [(String,a)] -> M.Map String [(String,a)] addElem (e,v) m = M.insertWith (++) (prefix e) [(tail e,v)] m prefix :: String -> String prefix e = head e : "" simplifyTree :: Tree a -> [Tree a] simplifyTree (Node s a []) = [Node s a []] simplifyTree (Node s a@(Just _) l) = [Node s a (concatMap simplifyTree l)] simplifyTree (Node s Nothing (Node s' a l:[])) = simplifyTree $ Node (s++s') a l simplifyTree (Node s Nothing l) =[Node s Nothing (concatMap simplifyTree l)] --simplifyTree a = [a] --main :: IO () --main = do -- print . concatMap simplifyTree . analyze $ test