mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-16 18:30:36 +03:00
Simplify EdgeOption and EdgeEnd.
This commit is contained in:
parent
ccee42c23e
commit
7a854d9679
@ -517,7 +517,7 @@ guardLBracket :: SpecialBackend b n =>
|
||||
SpecialQDiagram b n -> SpecialQDiagram b n
|
||||
guardLBracket portDia = alignL (alignT ell) <> portDia
|
||||
where
|
||||
ellShape = fromOffsets $ map r2 [(0, guardSize), (-guardSize,0)]
|
||||
ellShape = fromOffsets $ map r2 [(0, guardSize), (-guardSize, 0)]
|
||||
ell = lineJoin LineJoinRound $ lwG defaultLineWidth $ lc (boolC colorScheme) (strokeLine ellShape)
|
||||
|
||||
-- | The ports of the guard icon are as follows:
|
||||
|
@ -104,14 +104,8 @@ getArrowOpts (t, h) _ (fromAngle, toAngle) (NameAndPort (NodeName nodeNum) mPort
|
||||
ap1ResultTexture = solid (apply1C colorScheme)
|
||||
|
||||
lookupTail EndNone = id
|
||||
lookupTail EndAp1Arg = (arrowTail .~ dart')
|
||||
. (tailTexture .~ ap1ArgTexture) . (tailStyle %~ ap1ArgStyle)
|
||||
lookupTail EndAp1Result = (arrowTail .~ arg1ResT) . (tailTexture .~ ap1ResultTexture)
|
||||
|
||||
lookupHead EndNone = id
|
||||
lookupHead EndAp1Arg = (arrowHead .~ dart)
|
||||
. (headTexture .~ ap1ArgTexture) . (headStyle %~ ap1ArgStyle)
|
||||
lookupHead EndAp1Result = (arrowHead .~ arg1ResH) . (headTexture .~ ap1ResultTexture)
|
||||
|
||||
arrowOptions =
|
||||
arrowHead .~ noHead $
|
||||
|
@ -60,14 +60,15 @@ data SgBind = SgBind String Reference deriving (Eq, Show, Ord)
|
||||
data SgSink = SgSink String NameAndPort deriving (Eq, Ord, Show)
|
||||
|
||||
-- TODO Replace lists with sets
|
||||
-- | SyntaxGraph is an abstract representation for Haskell syntax. SyntaxGraphs are
|
||||
-- generated from the Haskell syntax tree, and are used to generate Drawings
|
||||
-- | A SyntaxGraph is an abstract representation of Haskell syntax. SyntaxGraphs
|
||||
-- are generated from the Haskell syntax tree and are used to generate Drawings.
|
||||
data SyntaxGraph = SyntaxGraph {
|
||||
sgNodes :: [SgNamedNode],
|
||||
sgEdges :: [Edge],
|
||||
sgSinks :: [SgSink],
|
||||
sgBinds :: [SgBind],
|
||||
-- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent) is in the Map, then child is embedded inside parent.
|
||||
-- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent)
|
||||
-- is in the Map, then child is embedded inside parent.
|
||||
sgEmbedMap :: [(NodeName, NodeName)]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
|
14
app/Types.hs
14
app/Types.hs
@ -33,9 +33,9 @@ data NamedIcon = NamedIcon {niName :: NodeName, niIcon :: Icon}
|
||||
-- TYPES --
|
||||
-- | A datatype that represents an icon.
|
||||
-- The TextBoxIcon's data is the text that appears in the text box.
|
||||
-- The LambdaRegionIcon's data is the number of lambda ports, and the name of it's
|
||||
-- subdrawing.
|
||||
data Icon = TextBoxIcon String | GuardIcon Int
|
||||
data Icon = TextBoxIcon String
|
||||
| GuardIcon
|
||||
Int -- Number of alternatives
|
||||
| FlatLambdaIcon [String] | ApplyAIcon Int | ComposeIcon Int
|
||||
| PAppIcon Int String | CaseIcon Int | CaseResultIcon
|
||||
| BindTextBoxIcon String
|
||||
@ -63,7 +63,8 @@ data SyntaxNode =
|
||||
| BindNameNode String
|
||||
| LiteralNode String -- Literal values like the string "Hello World"
|
||||
| FunctionDefNode [String] -- Function definition (ie. lambda expression)
|
||||
| GuardNode Int
|
||||
| GuardNode
|
||||
Int -- Number of alternatives
|
||||
| CaseNode Int
|
||||
| CaseResultNode -- TODO remove caseResultNode
|
||||
| NestedCaseOrGuardNode CaseOrGuardTag Int [(SgNamedNode, Edge)]
|
||||
@ -79,15 +80,16 @@ data NameAndPort = NameAndPort NodeName (Maybe Port) deriving (Show, Eq, Ord)
|
||||
|
||||
type Connection = (NameAndPort, NameAndPort)
|
||||
|
||||
-- TODO Consider removing EdgeOption and EdgeEnd since they are unused.
|
||||
data EdgeOption = EdgeInPattern deriving (Show, Eq, Ord)
|
||||
|
||||
data EdgeEnd = EndNone deriving (Show, Eq, Ord)
|
||||
|
||||
-- | An Edge has an name of the source icon, and its optional port number,
|
||||
-- and the name of the destination icon, and its optional port number.
|
||||
data Edge = Edge {edgeOptions::[EdgeOption], edgeEnds :: (EdgeEnd, EdgeEnd), edgeConnection :: Connection}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data EdgeEnd = EndAp1Result | EndAp1Arg | EndNone deriving (Show, Eq, Ord)
|
||||
|
||||
-- | A drawing is a map from names to Icons, a list of edges,
|
||||
-- and a map of names to subDrawings
|
||||
data Drawing = Drawing [NamedIcon] [Edge] deriving (Show, Eq)
|
||||
|
@ -75,89 +75,6 @@ fact0Drawing = Drawing fact0Icons fact0Edges where
|
||||
iconToIntPort fRes fG0 0
|
||||
]
|
||||
|
||||
|
||||
fact1Icons :: [NamedIcon]
|
||||
fact1Icons = fmap tupleToNamedIcon
|
||||
[
|
||||
(fG0, GuardIcon 2),
|
||||
(fOne, TextBoxIcon "1"),
|
||||
(fEq0, TextBoxIcon "== 0"),
|
||||
(fMinus1, TextBoxIcon "-1"),
|
||||
(fTimes, TextBoxIcon "*"),
|
||||
(fRecurAp, ApplyAIcon 1),
|
||||
(fTimesAp, ApplyAIcon 2),
|
||||
-- (fArg, BranchIcon),
|
||||
(fRes, CaseResultIcon)
|
||||
]
|
||||
|
||||
fact1Edges :: [Edge]
|
||||
fact1Edges = [
|
||||
iconToIconEnds fArg EndNone fEq0 EndAp1Arg,
|
||||
iconTailToPort fEq0 EndAp1Result fG0 (Port 3),
|
||||
iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
|
||||
iconTailToPort fMinus1 EndAp1Result fRecurAp (Port 2),
|
||||
iconToIntPort fTimes fTimesAp 0,
|
||||
iconToIntPort fOne fG0 2,
|
||||
intPortToPort fTimesAp 1 fG0 4,
|
||||
intPortToPort fRecurAp 1 fTimesAp 3,
|
||||
iconToIntPort fArg fTimesAp 2,
|
||||
iconToIntPort fRes fG0 0
|
||||
]
|
||||
|
||||
fact1Drawing :: Drawing
|
||||
fact1Drawing = Drawing fact1Icons fact1Edges
|
||||
|
||||
-- fact2 is like fact1, but uses fTimesAp port 2 to distrubute the argument,
|
||||
-- not fArg
|
||||
fact2Icons :: [NamedIcon]
|
||||
fact2Icons = fmap tupleToNamedIcon
|
||||
[
|
||||
(fG0, GuardIcon 2),
|
||||
(fOne, TextBoxIcon "1"),
|
||||
(fEq0, TextBoxIcon "== 0"),
|
||||
(fMinus1, TextBoxIcon "-1"),
|
||||
(fTimes, TextBoxIcon "*"),
|
||||
(fRecurAp, ApplyAIcon 1),
|
||||
(fTimesAp, ApplyAIcon 2),
|
||||
--(fArg, BranchIcon),
|
||||
(fRes, CaseResultIcon)
|
||||
]
|
||||
|
||||
fact2Edges :: [Edge]
|
||||
fact2Edges = [
|
||||
--iconToIconEnds fArg EndNone fEq0 EndAp1Arg,
|
||||
iconTailToPort fEq0 EndAp1Arg fTimesAp (Port 2),
|
||||
iconTailToPort fEq0 EndAp1Result fG0 (Port 3),
|
||||
--iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
|
||||
iconTailToPort fMinus1 EndAp1Arg fTimesAp (Port 2),
|
||||
iconTailToPort fMinus1 EndAp1Result fRecurAp (Port 2),
|
||||
iconToIntPort fTimes fTimesAp 0,
|
||||
iconToIntPort fOne fG0 2,
|
||||
intPortToPort fTimesAp 1 fG0 4,
|
||||
intPortToPort fRecurAp 1 fTimesAp 3,
|
||||
--iconToIntPort fArg fTimesAp 2,
|
||||
iconToIntPort fRes fG0 0
|
||||
]
|
||||
|
||||
fact2Drawing :: Drawing
|
||||
fact2Drawing = Drawing fact2Icons fact2Edges
|
||||
|
||||
arrowTestDrawing :: Drawing
|
||||
arrowTestDrawing = Drawing arrowTestIcons arrowTestEdges where
|
||||
[arr1, arr2, arr3, arr4] = fmap NodeName [0..3] --["arr1", "arr2", "arr3", "arr4"]
|
||||
arrowTestIcons = fmap tupleToNamedIcon [
|
||||
(arr1, TextBoxIcon "1"),
|
||||
(arr2, TextBoxIcon "2"),
|
||||
(arr3, TextBoxIcon "3"),
|
||||
(arr4, TextBoxIcon "4")
|
||||
]
|
||||
arrowTestEdges = [
|
||||
iconToIconEnds arr1 EndAp1Arg arr2 EndAp1Result,
|
||||
iconToIconEnds arr1 EndAp1Result arr3 EndAp1Arg,
|
||||
iconToIconEnds arr2 EndAp1Result arr3 EndAp1Result,
|
||||
iconToIconEnds arr1 EndAp1Arg arr4 EndAp1Arg
|
||||
]
|
||||
|
||||
-- TODO refactor these Drawings
|
||||
nestedCaseDrawing :: Drawing
|
||||
nestedCaseDrawing = Drawing icons [] where
|
||||
@ -219,9 +136,6 @@ renderTests = do
|
||||
allDrawings = [
|
||||
drawing0,
|
||||
fact0Drawing,
|
||||
fact1Drawing,
|
||||
fact2Drawing,
|
||||
arrowTestDrawing,
|
||||
nestedCaseDrawing,
|
||||
nestedGuardDrawing,
|
||||
flatCaseDrawing,
|
||||
|
Loading…
Reference in New Issue
Block a user