justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement break list attachments without internal item updates

Browse Source
This commit is contained in:
justin
2025-06-26 23:42:54 +01:00
parent 4710dd7631
commit 73c708a325
1 changed files with 14 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Grammar.hs
+14 -3
View File
@@ -231,11 +231,16 @@ 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
let l = rightChildList ltree
xs = dropWhile ((\s -> not $ S.member s (structureToPotentialFunction rtree)) . fst) l
(sf,linktype) <- safeHead xs
return $
ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)
leftIsParentCombine' :: LDTComb CItem ItemLink
leftIsParentCombine' ltree rtree = do
lu <- (ltree ^. ldtValue . _3 . tryRightLink) rtree --(rtree ^. ldtValue)
return $
ltree & ldtValue %~ (lu ^. luParentUpdate)
@@ -255,6 +260,12 @@ leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _1)
l = fst $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
f x y = tail $ dropWhile ((/=y) . snd) x
rightChildList :: LabelDoubleTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
rightChildList t = foldl' f l (reverse $ t ^.. ldtRight . each . _1)
where
l = snd $ 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)