Defunction-ify item modules, requires more cleanup

src/Dodge/Combine.hs

@@ -12,7 +12,8 @@ import Dodge.Base.You
 import Dodge.Data
 import Dodge.Item.Amount
 import Dodge.Inventory.ItemSpace
---import Dodge.Combine.Data
+import Dodge.Combine.Module
+import Dodge.Combine.Data
 import Multiset
 import SimpleTrie
 
@@ -25,7 +26,7 @@ import Data.Map.Merge.Strict
 import Data.Maybe
 import Data.List (scanl',sortOn)
 
-combinationsTrie :: Trie (Int,CombineType) Item
+combinationsTrie :: Trie (Int,ItemBaseType) Item
 combinationsTrie = foldr 
     (uncurry insertInTrie . first (sortOn snd)) 
     emptyTrie
@@ -35,25 +36,25 @@ combinationsTrie = foldr
 -- trie going through each combine type in your inventory in order, rather than
 -- creating all multisets of combine types.
 
-lookupItems :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] 
-    -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
+lookupItems :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] 
+    -> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
 lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
 
-lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] 
-    -> Trie (Int,CombineType) Item 
-    -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
+lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] 
+    -> Trie (Int,ItemBaseType) Item 
+    -> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
 lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
 lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do
     n' <- [1..min n 4]
     let is = replicate n' (mods,i)
     concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
 
-invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]]
+invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]]
 invertListInvMult = powlistUpToN 4 . invertListInv
 
-invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]
+invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]
 invertListInv = IM.foldrWithKey
-    (\k it -> ((_itModules it,_itType it, k, itStackAmount it) :) )
+    (\k it -> ((_iyModules $ _itType it,_iyBase $ _itType it, k, itStackAmount it) :) )
     []
 
 -- gives a list of indices-item pairs.
@@ -65,21 +66,21 @@ combineItemListYou = map (second fst) . combineItemListYou'
 combineItemListYou' :: World -> [([Int],(Item,[String]))]
 combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv
 
-addModules :: ([(M.Map ModuleSlot ItemModule,Int)],Item) 
+addModules :: ([(M.Map ModuleSlot ItemModuleType,Int)],Item) 
     -> ([Int],(Item,[String]))
 addModules (ps,it) = (is , (applyModules newm it, ss))
   where
     (ms,is) = unzip ps
-    m = ([],_itModules it)
+    m = ([],_iyModules $ _itType it)
     (ss,newm) = foldr f m ms
     f m' (s,m'') = (s ++ s',m''')
       where
         (s',m''') = combineModules m' m''
 
-applyModules :: M.Map ModuleSlot ItemModule -> Item -> Item
-applyModules ms it = foldr f (it & itModules .~ ms) ms
+applyModules :: M.Map ModuleSlot ItemModuleType -> Item -> Item
+applyModules ms it = foldr f (it & itType . iyModules .~ ms) ms
   where
-    f m = fromMaybe id (m ^? modModification)
+    f m = fromMaybe id (fromModuleType m ^? modModification)
 --    (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules]
 --  where
 --    (ms,is) = unzip ps
@@ -88,20 +89,22 @@ applyModules ms it = foldr f (it & itModules .~ ms) ms
 --    f ims imss = concatMap (g ims) imss
 --    g ims (ims',s) = map (second (s++)) $ combineModules ims ims'
 
-combineModules :: M.Map ModuleSlot ItemModule 
-    -> M.Map ModuleSlot ItemModule
-    -> ([String],M.Map ModuleSlot ItemModule)
+combineModules :: M.Map ModuleSlot ItemModuleType 
+    -> M.Map ModuleSlot ItemModuleType
+    -> ([String],M.Map ModuleSlot ItemModuleType)
 combineModules = mergeA 
     (traverseMaybeMissing f)
     (traverseMissing g)
     (zipWithAMatched h)
   where
-    f _ ItemModule{_modName=ss} = ("WARNING:REMOVES":ss,Nothing)
+    f _ imt | imt /= EMPTYMODULE = ("WARNING:REMOVES":ss imt,Nothing)
     f _ _ = ([],Nothing)
     g _ m = ([], m)
-    h _ ItemModule{_modName=ss} im@ItemModule{} = ("WARNING:REMOVES":ss,im)
-    h _ _ im@ItemModule{} = ([],im)
+    h _ im1 im2 | im1 /= EMPTYMODULE && im2 /= EMPTYMODULE 
+        = ("WARNING:REMOVES":ss im1,im2)
+    h _ _ im | im /= EMPTYMODULE = ([],im)
     h _ im _ = ([],im)
+    ss imt = _modName $ fromModuleType imt
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _hudElement (_hud w) of