Remove LDTs from item attachment

src/Dodge/Item/Grammar.hs

@@ -33,8 +33,7 @@ import Dodge.DoubleTree
 import LensHelp
 import ListHelp
 
-tryAttachItems :: LDTree ItemLink CItem -> LDTree ItemLink CItem -> 
-    Maybe (LDTree ItemLink CItem)
+tryAttachItems :: DTree CItem -> DTree CItem -> Maybe (DTree CItem)
 tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
 
 --breakListAbove :: Item -> ItemStructuralFunction -> [(ItemStructuralFunction, ItemLink)]
@@ -53,20 +52,20 @@ tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
 --        [(JoystickSF, JoystickLink)]
 --    _ -> []
 
+--itemToBreakLists ::
+--    Item ->
+--    ItemStructuralFunction ->
+--    ([(ItemStructuralFunction, ItemLink)], [(ItemStructuralFunction, ItemLink)])
+--itemToBreakLists itm itmf = (fmap f l, fmap f r)
+--  where
+--    f x = (x, SFLink x)
+--    (l,r) = itemToBreakLists' itm itmf
+
 itemToBreakLists ::
-    Item ->
-    ItemStructuralFunction ->
-    ([(ItemStructuralFunction, ItemLink)], [(ItemStructuralFunction, ItemLink)])
-itemToBreakLists itm itmf = (fmap f l, fmap f r)
-  where
-    f x = (x, SFLink x)
-    (l,r) = itemToBreakLists' itm itmf
-
-itemToBreakLists' ::
     Item ->
     ItemStructuralFunction ->
     ([(ItemStructuralFunction)], [(ItemStructuralFunction)])
-itemToBreakLists' itm itmf = case (itm ^. itType, itmf) of
+itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
     (HELD TORCH, _) -> (getAmmoLinks itm, [])
     (ATTACH UNDERBARRELSLOT, _) -> ([(UnderBarrelPlatformSF)], [])
     (_, HeldPlatformSF) ->
@@ -179,8 +178,8 @@ itemToFunction itm = case itm ^. itType of
     CLICKER{} -> GadgetPlatformSF
     _ -> NoSF
 
-treeToPotentialFunction :: LDTree ItemLink CItem -> S.Set ItemStructuralFunction
-treeToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
+treeToPotentialFunction :: DTree CItem -> S.Set ItemStructuralFunction
+treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
     STICKYMOD -> S.singleton GrenadeHitEffectSF
     ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
     ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
@@ -188,52 +187,52 @@ treeToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
     HELD BURSTRIFLE -> S.singleton UnderBarrelPlatformSF
     HELD LASER -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
     -- following limits items to ten ammo slots
-    _ | AmmoMagSF _ x <- ldt ^. ldtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
-    _ -> S.singleton (ldt ^. ldtValue . _2)
+    _ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
+    _ -> S.singleton (ldt ^. dtValue . _2)
 
 baseCI :: Item -> CItem
 baseCI itm = (itm, itemToFunction itm)
 
-type LDTComb a b = LDTree b a -> LDTree b a -> Maybe (LDTree b a)
+type DTComb a = DTree a -> DTree a -> Maybe (DTree a)
 
-leftIsParentCombine :: LDTComb CItem ItemLink
+leftIsParentCombine :: DTComb CItem
 leftIsParentCombine ltree rtree = do
     let l = rightChildList ltree
-        xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction rtree)) . fst) l
-    (sf,linktype) <- safeHead xs
-    return $ ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)
+        xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction rtree))) l
+    (sf) <- safeHead xs
+    return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf)
 
-rightIsParentCombine :: LDTComb CItem ItemLink
+rightIsParentCombine :: DTComb CItem
 rightIsParentCombine ltree rtree = do
     let l = leftChildList rtree
-        xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction ltree)) . fst) l
-    (sf,linktype) <- safeHead xs
-    return $ rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)
+        xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction ltree))) l
+    (sf) <- safeHead xs
+    return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
 
-leftChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
-leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _2 . ldtValue . _2)
+leftChildList :: DTree CItem -> [ItemStructuralFunction]
+leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2)
   where
-    l = fst $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
-    f x y = tail $ dropWhile ((/=y) . fst) x
+    l = fst $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
+    f x y = tail $ dropWhile ((/=y) ) x
 
-rightChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
-rightChildList t = foldl' f l (reverse $ t ^.. ldtRight . each . _2 . ldtValue . _2)
+rightChildList :: DTree CItem -> [ItemStructuralFunction]
+rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2)
   where
-    l = snd $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
-    f x y = tail $ dropWhile ((/=y) . fst) x
+    l = snd $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
+    f x y = tail $ dropWhile ((/=y)) x
 
 leftRightCombine ::
-    LDTComb a b ->
-    LDTComb a b ->
-    LDTree b a ->
-    LDTree b a ->
-    Maybe (LDTree b a)
+    DTComb a ->
+    DTComb a ->
+    DTree a ->
+    DTree a ->
+    Maybe (DTree a)
 leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
   where
-    checkdepth t t'@(LDT x ls rs) = fromMaybe (checktop t t') $ do
-        (lab, t'') <- safeHead ls
+    checkdepth t t'@(DT x ls rs) = fromMaybe (checktop t t') $ do
+        (t'') <- safeHead ls
         tx <- checkdepth t t''
-        return $ Just $ LDT x ((lab, tx) : tail ls) rs
+        return $ Just $ DT x (( tx) : tail ls) rs
     checktop t t' = f' t t'
 
 joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
@@ -252,9 +251,9 @@ joinItemsInList f = fst . h . ([],)
 --        . fmap (singleLDT . baseCI)
 
 invDT :: IM.IntMap Item -> [DTree CItem]
-invDT = fmap ldtToDT .
+invDT = 
     joinItemsInList tryAttachItems . IM.elems
-        . fmap (singleLDT . baseCI)
+        . fmap (singleDT . baseCI)
 
 --invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
 --invLDT' = fmap propagateOrientation . invLDT