diff --git a/ghcidOutput b/ghcidOutput index 6115bbb7c..95162759e 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1 +1 @@ -All good (614 modules, at 16:33:21) +All good (614 modules, at 16:50:05) diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index dbca11343..b6accfa93 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -5,68 +5,68 @@ import ListHelp import Dodge.Data.Item import Dodge.Data.DoubleTree import Dodge.Data.ComposedItem -import TreeHelp +--import TreeHelp import qualified Data.IntMap.Strict as IM import Control.Lens -type PCI = (ComposedItem, [ComposedItem]) +type PCI = (ComposedItem, [ComposedItem], [ComposedItem]) -type PCI' = (Item,ComposedItem, [ComposedItem]) +type PCI' = (Item,ComposedItem,[ComposedItem], [ComposedItem]) singleDT :: a -> DoubleTree a singleDT x = DT x [] [] baseComposedItem :: ItemBaseType -> PCI baseComposedItem ibt = case ibt of - HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI]) - AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI]) - AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI]) - ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, []) - _ -> (UncomposableCI, []) + HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI], []) + AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI], []) + AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI], []) + ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, [], []) + _ -> (UncomposableCI, [], []) baseCI :: Item -> PCI' -baseCI itm = let (a,b) = baseComposedItem (itm ^. itType . iyBase) - in (itm, a, b) +baseCI itm = let (a,b,c) = baseComposedItem (itm ^. itType . iyBase) + in (itm, a, b, c) joinItems :: DoubleTree PCI' -> DoubleTree PCI' -> Maybe (DoubleTree PCI') -joinItems t@(DT (itm,px,cx) ls' rs') s@(DT (_,py,_) _ _) - | py `elem` cx = Just (DT (itm,px, delete py cx) ls' (rs' ++ [s])) +joinItems t@(DT (itm,px,lc',rc') ls' rs') s@(DT (_,py,_,_) _ _) + | py `elem` rc' = Just (DT (itm,px,lc', delete py rc') ls' (rs' ++ [s])) | otherwise = checkdepth t s where checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do c <- safeHead ls d <- checkdepth a c return $ Just $ DT b (d:tail ls) rs - checktop a@(DT (_,pa,_) _ _) (DT (itm2,pb,cb) ls rs) - | pa `elem` cb = Just (DT (itm2,pb, delete pa cb) (a:ls) rs) + checktop a@(DT (_,pa,_,_) _ _) (DT (itm2,pb,lc,rc) ls rs) + | pa `elem` lc = Just (DT (itm2,pb, delete pa lc,rc) (a:ls) rs) | otherwise = Nothing -joinItems' :: DoubleTree PCI -> DoubleTree PCI -> Maybe (DoubleTree PCI) -joinItems' t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _) - | py `elem` cx = Just (DT (px, delete py cx) ls' (rs' ++ [s])) - | otherwise = checkdepth t s - where - checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do - c <- safeHead ls - d <- checkdepth a c - return $ Just $ DT b (d:ls) rs - checktop a@(DT (pa,_) _ _) (DT (pb,cb) ls rs) - | pa `elem` cb = Just (DT (pb, delete pa cb) (a:ls) rs) - | otherwise = Nothing - -joinItems'' :: Tree PCI -> Tree PCI -> Maybe (Tree PCI) -joinItems'' t@(Node (px,cx) xs) s@(Node (py,_) _) --- | fst y `elem` cx = Just (Node (px, delete y cx) (xs ++ [s])) - | py `elem` cx = Just (Node (px, delete py cx) (xs ++ [s])) - | otherwise = checkdepth t s - where - checkdepth a a'@(Node b cs) = fromMaybe (checktop a a') $ do - c <- safeHead cs - d <- checkdepth a c - return $ Just $ Node b (d:cs) - checktop a@(Node (pa,_) _) (Node (pb,cb) bs) - | pa `elem` cb = Just (Node (pb, delete pa cb) (a:bs)) - | otherwise = Nothing +--joinItems' :: DoubleTree PCI -> DoubleTree PCI -> Maybe (DoubleTree PCI) +--joinItems' t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _) +-- | py `elem` cx = Just (DT (px, delete py cx) ls' (rs' ++ [s])) +-- | otherwise = checkdepth t s +-- where +-- checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do +-- c <- safeHead ls +-- d <- checkdepth a c +-- return $ Just $ DT b (d:ls) rs +-- checktop a@(DT (pa,_) _ _) (DT (pb,cb) ls rs) +-- | pa `elem` cb = Just (DT (pb, delete pa cb) (a:ls) rs) +-- | otherwise = Nothing +-- +--joinItems'' :: Tree PCI -> Tree PCI -> Maybe (Tree PCI) +--joinItems'' t@(Node (px,cx) xs) s@(Node (py,_) _) +---- | fst y `elem` cx = Just (Node (px, delete y cx) (xs ++ [s])) +-- | py `elem` cx = Just (Node (px, delete py cx) (xs ++ [s])) +-- | otherwise = checkdepth t s +-- where +-- checkdepth a a'@(Node b cs) = fromMaybe (checktop a a') $ do +-- c <- safeHead cs +-- d <- checkdepth a c +-- return $ Just $ Node b (d:cs) +-- checktop a@(Node (pa,_) _) (Node (pb,cb) bs) +-- | pa `elem` cb = Just (Node (pb, delete pa cb) (a:bs)) +-- | otherwise = Nothing joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a] joinItemsInList f xs = snd $ h (xs,[]) @@ -114,7 +114,7 @@ prettyDT f (DT x l r) = concatMap (map ('/':) . prettyDT f) r ++ (f x : concatMap (map ('\\':) . prettyDT f) l) invTree :: IM.IntMap Item -> [String] -invTree = concatMap (prettyDT (\(itm,_,_) -> show (_itType itm))) . +invTree = concatMap (prettyDT (\(itm,_,_,_) -> show (_itType itm))) . joinItemsInList joinItems . IM.elems . fmap (singleDT . baseCI) indentInv :: IM.IntMap Item -> IM.IntMap String