mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 02:40:28 +03:00
Turn SgNamedNode into a data type.
This commit is contained in:
Robbie Gleichman
parent
7ab8d2d442
commit
f2f54d9c3b
@ -13,7 +13,7 @@ import Data.Maybe(catMaybes, isJust, fromMaybe)
|
||||
--import qualified Debug.Trace
|
||||
|
||||
import Types(SyntaxNode(..), sgNamedNodeToSyntaxNode, IngSyntaxGraph, Edge(..),
|
||||
CaseOrGuardTag(..), Port(..), NameAndPort(..))
|
||||
CaseOrGuardTag(..), Port(..), NameAndPort(..), SgNamedNode(..))
|
||||
import Util(maybeBoolToBool)
|
||||
--import Util(printSelf)
|
||||
|
||||
@ -246,8 +246,8 @@ embedChildSyntaxNodes parentNode childrenNodes oldGraph = case childrenNodes of
|
||||
Nothing -> oldGraph
|
||||
Just oldNodeLabel -> changeNodeLabel oldGraph parentNode newNodeLabel
|
||||
where
|
||||
(nodeName, oldSyntaxNode) = oldNodeLabel
|
||||
newNodeLabel = (nodeName, newSyntaxNode)
|
||||
SgNamedNode nodeName oldSyntaxNode = oldNodeLabel
|
||||
newNodeLabel = SgNamedNode nodeName newSyntaxNode
|
||||
newSyntaxNode = case oldSyntaxNode of
|
||||
LikeApplyNode flavor x -> NestedApplyNode flavor x childrenAndEdgesToParent
|
||||
CaseNode x -> NestedCaseOrGuardNode CaseTag x childrenAndEdgesToParent
|
||||
|
||||
@ -29,8 +29,9 @@ import Data.Typeable(Typeable)
|
||||
import Icons(colorScheme, iconToDiagram, defaultLineWidth, ColorStyle(..), getPortAngles)
|
||||
import TranslateCore(nodeToIcon)
|
||||
import Types(Edge(..), Icon, EdgeOption(..), Drawing(..), EdgeEnd(..),
|
||||
NameAndPort(..), SpecialQDiagram, SpecialBackend, SyntaxNode, SpecialNum, NodeName(..), Port(..))
|
||||
import Util(fromMaybeError)
|
||||
NameAndPort(..), SpecialQDiagram, SpecialBackend, SyntaxNode, SpecialNum, NodeName(..), Port(..),
|
||||
SgNamedNode)
|
||||
import Util(fromMaybeError, mapNodeInNamedNode)
|
||||
|
||||
-- If the inferred types for these functions becomes unweildy,
|
||||
-- try using PartialTypeSignitures.
|
||||
@ -353,8 +354,8 @@ renderDrawing = renderIconGraph . drawingToIconGraph
|
||||
|
||||
renderIngSyntaxGraph ::
|
||||
SpecialBackend b Double =>
|
||||
Gr (NodeName, SyntaxNode) Edge -> IO (SpecialQDiagram b Double)
|
||||
renderIngSyntaxGraph = renderIconGraph . ING.nmap (Control.Arrow.second nodeToIcon)
|
||||
Gr SgNamedNode Edge -> IO (SpecialQDiagram b Double)
|
||||
renderIngSyntaxGraph = renderIconGraph . ING.nmap (mapNodeInNamedNode nodeToIcon)
|
||||
|
||||
renderIconGraph :: SpecialBackend b Double => Gr (NodeName, Icon) Edge -> IO (SpecialQDiagram b Double)
|
||||
renderIconGraph = doGraphLayout
|
||||
|
||||
@ -27,7 +27,7 @@ import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..), S
|
||||
makeBox, nTupleString, nListString,
|
||||
syntaxGraphToFglGraph, getUniqueString, bindsToSyntaxGraph, graphAndRefToGraph)
|
||||
import Types(NameAndPort(..), IDState,
|
||||
initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode,
|
||||
initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode(..),
|
||||
LikeApplyFlavor(..))
|
||||
import Util(makeSimpleEdge, nameAndPort, justName)
|
||||
|
||||
@ -113,7 +113,7 @@ decideIfNested (GraphAndRef (SyntaxGraph [nameAndIcon] [] sinks bindings eMap) _
|
||||
decideIfNested valAndPort = (Just valAndPort, Nothing, [], [], [])
|
||||
|
||||
asNameBind :: (GraphAndRef, Maybe String) -> Maybe SgBind
|
||||
asNameBind ((GraphAndRef _ ref), mAsName) = case mAsName of
|
||||
asNameBind (GraphAndRef _ ref, mAsName) = case mAsName of
|
||||
Nothing -> Nothing
|
||||
Just asName -> Just $ SgBind asName ref
|
||||
|
||||
@ -134,8 +134,8 @@ makePatternGraph applyIconName funStr argVals _ = nestedApplyResult
|
||||
originalPortExpPairs = catMaybes unnestedArgsAndPort
|
||||
portExpressionPairs = originalPortExpPairs
|
||||
combinedGraph = combineExpressions True portExpressionPairs
|
||||
icons = [(applyIconName, NestedPatternApplyNode funStr nestedArgs)]
|
||||
newEMap = ((\(n, _) -> (n, applyIconName)) <$> catMaybes nestedArgs) <> mconcat nestedEMaps
|
||||
icons = [SgNamedNode applyIconName (NestedPatternApplyNode funStr nestedArgs)]
|
||||
newEMap = ((\(SgNamedNode n _) -> (n, applyIconName)) <$> catMaybes nestedArgs) <> mconcat nestedEMaps
|
||||
|
||||
newGraph = SyntaxGraph icons [] allSinks allBinds newEMap
|
||||
nestedApplyResult = (newGraph <> combinedGraph, nameAndPort applyIconName (Port 1))
|
||||
@ -145,7 +145,7 @@ makePatternGraph' applyIconName funStr argVals numArgs = (newGraph <> combinedGr
|
||||
where
|
||||
argumentPorts = map (nameAndPort applyIconName . Port) [2,3..]
|
||||
combinedGraph = combineExpressions True $ zip argVals argumentPorts
|
||||
icons = [(applyIconName, PatternApplyNode funStr numArgs)]
|
||||
icons = [SgNamedNode applyIconName (PatternApplyNode funStr numArgs)]
|
||||
newGraph = syntaxGraphFromNodes icons
|
||||
|
||||
evalPApp :: QName -> [Pat] -> State IDState (SyntaxGraph, NameAndPort)
|
||||
@ -186,7 +186,7 @@ evalPAsPat n p = do
|
||||
let
|
||||
outerName = nameToString n
|
||||
asBindGraph = makeAsBindGraph (Left outerName) [mInnerName]
|
||||
pure ((GraphAndRef (asBindGraph <> evaledPatGraph) evaledPatRef), Just outerName)
|
||||
pure (GraphAndRef (asBindGraph <> evaledPatGraph) evaledPatRef, Just outerName)
|
||||
|
||||
makePatternResult :: Functor f => f (SyntaxGraph, NameAndPort) -> f (GraphAndRef, Maybe String)
|
||||
makePatternResult = fmap (\(graph, namePort) -> (GraphAndRef graph (Right namePort), Nothing))
|
||||
@ -361,7 +361,7 @@ evalIf c e1 e2 e3 = do
|
||||
e3Val <- evalExp c e3
|
||||
guardName <- getUniqueName "if"
|
||||
let
|
||||
icons = [(guardName, GuardNode 2)]
|
||||
icons = [SgNamedNode guardName (GuardNode 2)]
|
||||
combinedGraph =
|
||||
combineExpressions False $ zip [e1Val, e2Val, e3Val] (map (nameAndPort guardName . Port) [3, 2, 4])
|
||||
newGraph = syntaxGraphFromNodes icons <> combinedGraph
|
||||
@ -424,7 +424,7 @@ evalGuardedRhss c rhss = do
|
||||
expsWithPorts = zip exps $ map (nameAndPort guardName . Port) [2,4..]
|
||||
boolsWithPorts = zip bools $ map (nameAndPort guardName . Port) [3,5..]
|
||||
combindedGraph = combineExpressions False $ expsWithPorts <> boolsWithPorts
|
||||
icons = [(guardName, GuardNode (length rhss))]
|
||||
icons = [SgNamedNode guardName $ GuardNode (length rhss)]
|
||||
newGraph = syntaxGraphFromNodes icons <> combindedGraph
|
||||
pure (newGraph, nameAndPort guardName (Port 1))
|
||||
|
||||
@ -472,7 +472,7 @@ evalCase c e alts = do
|
||||
(patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
|
||||
combindedAltGraph = mconcat altGraphs
|
||||
numAlts = length alts
|
||||
icons = [(caseIconName, CaseNode numAlts)]
|
||||
icons = [SgNamedNode caseIconName (CaseNode numAlts)]
|
||||
caseGraph = syntaxGraphFromNodes icons
|
||||
expEdge = (expRef, nameAndPort caseIconName (Port 0))
|
||||
patEdges = zip patRefs $ map (nameAndPort caseIconName . Port) [2,4..]
|
||||
@ -485,7 +485,7 @@ evalCase c e alts = do
|
||||
Left _ -> mempty
|
||||
Right rhsPort -> syntaxGraphFromNodesEdges rhsNewIcons rhsNewEdges
|
||||
where
|
||||
rhsNewIcons = [(resultIconName, CaseResultNode)]
|
||||
rhsNewIcons = [SgNamedNode resultIconName CaseResultNode]
|
||||
rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
|
||||
caseResultGraphs = mconcat $ zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
|
||||
filteredRhsEdges = fmap snd unConnectedRhss
|
||||
@ -560,7 +560,7 @@ generalEvalLambda context patterns rhsEvalFun = do
|
||||
|
||||
GraphAndRef rhsRawGraph rhsRef <- rhsEvalFun rhsContext
|
||||
let
|
||||
icons = [(lambdaName, FunctionDefNode (length patterns))]
|
||||
icons = [SgNamedNode lambdaName $ FunctionDefNode (length patterns)]
|
||||
returnPort = nameAndPort lambdaName (Port 0)
|
||||
(newEdges, newSinks) = case rhsRef of
|
||||
Left s -> (patternEdges, [SgSink s returnPort])
|
||||
@ -705,7 +705,7 @@ showTopLevelBinds gr = do
|
||||
addBind (SgBind patName (Right port)) = do
|
||||
uniquePatName <- getUniqueName patName
|
||||
let
|
||||
icons = [(uniquePatName, BindNameNode patName)]
|
||||
icons = [SgNamedNode uniquePatName (BindNameNode patName)]
|
||||
edges = [makeSimpleEdge (port, justName uniquePatName)]
|
||||
edgeGraph = syntaxGraphFromNodesEdges icons edges
|
||||
pure edgeGraph
|
||||
|
||||
@ -36,9 +36,9 @@ import Data.List(find)
|
||||
import Data.Semigroup(Semigroup, (<>))
|
||||
|
||||
import Types(Icon, SyntaxNode(..), Edge(..), EdgeOption(..),
|
||||
NameAndPort(..), IDState, getId, SgNamedNode, NodeName(..), Port(..), nodeNameToInt,
|
||||
NameAndPort(..), IDState, getId, SgNamedNode(..), NodeName(..), Port(..), nodeNameToInt,
|
||||
LikeApplyFlavor(..), CaseOrGuardTag(..))
|
||||
import Util(noEnds, nameAndPort, makeSimpleEdge, justName, maybeBoolToBool)
|
||||
import Util(noEnds, nameAndPort, makeSimpleEdge, justName, maybeBoolToBool, mapNodeInNamedNode)
|
||||
import Icons(Icon(..))
|
||||
|
||||
-- OVERVIEW --
|
||||
@ -83,10 +83,10 @@ sgBindToString (SgBind s _) = s
|
||||
sgBindToTuple :: SgBind -> (String, Reference)
|
||||
sgBindToTuple (SgBind s r) = (s, r)
|
||||
|
||||
syntaxGraphFromNodes :: [(NodeName, SyntaxNode)] -> SyntaxGraph
|
||||
syntaxGraphFromNodes :: [SgNamedNode] -> SyntaxGraph
|
||||
syntaxGraphFromNodes icons = SyntaxGraph icons mempty mempty mempty mempty
|
||||
|
||||
syntaxGraphFromNodesEdges :: [(NodeName, SyntaxNode)] -> [Edge] -> SyntaxGraph
|
||||
syntaxGraphFromNodesEdges :: [SgNamedNode] -> [Edge] -> SyntaxGraph
|
||||
syntaxGraphFromNodesEdges icons edges = SyntaxGraph icons edges mempty mempty mempty
|
||||
|
||||
bindsToSyntaxGraph :: [SgBind] -> SyntaxGraph
|
||||
@ -142,7 +142,7 @@ makeApplyGraph applyFlavor inPattern applyIconName funVal argVals numArgs = (new
|
||||
argumentPorts = map (nameAndPort applyIconName . Port) [2,3..]
|
||||
functionPort = nameAndPort applyIconName (Port 0)
|
||||
combinedGraph = combineExpressions inPattern $ zip (funVal:argVals) (functionPort:argumentPorts)
|
||||
icons = [(applyIconName, LikeApplyNode applyFlavor numArgs)]
|
||||
icons = [SgNamedNode applyIconName (LikeApplyNode applyFlavor numArgs)]
|
||||
newGraph = syntaxGraphFromNodes icons
|
||||
|
||||
namesInPatternHelper :: GraphAndRef -> [String]
|
||||
@ -192,7 +192,7 @@ makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph where
|
||||
makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
|
||||
makeBox str = do
|
||||
name <- getUniqueName str
|
||||
let graph = syntaxGraphFromNodes [(name, LiteralNode str)]
|
||||
let graph = syntaxGraphFromNodes [SgNamedNode name (LiteralNode str)]
|
||||
pure (graph, justName name)
|
||||
|
||||
nTupleString :: Int -> String
|
||||
@ -222,7 +222,7 @@ nodeToIcon (NestedCaseOrGuardNode tag x edges) = nestedCaseOrGuardNodeToIcon tag
|
||||
makeArg :: [(SgNamedNode, Edge)] -> Int -> Maybe (NodeName, Icon)
|
||||
makeArg args port = case find (findArg (Port port)) args of
|
||||
Nothing -> Nothing
|
||||
Just ((argName, argSyntaxNode), _) -> Just (argName, nodeToIcon argSyntaxNode)
|
||||
Just (SgNamedNode argName argSyntaxNode, _) -> Just (argName, nodeToIcon argSyntaxNode)
|
||||
|
||||
nestedApplySyntaxNodeToIcon :: LikeApplyFlavor -> Int -> [(SgNamedNode, Edge)] -> Icon
|
||||
nestedApplySyntaxNodeToIcon flavor numArgs args = NestedApply flavor argList where
|
||||
@ -242,7 +242,7 @@ nestedPatternNodeToIcon :: String -> [Maybe SgNamedNode] -> Icon
|
||||
nestedPatternNodeToIcon str children = NestedPApp $
|
||||
Just (NodeName (-1), TextBoxIcon str)
|
||||
:
|
||||
fmap (fmap (second nodeToIcon)) children
|
||||
(fmap (mapNodeInNamedNode nodeToIcon) <$> children)
|
||||
|
||||
nestedPatternNodeToIcon' :: String -> Int -> [(SgNamedNode, Edge)] -> Icon
|
||||
nestedPatternNodeToIcon' str numArgs args = NestedPApp argList where
|
||||
@ -251,13 +251,13 @@ nestedPatternNodeToIcon' str numArgs args = NestedPApp argList where
|
||||
argList = Just (NodeName (-1), TextBoxIcon str) : fmap (makeArg args) [2..numArgs + 1]
|
||||
|
||||
findArg :: Port -> (SgNamedNode, Edge) -> Bool
|
||||
findArg currentPort ((argName, _), Edge _ _ (NameAndPort fromName fromPort, NameAndPort toName toPort))
|
||||
findArg currentPort (SgNamedNode argName _, Edge _ _ (NameAndPort fromName fromPort, NameAndPort toName toPort))
|
||||
| argName == fromName = maybeBoolToBool $ fmap (== currentPort) toPort
|
||||
| argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort
|
||||
| otherwise = False -- This case should never happen
|
||||
|
||||
makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
|
||||
makeLNode namedNode@(NodeName name, _) = (name, namedNode)
|
||||
makeLNode namedNode@(SgNamedNode (NodeName name) _) = (name, namedNode)
|
||||
|
||||
lookupInEmbeddingMap :: NodeName -> [(NodeName, NodeName)] -> NodeName
|
||||
lookupInEmbeddingMap origName eMap = lookupHelper origName where
|
||||
|
||||
@ -15,7 +15,7 @@ module Types (
|
||||
SpecialQDiagram,
|
||||
SpecialBackend,
|
||||
SpecialNum,
|
||||
SgNamedNode,
|
||||
SgNamedNode(..),
|
||||
IngSyntaxGraph,
|
||||
LikeApplyFlavor(..),
|
||||
CaseOrGuardTag(..),
|
||||
@ -91,6 +91,8 @@ data EdgeEnd = EndAp1Result | EndAp1Arg | EndNone deriving (Show, Eq, Ord)
|
||||
-- and a map of names to subDrawings
|
||||
data Drawing = Drawing [(NodeName, Icon)] [Edge] deriving (Show, Eq)
|
||||
|
||||
data SgNamedNode = SgNamedNode NodeName SyntaxNode deriving (Ord, Eq, Show)
|
||||
|
||||
-- | IDState is an Abstract Data Type that is used as a state whose value is a unique id.
|
||||
newtype IDState = IDState Int deriving (Eq, Show)
|
||||
|
||||
@ -101,11 +103,10 @@ type SpecialBackend b n = (SpecialNum n, Renderable (Path V2 n) b, Renderable (T
|
||||
|
||||
type SpecialQDiagram b n = QDiagram b V2 n Any
|
||||
|
||||
type SgNamedNode = (NodeName, SyntaxNode)
|
||||
type IngSyntaxGraph gr = gr SgNamedNode Edge
|
||||
|
||||
sgNamedNodeToSyntaxNode :: SgNamedNode -> SyntaxNode
|
||||
sgNamedNodeToSyntaxNode = snd
|
||||
sgNamedNodeToSyntaxNode (SgNamedNode _ n) = n
|
||||
|
||||
initialIdState :: IDState
|
||||
initialIdState = IDState 0
|
||||
|
||||
@ -15,7 +15,8 @@ module Util (
|
||||
mapFst,
|
||||
printSelf,
|
||||
eitherToMaybes,
|
||||
maybeBoolToBool
|
||||
maybeBoolToBool,
|
||||
mapNodeInNamedNode
|
||||
)where
|
||||
|
||||
import Control.Arrow(first)
|
||||
@ -23,7 +24,8 @@ import Control.Arrow(first)
|
||||
import Data.Maybe(fromMaybe)
|
||||
import qualified Debug.Trace
|
||||
|
||||
import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName, Port)
|
||||
import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName, Port,
|
||||
SyntaxNode, SgNamedNode(..))
|
||||
|
||||
mapFst :: Functor f => (a -> b) -> f (a, c) -> f (b, c)
|
||||
mapFst f = fmap (first f)
|
||||
@ -75,3 +77,6 @@ eitherToMaybes (Right y) = (Nothing, Just y)
|
||||
-- | (Just True) = True, Nothing = False
|
||||
maybeBoolToBool :: Maybe Bool -> Bool
|
||||
maybeBoolToBool = or
|
||||
|
||||
mapNodeInNamedNode :: (SyntaxNode -> a) -> SgNamedNode -> (NodeName, a)
|
||||
mapNodeInNamedNode f (SgNamedNode name node) = (name, f node)
|
||||
|
||||
@ -11,7 +11,7 @@ import Data.List(foldl', sort, sortOn)
|
||||
|
||||
import Translate(translateStringToSyntaxGraph)
|
||||
import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..), Reference, SgBind(..))
|
||||
import Types(SgNamedNode, Edge(..), SyntaxNode(..),
|
||||
import Types(SgNamedNode(..), Edge(..), SyntaxNode(..),
|
||||
IngSyntaxGraph, NodeName(..), LikeApplyFlavor(..), NameAndPort(..))
|
||||
import qualified GraphAlgorithms
|
||||
import Util(fromMaybeError)
|
||||
@ -31,11 +31,11 @@ type NameMap = [(NodeName, NodeName)]
|
||||
|
||||
renameNode
|
||||
:: NameMap -> Int -> SgNamedNode -> (SgNamedNode, NameMap, Int)
|
||||
renameNode nameMap counter (nodeName, syntaxNode) = (newNamedNode, nameMap3, newCounter) where
|
||||
renameNode nameMap counter (SgNamedNode nodeName syntaxNode) = (newNamedNode, nameMap3, newCounter) where
|
||||
newNodeName = NodeName counter
|
||||
nameMap2 = (nodeName, newNodeName) : nameMap
|
||||
(newSyntaxNode, nameMap3, newCounter) = renameSyntaxNode nameMap2 syntaxNode (counter + 1)
|
||||
newNamedNode = (newNodeName, newSyntaxNode)
|
||||
newNamedNode = SgNamedNode newNodeName newSyntaxNode
|
||||
|
||||
maybeRenameNodeFolder ::
|
||||
([Maybe SgNamedNode], NameMap, Int) -> Maybe SgNamedNode -> ([Maybe SgNamedNode], NameMap, Int)
|
||||
@ -53,7 +53,7 @@ renameSyntaxNode nameMap node counter = case node of
|
||||
_ -> (node, nameMap, counter)
|
||||
|
||||
renameNodeFolder :: ([SgNamedNode], NameMap, Int) -> SgNamedNode -> ([SgNamedNode], NameMap, Int)
|
||||
renameNodeFolder state@(renamedNodes, nameMap, counter) node@(nodeName, _) = case lookup nodeName nameMap of
|
||||
renameNodeFolder state@(renamedNodes, nameMap, counter) node@(SgNamedNode nodeName _) = case lookup nodeName nameMap of
|
||||
Nothing -> (newNamedNode:renamedNodes, newNameMap, newCounter) where
|
||||
(newNamedNode, newNameMap, newCounter) = renameNode nameMap counter node
|
||||
Just _ -> error $ "renameNode: node already in name map. State = " ++ show state ++ " Node = " ++ show node
|
||||
@ -80,7 +80,7 @@ renameEmbed nameMap (leftName, rightName) = (newLeftName, newRightName) where
|
||||
|
||||
-- TODO May want to remove names for sub-nodes
|
||||
removeNames :: SgNamedNode -> SyntaxNode
|
||||
removeNames (_, syntaxNode) = syntaxNode
|
||||
removeNames (SgNamedNode _ syntaxNode) = syntaxNode
|
||||
|
||||
-- TODO Rename sinks
|
||||
-- TODO Add unit tests for renameGraph
|
||||
@ -114,10 +114,10 @@ makeTreeRootTest (testName, expected, haskellString) = TestCase $ assertEqual te
|
||||
treeRootTests :: Test
|
||||
treeRootTests = TestList $ fmap makeTreeRootTest treeRootTestList where
|
||||
treeRootTestList = [
|
||||
("single apply", [Just (NodeName 2, LikeApplyNode ApplyNodeFlavor 1)], "y = f x"),
|
||||
("single apply", [Just $ SgNamedNode (NodeName 2) (LikeApplyNode ApplyNodeFlavor 1)], "y = f x"),
|
||||
-- TODO Fix test below
|
||||
("double apply", [Just (NodeName 3, LikeApplyNode ComposeNodeFlavor 2)], "y = f (g x)"),
|
||||
("recursive apply", [Just (NodeName 3,LikeApplyNode ComposeNodeFlavor 2)], "y = f (g y)")
|
||||
("double apply", [Just $ SgNamedNode (NodeName 3) (LikeApplyNode ComposeNodeFlavor 2)], "y = f (g x)"),
|
||||
("recursive apply", [Just $ SgNamedNode (NodeName 3) (LikeApplyNode ComposeNodeFlavor 2)], "y = f (g y)")
|
||||
]
|
||||
|
||||
makeChildCanBeEmbeddedTest ::
|
||||
|
||||
@ -11,7 +11,7 @@ import qualified Data.GraphViz.Attributes.Complete as GVA
|
||||
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
|
||||
import Types(SpecialQDiagram, SpecialBackend, SyntaxNode(..), NameAndPort(..), SgNamedNode, Edge(..))
|
||||
import Types(SpecialQDiagram, SpecialBackend, SyntaxNode(..), NameAndPort(..), SgNamedNode(..), Edge(..))
|
||||
import Translate(translateStringToSyntaxGraph)
|
||||
import TranslateCore(syntaxGraphToFglGraph)
|
||||
import GraphAlgorithms(collapseNodes)
|
||||
@ -22,7 +22,7 @@ prettyPrintSyntaxNode :: SyntaxNode -> String
|
||||
prettyPrintSyntaxNode (NestedApplyNode _ _ namedNodesAndEdges) = concatMap printNameAndEdge namedNodesAndEdges
|
||||
where
|
||||
printNameAndEdge (namedNode, edge) = "(" ++ prettyPrintNamedNode namedNode ++ "," ++ printEdge edge ++ ")"
|
||||
prettyPrintNamedNode = show. fst -- "(" ++ show name ++ "," ++ prettyPrintSyntaxNode syntaxNode ++ ")"
|
||||
prettyPrintNamedNode (SgNamedNode name _) = show name -- "(" ++ show name ++ "," ++ prettyPrintSyntaxNode syntaxNode ++ ")"
|
||||
printEdge (Edge _ _ (NameAndPort n1 _, NameAndPort n2 _)) = show (n1, n2)
|
||||
prettyPrintSyntaxNode x = show x
|
||||
|
||||
@ -39,7 +39,7 @@ renderFglGraph fglGraph = do
|
||||
layedOutGraph
|
||||
where
|
||||
scaleFactor = 0.12
|
||||
nodeFunc (name, syntaxNode) point =
|
||||
nodeFunc (SgNamedNode name syntaxNode) point =
|
||||
place (coloredTextBox white (opaque white) (show name ++ prettyPrintSyntaxNode syntaxNode) {- :: Diagram B -})
|
||||
(scaleFactor *^ point)
|
||||
layoutParams :: GV.GraphvizParams Int v e () v
|
||||
|
||||
Loading…
Reference in New Issue
Block a user