Allow for stacking of items and combining sensibly

src/Dodge/Combine.hs

@@ -15,32 +15,66 @@ import qualified Data.Map.Strict as M
 import Data.Maybe
 
 itemCombinations :: [ (M.Map CombineType Int, Item) ]
-itemCombinations = map (first toMultiset)
-    [ p [PIPE,HARDWARE] bangStick
+itemCombinations = map (first toMultiset) $
+    [ p [PIPE,HARDWARE] (bangStick 1)
     , p [LONGPIPE,HARDWARE] bangCane
     , p [VERYLONGPIPE,HARDWARE] bangRod
     , p [PIPE,PIPE]     $ makeTypeCraft LONGPIPE
     , p [LONGPIPE,PIPE] $ makeTypeCraft VERYLONGPIPE
-    ]
+    ] ++
+    map (\i -> ([PIPE,BANGSTICK i],bangStick (i+1))) [1..8]
   where
     p = (,)
 
+combinations :: [(M.Map CombineType Int, CombineType)]
+combinations = map (second _itCombineType) itemCombinations
+
 combineToItem :: M.Map CombineType Int -> Maybe Item
 combineToItem m = lookup m itemCombinations
 
-combineItemList :: IM.IntMap CombineType -> [([Int],Item)]
-combineItemList m = mapMaybe (pushoutmaybe . second (combineToItem . toMultiset) . unzip)
+combineItemList :: IM.IntMap Item -> [([Int],Item)]
+combineItemList m = mapMaybe (pushoutmaybe . second combineToItem)
+    . concatMap itemsMultisets
     . powlistN 4
     $ IM.toList m
   where
     pushoutmaybe (_,Nothing) = Nothing
     pushoutmaybe (x,Just y)  = Just (x,y)
+--combineItemList :: IM.IntMap CombineType -> [([Int],Item)]
+--combineItemList m = mapMaybe (pushoutmaybe . second (combineToItem . toMultiset) . unzip)
+--    . powlistN 4
+--    $ IM.toList m
+--  where
+--    pushoutmaybe (_,Nothing) = Nothing
+--    pushoutmaybe (x,Just y)  = Just (x,y)
+
+
+-- multiple multisets produced by a single item stack are combined using the list monad
+itemsMultisets :: [(Int,Item)] -> [([Int],M.Map CombineType Int)]
+itemsMultisets = map mconcat . mapM itemMultisets
+
+-- individual items can produce multiple multisets if they are a stack of more
+-- than one item
+itemMultisets :: (Int,Item) -> [([Int],M.Map CombineType Int)]
+itemMultisets (i,it) = case it ^? itConsumption . itAmount' of
+    Nothing -> [ ([i], M.singleton thetype 1 ) ]
+    Just n  -> map (\k -> (replicate k i, M.singleton thetype k)) [1..n]
+  where
+    thetype = _itCombineType it
+
+
+itemTypeAmounts :: Item -> [[CombineType]]
+itemTypeAmounts it = case it ^? itConsumption . itAmount' of
+    Nothing -> [[thetype]]
+    Just i  -> map (flip replicate thetype) [1 .. i]
+  where
+    thetype = _itCombineType it
 
 combineItemListYou :: World -> [([Int],Item)]
-combineItemListYou = combineItemList . fmap _itCombineType . yourInv
+combineItemListYou = combineItemList . yourInv
 
 combineListYou :: World -> [([Int],CombineType)]
-combineListYou = combineList . fmap _itCombineType . yourInv
+combineListYou = fmap (second _itCombineType) . combineItemListYou
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _inventoryMode w of
@@ -51,3 +85,6 @@ enterCombineInv :: World -> World
 enterCombineInv w = w & inventoryMode .~ CombineInventory mi
   where
     mi = const 0 <$> listToMaybe (combineListYou w)
+
+combine :: M.Map CombineType Int -> Maybe CombineType
+combine m = lookup m combinations