From ca1caa96b2987fea40c630455ce55b2dbd60dff2 Mon Sep 17 00:00:00 2001 From: Robbie Gleichman Date: Fri, 8 Jan 2016 02:15:37 -0800 Subject: [PATCH] Clean up graphviz stuff. --- app/Icons.hs | 18 ++++++-- app/Main.hs | 120 ++++++++++++++++++++++++++++++++------------------- glance.cabal | 1 + 3 files changed, 91 insertions(+), 48 deletions(-) diff --git a/app/Icons.hs b/app/Icons.hs index 4562d23..e69c95f 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -7,6 +7,7 @@ module Icons drawIconsAndPortNumbers, PortName(..), nameDiagram, + connectMaybePorts, connectPorts, connectIconToPort, connectIcons, @@ -36,17 +37,26 @@ nameDiagram name dia = name .>> (dia # named name) arrowOptions = with & arrowHead .~ noHead & shaftStyle %~ lwG defaultLineWidth . lc white -connectPorts icon0 port0 icon1 port1 = +connectMaybePorts icon0 (Just port0) icon1 (Just port1) = connect' arrowOptions (icon0 .> port0) (icon1 .> port1) +connectMaybePorts icon0 Nothing icon1 (Just port1) = + connectOutside' arrowOptions icon0 (icon1 .> port1) +connectMaybePorts icon0 (Just port0) icon1 Nothing = + connectOutside' arrowOptions (icon0 .> port0) icon1 +connectMaybePorts icon0 Nothing icon1 Nothing = + connectOutside' arrowOptions icon0 icon1 + +connectPorts icon0 port0 icon1 port1 = + connectMaybePorts icon0 (Just port0) icon1 (Just port1) connectIconToPort icon0 icon1 port1 = - connectOutside' arrowOptions icon0 (icon1 .> port1) + connectMaybePorts icon0 (Nothing :: Maybe PortName) icon1 (Just port1) -connectIcons = - connectOutside' arrowOptions +connectIcons icon0 icon1 = + connectMaybePorts icon0 (Nothing:: Maybe PortName) icon1 (Nothing :: Maybe PortName) -- | Draw the icon with circles where the ports are drawIconAndPorts :: Icon B -> Diagram B diff --git a/app/Main.hs b/app/Main.hs index 951e63d..7e4c3cf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -14,69 +14,101 @@ import Data.Maybe (fromMaybe) import Lib import Icons --- todo: refactor and clean up - -ex1 = drawIconAndPorts apply0Icon -ex2 = drawIconsAndPortNumbers apply0Icon +-- todo: Put applyDia = iconDia apply0Icon ---apply0A = "A" .>> applyDia -apply0A = applyDia # nameDiagram "A" -apply0B = applyDia # nameDiagram "B" -result = resultIcon # named "res" -fooBox = textBox "foo" # named "foo" -barBox = textBox "bar" # named "bar" +-- --apply0A = "A" .>> applyDia +-- apply0A = applyDia # nameDiagram "A" +-- apply0B = applyDia # nameDiagram "B" +-- result = resultIcon # named "res" +-- fooBox = textBox "foo" # named "foo" +-- barBox = textBox "bar" # named "bar" -graph = mkGraph ["A", "B", "res", "foo", "bar"] - [("A", "B", ()), - ("res", "A", ()), - ("bar", "B", ()), - ("foo", "B", ()) +-- ex1 = drawIconAndPorts apply0Icon +-- ex2 = drawIconsAndPortNumbers apply0Icon +--ex3 = atPoints (map p2 [(0,0), (3,0)]) [apply0A, apply0B] + +-- fromAtoB = ex3 # connectPorts "A" (PortName 0) "B" (PortName 2) +--ex4 = apply0A ||| textBox "hello world" === textBox "1" === textBox "gpq" === textBox ['A'..'Z'] + +-- ex5 = resultIcon # named "res"||| hrule 1 ||| fromAtoB ||| hrule 1 ||| textBox "foo" # named "foo" === vrule 1 === textBox "bar" # named "bar" +-- ex6 = ex5 # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0) +-- # connectIconToPort "bar" "B" (PortName 3) # centerXY +-- +-- ex7 = ex6 # center # showOrigin # showEnvelope +-- ex8 = enclosure ex6 +-- ex9 = lambdaRegion 3 ex6 "lam0" +-- ex10 = ex9 # connectPorts ("lam0" .> "A") (PortName 1) "lam0" (PortName 0) +-- # connectPorts ("lam0" .> "B") (PortName 1) "lam0" (PortName 2) +-- ex11 = connectIcons "lam0" "y" $ ex10 === vrule 2 === textBox "y" # named "y" + +makeNamedMap :: (IsName a) => [(a, Diagram B)] -> [(a, Diagram B)] +makeNamedMap = + map (\(label, dia) -> (label, dia # nameDiagram label)) + +labelDiagramMap = makeNamedMap + [("A", applyDia ), + ("B", applyDia), + ("res", resultIcon), + ("foo", textBox "foo"), + ("bar", textBox "bar") ] -labelToDiagram = - [("A", apply0A), - ("B", apply0B), - ("res", result), - ("foo", fooBox), - ("bar", barBox) +labels = map fst labelDiagramMap + +portToPort a b c d = (a, Just $ PortName b, c, Just $ PortName d) +iconToPort a c d = (a, Nothing, c, Just $ PortName d) +iconToIcon a c = (a, Nothing, c, Nothing) + +edges = + [ + portToPort "A" 0 "B" 2, + iconToPort "foo" "B" 0, + iconToPort "res" "A" 2, + iconToPort "foo" "B" 0, + iconToPort "bar" "B" 3, + iconToPort "bar" "A" 3 ] -ex3 = atPoints (map p2 [(0,0), (3,0)]) [apply0A, apply0B] +edgesToGraph labels edges = mkGraph labels simpleEdges + where + simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges -fromAtoB = ex3 # connectPorts "A" (PortName 0) "B" (PortName 2) -ex4 = apply0A ||| textBox "hello world" === textBox "1" === textBox "gpq" === textBox ['A'..'Z'] +graph = edgesToGraph labels edges -ex5 = resultIcon # named "res"||| hrule 1 ||| fromAtoB ||| hrule 1 ||| textBox "foo" # named "foo" === vrule 1 === textBox "bar" # named "bar" -ex6 = ex5 # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0) - # connectIconToPort "bar" "B" (PortName 3) # centerXY +uncurry4 f (a, b, c, d) = f a b c d -ex7 = ex6 # center # showOrigin # showEnvelope -ex8 = enclosure ex6 -ex9 = lambdaRegion 3 ex6 # nameDiagram "lam0" -ex10 = ex9 # connectPorts ("lam0" .> "A") (PortName 1) "lam0" (PortName 0) - # connectPorts ("lam0" .> "B") (PortName 1) "lam0" (PortName 2) -ex11 = connectIcons "lam0" "y" $ ex10 === vrule 2 === textBox "y" # named "y" +makeConnections edges = applyAll connections + where + connections = map (uncurry4 connectMaybePorts) edges - -placeNodes layoutResult = mconcat placedNodes +placeNodes scaleFactor layoutResult labelDiagramMap = mconcat placedNodes where (positionMap, _) = getGraph layoutResult - placedNodes = map (\label -> place (fromMaybe mempty $ lookup label labelToDiagram) (0.04 * positionMap ! label)) $ map fst labelToDiagram + placedNodes = map mapper labels + mapper label = placedNode + where + maybeDiagram = lookup label labelDiagramMap + placedNode = place + (fromMaybe (error "placeNodes: label not in map") maybeDiagram) + (scaleFactor * positionMap ! label) -connectNodes g = - g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0) - # connectIconToPort "bar" "B" (PortName 3) # connectPorts "A" (PortName 0) "B" (PortName 2) +-- This is left commented out for a future test of the manual connect functions. +-- connectNodes g = +-- g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0) +-- # connectIconToPort "bar" "B" (PortName 3) # connectPorts "A" (PortName 0) "B" (PortName 2) +-- # connectIconToPort "bar" "A" (PortName 3) -doGraphLayout :: IO (Diagram B) -doGraphLayout = do +connectNodes = makeConnections edges + +doGraphLayout graph labelDiagramMap connectNodes = do layoutResult <- layoutGraph Neato graph - return $ placeNodes layoutResult # connectNodes + return $ placeNodes 0.04 layoutResult labelDiagramMap # connectNodes -main1 = mainWith (ex11 # bgFrame 0.1 black) +--main1 = mainWith (ex11 # bgFrame 0.1 black) main0 = do - placedNodes <- doGraphLayout + placedNodes <- doGraphLayout graph labelDiagramMap connectNodes mainWith (placedNodes # bgFrame 0.1 black) main :: IO () diff --git a/glance.cabal b/glance.cabal index d41074b..4e19b3b 100644 --- a/glance.cabal +++ b/glance.cabal @@ -30,6 +30,7 @@ executable glance-exe , diagrams-svg , diagrams-graphviz , graphviz + , containers default-language: Haskell2010 Other-modules: Icons