Commit before changing combining code

src/Dodge/Combine.hs

@@ -25,7 +25,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Data.Map.Merge.Strict
 import Data.Maybe
-import Data.List (scanl',sortOn)
+import Data.List (scanl',sortOn,sort)
 
 combinationsTrie :: Trie (Int,ItemBaseType) Item
 combinationsTrie = foldr 
@@ -79,16 +79,7 @@ addModules (ps,it) = (is , (applyModules newm it, ss))
         (s',m''') = combineModules m' m''
 
 applyModules :: M.Map ModuleSlot ItemModuleType -> Item -> Item
-applyModules ms it = foldr f (it & itType . iyModules .~ ms) ms
-  where
-    f m = moduleModification m
---    (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules]
---  where
---    (ms,is) = unzip ps
---    combinedmodules = foldr f [(_itModules it,[])] ms
---    f :: M.Map ModuleSlot ItemModule -> [(M.Map ModuleSlot ItemModule,[String])] -> [(M.Map ModuleSlot ItemModule,[String])]
---    f ims imss = concatMap (g ims) imss
---    g ims (ims',s) = map (second (s++)) $ combineModules ims ims'
+applyModules ms it = foldr moduleModification (it & itType . iyModules .~ ms) ms
 
 combineModules :: M.Map ModuleSlot ItemModuleType 
     -> M.Map ModuleSlot ItemModuleType

src/SimpleTrie.hs

@@ -1,26 +1,34 @@
 {-# LANGUAGE TemplateHaskell #-}
 module SimpleTrie where
-import Data.Map.Strict
+import qualified Data.Map.Strict as M
 import Control.Lens
 data Trie a b = Trie
     { _trieMVal    :: Maybe b
-    , _trieChildren :: Map a (Trie a b)
+    , _trieChildren :: M.Map a (Trie a b)
     }
 makeLenses ''Trie
 
 emptyTrie :: Trie a b
-emptyTrie = Trie Nothing empty
+emptyTrie = Trie Nothing M.empty
 
 singletonTrie :: Ord a => [a] -> b -> Trie a b
-singletonTrie (k:ks) x = Trie Nothing $ singleton k $ singletonTrie ks x
-singletonTrie [] x = Trie (Just x) empty
+singletonTrie (k:ks) x = Trie Nothing $ M.singleton k $ singletonTrie ks x
+singletonTrie [] x = Trie (Just x) M.empty
 
 insertInTrie :: Ord a => [a] -> b -> Trie a b -> Trie a b
 insertInTrie [] x      = trieMVal ?~ x
-insertInTrie (k:ks) x  = trieChildren %~ insertWith f k (singletonTrie ks x)
+insertInTrie (k:ks) x  = trieChildren %~ M.insertWith f k (singletonTrie ks x)
   where
     f _ = insertInTrie ks x
 
 lookupTrie :: Ord a => [a] -> Trie a b -> Maybe b
-lookupTrie (k:ks) t = _trieChildren t !? k >>= lookupTrie ks
+lookupTrie (k:ks) t = _trieChildren t M.!? k >>= lookupTrie ks
 lookupTrie []     t = _trieMVal t
+
+multiLookupTrie :: Ord a => [a] -> Trie a b -> [([a],b)]
+multiLookupTrie  xs t@(Trie my ch)
+    | null xs || null ch = maybe [] (\y -> [([],y)]) my
+    | otherwise = let (z:zs) = xs in
+        case M.lookup z ch of
+            Nothing -> multiLookupTrie zs t
+            Just t' -> map (_1 %~ (z:)) (multiLookupTrie zs t') ++ multiLookupTrie zs t