mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Fix edge transfer for embedded pattern apply.
This commit is contained in:
parent
02446b5b15
commit
860e00a724
@ -166,11 +166,9 @@ childCanBeEmbedded parentNode graph child =
|
||||
findChildEdgesToTransfer :: ING.Graph gr => ING.Node -> [ING.Node] -> gr a b-> [ING.LEdge b]
|
||||
findChildEdgesToTransfer parentNode nodes graph = concatMap makeLabelledGraphEdges nodes where
|
||||
makeLabelledGraphEdges childNode = changeEdgeToParent parentNode childNode <$>
|
||||
-- TODO FIX ME. Does not work for pattern apply.
|
||||
--filter (not . edgeGoesToParent parentNode)
|
||||
--(ING.inn graph childNode ++ ING.out graph childNode)
|
||||
ING.inn graph childNode
|
||||
|
||||
++
|
||||
filter (not. edgeGoesToParent parentNode) (ING.out graph childNode)
|
||||
|
||||
edgeGoesToParent :: ING.Node -> ING.LEdge b -> Bool
|
||||
edgeGoesToParent parentNode (fromNode, toNode, _)
|
||||
|
@ -497,13 +497,13 @@ collapseTestStrings = [
|
||||
makeCollapseTest :: String -> IO (Diagram B)
|
||||
makeCollapseTest str = do
|
||||
before <- renderFglGraph fglGraph
|
||||
after <- renderFglGraph collapsedGraph
|
||||
afterCollapse <- renderFglGraph collapsedGraph
|
||||
pure $ vsep 1 [
|
||||
expressionText,
|
||||
beforeText,
|
||||
before,
|
||||
afterText,
|
||||
after]
|
||||
afterCollapse]
|
||||
where
|
||||
fglGraph = syntaxGraphToFglGraph $ stringToSyntaxGraph str
|
||||
collapsedGraph = collapseNodes fglGraph
|
||||
|
Loading…
Reference in New Issue
Block a user