WURFL-0.1: src/CreateTree.hs

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