Move towards externalizing item attachment updates

src/Dodge/Item/Grammar.hs

@@ -37,15 +37,7 @@ useBreakL ::
     [(ItemStructuralFunction, ItemLink)] ->
     [(ItemStructuralFunction, ItemLink)] ->
     LinkTest
-useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
-  where
-    noa a b = (a, b)
-
-useBreakListsLinkTest ::
-    [(ItemStructuralFunction, ItemLink)] ->
-    [(ItemStructuralFunction, ItemLink)] ->
-    LinkTest
-useBreakListsLinkTest llist rlist = LTest ltest rtest
+useBreakL llist rlist = LTest ltest rtest
   where
     ltest ldt = do
         let xs =
@@ -53,7 +45,7 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
                     ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
                     llist
         (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) 
+        return $ LUpdate linktype (set _3 (useBreakL (tail xs) rlist)) 
             (_2 .~ sf)
     rtest ldt = do
         let xs =
@@ -61,7 +53,7 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
                     ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
                     rlist
         (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) 
+        return $ LUpdate linktype (set _3 (useBreakL llist (tail xs))) 
             (_2 .~ sf)
 
 itemToBreakLists ::
@@ -78,6 +70,8 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
             <> getAutoSpringLinks itm
             <> extraWeaponLinks itm
         )
+    (_, UnderBarrelPlatformSF) ->
+        ( getAmmoLinks itm,[])
     (DETECTOR {}, _) -> 
         ( getAmmoLinks itm
         , [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
@@ -237,6 +231,9 @@ springLinkTest = LTest (const Nothing) $
 
 type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
 
+leftIsParentCombine' :: LDTComb CItem ItemLink
+leftIsParentCombine' ltree rtree = Nothing
+
 leftIsParentCombine :: LDTComb CItem ItemLink
 leftIsParentCombine ltree rtree = do
     lu <- (ltree ^. ldtValue . _3 . tryRightLink) rtree --(rtree ^. ldtValue)
@@ -246,6 +243,20 @@ leftIsParentCombine ltree rtree = do
 
 rightIsParentCombine :: LDTComb CItem ItemLink
 rightIsParentCombine ltree rtree = do
+    let l = leftChildList rtree
+        xs = dropWhile ((\s -> not $ S.member s (structureToPotentialFunction ltree)) . fst) l
+    (sf,linktype) <- safeHead xs
+    return $
+        rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)
+
+leftChildList :: LabelDoubleTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
+leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _1)
+  where
+    l = fst $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
+    f x y = tail $ dropWhile ((/=y) . snd) x
+
+rightIsParentCombine' :: LDTComb CItem ItemLink
+rightIsParentCombine' ltree rtree = do
     lu <- (rtree ^. ldtValue . _3 . tryLeftLink) ltree -- (ltree ^. ldtValue)
     return $
         rtree & ldtValue %~ (lu ^. luParentUpdate)