Cleanup invLDT

ghcidOutput

@@ -1 +1 @@
-All good (604 modules, at 13:20:50)
+All good (604 modules, at 13:28:17)

src/Dodge/Creature/Picture.hs

@@ -173,4 +173,4 @@ shoulderSH = translateSHz 20
 
 drawEquipment :: Creature -> SPic
 {-# INLINE drawEquipment #-}
-drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a,b,_) -> (a,b))) (invLDT'' $ _crInv cr)
+drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a,b,_) -> (a,b))) (invLDT $ _crInv cr)

src/Dodge/Item/Draw.hs

@@ -16,8 +16,7 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture
 
-itemEquipPict :: Creature -> LabelDoubleTree ItemLink ComposedItem
+itemEquipPict :: Creature -> LabelDoubleTree ItemLink ComposedItem -> SPic
-    -> SPic
 itemEquipPict cr itmtree = case itm ^. itUse of
     UseHeld{} | itm ^? itLocation . ilIsRoot == Just True 
         -> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)

src/Dodge/Item/Grammar.hs

@@ -1,79 +1,80 @@
 module Dodge.Item.Grammar (
-    invLDT',
+    invLDT,
-    invLDT'',
     invTrees,
     invIndentIM,
     invAdj,
     invRootMap,
 ) where
 
-import Dodge.Item.Orientation
---import qualified Linear.Quaternion as Q
---import Geometry.Data
 import Control.Applicative
 import Data.Bifunctor
-
-import LensHelp
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.Item
 import Dodge.DoubleTree
+import Dodge.Item.Orientation
+import LensHelp
 import ListHelp
 
-
+useBreakListsLinkTest :: [(ItemStructuralFunction, a)] -> [(ItemStructuralFunction, a)] -> LinkTest a
-useBreakListsLinkTest :: [(ItemStructuralFunction,a)] -> [(ItemStructuralFunction,a)] -> LinkTest a
 useBreakListsLinkTest llist rlist = LTest ltest rtest
   where
-    ltest (_,sf,_) = do
+    ltest (_, sf, _) = do
         let xs = dropWhile ((/= sf) . fst) llist
-        (_,linktype) <- safeHead xs
+        (_, linktype) <- safeHead xs
         return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
-    rtest (_,sf,_) = do
+    rtest (_, sf, _) = do
         let xs = dropWhile ((/= sf) . fst) rlist
-        (_,linktype) <- safeHead xs
+        (_, linktype) <- safeHead xs
         return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
 
-
 basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
 basePartiallyComposedItem' itm = case itm ^. itType of
-    HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest 
+    HELD _ ->
-        (map (\(i,a) -> noa (AmmoMagSF a) (AmmoInLink i a))
+        ( itm
-            (IM.toList $ itm ^. itUse . heldAmmoTypes))
+        , WeaponPlatformSF
-        [noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
+        , useBreakListsLinkTest
+            ( map
+                (\(i, a) -> noa (AmmoMagSF a) (AmmoInLink i a))
+                (IM.toList $ itm ^. itUse . heldAmmoTypes)
+            )
+            [noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
         )
     AMMOMAG _ -> ammoComposedItem' itm
-    TARGETING {} -> (itm,WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] [])
+    TARGETING{} -> (itm, WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] [])
     ATTACH ZOOMSCOPE -> nolinks WeaponScopeSF
     ATTACH HOMINGMODULE -> nolinks $ AmmoTargetingSF ProjectileAmmo
     ATTACH AUGMENTEDHUD -> nolinks AugmentedHUDSF
-    BULLETMOD BulletModTrajectory {} -> nolinks $ AmmoTargetingSF BulletAmmo
+    BULLETMOD BulletModTrajectory{} -> nolinks $ AmmoTargetingSF BulletAmmo
-    BULLETMOD BulletModPayload {} -> nolinks $ AmmoPayloadSF BulletAmmo
+    BULLETMOD BulletModPayload{} -> nolinks $ AmmoPayloadSF BulletAmmo
-    BULLETMOD BulletModEffect {} -> nolinks $ AmmoEffectSF BulletAmmo
+    BULLETMOD BulletModEffect{} -> nolinks $ AmmoEffectSF BulletAmmo
     ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
