Implement teleporting bullets

src/Dodge/Combine.hs

@@ -21,6 +21,7 @@ import Data.Bifunctor
 import qualified Data.IntMap.Strict as IM
 --import qualified Data.IntSet as IS
 import qualified Data.Map.Strict as M
+import Data.Map.Merge.Strict
 import Data.Maybe
 import Data.List (scanl',sortOn)
 
@@ -34,21 +35,25 @@ combinationsTrie = foldr
 -- trie going through each combine type in your inventory in order, rather than
 -- creating all multisets of combine types.
 
-lookupItems :: [(ItemModules,CombineType,Int,Int)] -> [ ([(ItemModules,Int)],Item) ]
+lookupItems :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] 
+    -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
 lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
 
-lookupItemsUsingTrie :: [(ItemModules,CombineType,Int,Int)] 
-    -> Trie (Int,CombineType) Item -> [ ([(ItemModules,Int)],Item) ]
+lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] 
+    -> Trie (Int,CombineType) Item 
+    -> [ ([(M.Map ModuleSlot ItemModule,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 -> [[(ItemModules,CombineType,Int,Int)]]
+invertListInvMult :: IM.IntMap Item 
+    -> [[(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]]
 invertListInvMult = powlistUpToN 4 . invertListInv
 
-invertListInv :: IM.IntMap Item -> [(ItemModules,CombineType,Int,Int)]
+invertListInv :: IM.IntMap Item 
+    -> [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]
 invertListInv = IM.foldrWithKey
     (\k it -> ((_itModules it,_itType it, k, itStackAmount it) :) )
     []
@@ -60,29 +65,45 @@ combineItemListYou :: World -> [([Int],Item)]
 combineItemListYou = map (second fst) . combineItemListYou'
 
 combineItemListYou' :: World -> [([Int],(Item,[String]))]
-combineItemListYou' = concatMap addModules . concatMap lookupItems . invertListInvMult . yourInv
+combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv
 
-addModules :: ([(ItemModules,Int)],Item) -> [([Int],(Item,[String]))]
-addModules (ps,it) = (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules]
+addModules :: ([(M.Map ModuleSlot ItemModule,Int)],Item) 
+    -> ([Int],(Item,[String]))
+addModules (ps,it) = (is , (applyModules newm it, ss))
   where
     (ms,is) = unzip ps
-    combinedmodules = foldr f [(_itModules it,[])] ms
-    f :: ItemModules -> [(ItemModules,[String])] -> [(ItemModules,[String])]
-    f ims imss = concatMap (g ims) imss
-    g ims (ims',s) = map (second (s++)) $ combineModules ims ims'
+    m = ([],_itModules it)
+    (ss,newm) = foldr f m ms
+    f m' (s,m'') = (s ++ s',m''')
+      where
+        (s',m''') = combineModules m' m''
 
-combineModules :: ItemModules -> ItemModules -> [(ItemModules,[String])]
-combineModules (ItemModules a1 b1) (ItemModules a2 b2)
-    = [(ItemModules a b,as++bs) | (a,as) <- combineModule a1 a2
-        , (b,bs) <- combineModule b1 b2]
+applyModules :: M.Map ModuleSlot ItemModule -> Item -> Item
+applyModules ms it = foldr f (it & itModules .~ ms) ms
+  where
+    f m = fromMaybe id (m ^? modModification)
+--    (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'
 
-combineModule :: ItemModule a -> ItemModule a -> [(ItemModule a,[String])]
-combineModule ItemModule{_modName=ss} BlockedModule = [(BlockedModule, "WARNING:REMOVES":ss)]
-combineModule _ BlockedModule = [(BlockedModule, [])]
-combineModule BlockedModule m = [(m,[])]
-combineModule DefaultModule m = [(m,[])]
-combineModule ItemModule{_modName=ss} m@ItemModule{} = [(m,"WARNING:REMOVES":ss)]
-combineModule m _ = [(m,[])]
+combineModules :: M.Map ModuleSlot ItemModule 
+    -> M.Map ModuleSlot ItemModule 
+    -> ([String],M.Map ModuleSlot ItemModule)
+combineModules = mergeA 
+    (traverseMaybeMissing f)
+    (traverseMissing g)
+    (zipWithAMatched h)
+  where
+    f _ ItemModule{_modName=ss} = ("WARNING:REMOVES":ss,Nothing)
+    f _ _ = ([],Nothing)
+    g _ m = ([], m)
+    h _ ItemModule{_modName=ss} im@ItemModule{} = ("WARNING:REMOVES":ss,im)
+    h _ _ im@ItemModule{} = ([],im)
+    h _ im _ = ([],im)
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _inventoryMode w of