-    ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
+    ATTACH BULLETSYNTHESIZER -> (itm, AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
-    LEFT {} -> isolate
+    LEFT{} -> isolate
-    EQUIP {} -> isolate
+    EQUIP{} -> isolate
-    CONSUMABLE {} -> isolate
+    CONSUMABLE{} -> isolate
-    CRAFT {} -> isolate
+    CRAFT{} -> isolate
---    _ -> 
   where
+    --    _ ->
+
     noa x y = (x, ILink y orientAttachment)
-    nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
+    nolinks x = (itm, x, LTest (const Nothing) (const Nothing))
-    isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
+    isolate = (itm, UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
 
 ammoComposedItem' :: Item -> PartiallyComposedItem ItemLink
 ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
     atype <- itm ^? itUse . amagType
-    return (itm
+    return
+        ( itm
         , AmmoMagSF atype
         , useBreakListsLinkTest
-            [noa (AmmoModifierSF atype) AmmoModLink
+            [ noa (AmmoModifierSF atype) AmmoModLink
-            ,noa (AmmoTargetingSF atype) AmmoTargetingLink
+            , noa (AmmoTargetingSF atype) AmmoTargetingLink
-            ,noa (AmmoPayloadSF atype) AmmoPayloadLink
+            , noa (AmmoPayloadSF atype) AmmoPayloadLink
-            ,noa (AmmoEffectSF atype) AmmoEffectLink
+            , noa (AmmoEffectSF atype) AmmoEffectLink
-            ,noa RemoteScreenSF RemoteScreenLink
+            , noa RemoteScreenSF RemoteScreenLink
             ]
             []
         )
@@ -85,14 +86,16 @@ type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDou
 leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
 leftIsParentCombine ltree rtree = do
     lu <- (ltree ^. ldtValue . _3 . tryRightLink) (rtree ^. ldtValue)
-    return $ ltree & ldtValue %~ (lu ^. luParentUpdate)
+    return $
-        & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
+        ltree & ldtValue %~ (lu ^. luParentUpdate)
+            & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
 
 rightIsParentCombine :: LDTComb (PartiallyComposedItem a) a
 rightIsParentCombine ltree rtree = do
     lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
-    return $ rtree & ldtValue %~ (lu ^. luParentUpdate)
+    return $
-        & ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))
+        rtree & ldtValue %~ (lu ^. luParentUpdate)
+            & ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))
 
 leftRightCombine ::
     LDTComb a b ->
@@ -119,24 +122,17 @@ joinItemsInList f xs = snd $ h (xs, [])
         Nothing -> h (ys, y : z : zs)
         Just w -> h (w : ys, zs)
 
-invLDT'' :: IM.IntMap Item -> [LabelDoubleTree ItemLink (PartiallyComposedItem ItemLink)]
+invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink (PartiallyComposedItem ItemLink)]
-invLDT'' = 
+invLDT =
     joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
         . fmap (singleLDT . basePartiallyComposedItem')
 
-invLDT' :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItem]
-invLDT' = map (bimap _iatType (\(x,y,_) -> (x,y))) . invLDT''
-
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
 -- consider explicitly reseting the inventory ids (but this probably really
 -- should be done upstream anyway in the actually creature inventory)
 invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree Item)
-invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) . invLDT''
+invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) . invLDT
-
---invRootMap = foldMap (dtToRootIntMap g . ldtToDT) . invLDT
---  where
---    g = _
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
@@ -144,7 +140,7 @@ invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _
 -- should be done upstream anyway in the actually creature inventory)
 invAdj :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
 invAdj im = do
-    l <- mapM g $ invLDT'' im
+    l <- mapM g $ invLDT im
     return $ IM.unions l
   where
     g = dtToLRAdjEither getid . ldtToDT
@@ -155,12 +151,15 @@ invAdj im = do
             $ itm ^? itLocation . ilInvID
 
 invIndentIM :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType ComposeLinkType)
-invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1)) 
+invIndentIM =
-    . concatMap ldtToIndentList . invLDT'
+    IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1))
+        . concatMap ldtToIndentList
+        . map (bimap _iatType (\(x, y, _) -> (x, y)))
+        . invLDT
 
 -- returns an intmap with trees for all root items
 invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
-invTrees = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . invLDT'
+invTrees = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (bimap _iatType (\(x, y, _) -> (x, y))) . invLDT
   where
     getindex :: Item -> Int
     getindex i =