diff --git a/app/GraphAlgorithms.hs b/app/GraphAlgorithms.hs index e2d5fbd..ac5349c 100644 --- a/app/GraphAlgorithms.hs +++ b/app/GraphAlgorithms.hs @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternSynonyms #-} module GraphAlgorithms( ParentType(..), annotateGraph, @@ -10,10 +11,12 @@ import qualified Data.Graph.Inductive as ING import Data.List(foldl', find) import Data.Tuple(swap) +import Constants(pattern ResultPortConst, pattern InputPortConst) import Types(SyntaxNode(..), IngSyntaxGraph, Edge(..), CaseOrMultiIfTag(..), Port(..), NameAndPort(..), SgNamedNode(..) , AnnotatedGraph, EmbedInfo(..), EmbedDirection(..)) import Util(sgNamedNodeToSyntaxNode) + {-# ANN module "HLint: ignore Use record patterns" #-} data ParentType = ApplyParent @@ -61,13 +64,13 @@ syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort _ -> False where isInput mPort = case mPort of - Just (Port 0) -> True + Just InputPortConst -> True _ -> False isResult mPort = case mPort of - Just (Port 1) -> True + Nothing -> True + Just ResultPortConst -> True Just _ -> False - _ -> True parentPortNotInput = not $ isInput mParentPort parentPortNotResult = not $ isResult mParentPort diff --git a/app/Icons.hs b/app/Icons.hs index 85cede8..614a1f8 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies, ScopedTypeVariables #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} module Icons ( TransformParams(..), @@ -30,10 +34,11 @@ import Data.List(find) import Data.Maybe(catMaybes, listToMaybe, isJust, fromJust) import Data.Typeable(Typeable) +import Constants(pattern InputPortConst, pattern ResultPortConst) +import DrawingColors(colorScheme, ColorStyle(..)) import Types(Icon(..), SpecialQDiagram, SpecialBackend, SpecialNum , NodeName, Port(..), LikeApplyFlavor(..), SyntaxNode(..), NamedIcon(..), Labeled(..)) -import DrawingColors(colorScheme, ColorStyle(..)) {-# ANN module "HLint: ignore Use record patterns" #-} {-# ANN module "HLint: ignore Unnecessary hiding" #-} @@ -181,21 +186,15 @@ getPortAngles icon port maybeNodeName = case icon of -- BEGIN Port numbers -inputPortConst :: Port -inputPortConst = Port 0 - -resultPortConst :: Port -resultPortConst = Port 1 - argPortsConst :: [Port] argPortsConst = fmap Port [2,3..] -- TODO It's a bit strange that the parameter is a SyntaxNode, not an Icon. inputPort :: SyntaxNode -> Port -inputPort = const inputPortConst +inputPort = const InputPortConst resultPort :: SyntaxNode -> Port -resultPort = const resultPortConst +resultPort = const ResultPortConst caseRhsPorts :: [Port] caseRhsPorts = fmap Port [3,5..] @@ -312,7 +311,7 @@ makeTransformedText :: SpecialBackend b n => -> SpecialQDiagram b n makeTransformedText tp maybeFunText = case laValue maybeFunText of Just _ -> - makeAppInnerIcon tp True inputPortConst maybeFunText + makeAppInnerIcon tp True InputPortConst maybeFunText Nothing -> mempty appArgBox :: (HasStyle a, Typeable (N a) @@ -344,7 +343,7 @@ nestedPAppDia transformedText = makeTransformedText tp maybeFunText separation = circleRadius * 1.5 resultCircleAndPort - = makeQualifiedPort name resultPortConst + = makeQualifiedPort name ResultPortConst <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius) @@ -353,7 +352,7 @@ nestedPAppDia rotate quarterTurn (apply0Triangle borderCol) : zipWith (makeAppInnerIcon tp False) argPortsConst args allPorts - = makeQualifiedPort name inputPortConst <> alignT triangleAndPorts + = makeQualifiedPort name InputPortConst <> alignT triangleAndPorts argBox = alignT $ appArgBox borderCol (width allPorts) @@ -366,8 +365,8 @@ beside' :: (Semigroup a, Juxtaposable a) => V a (N a) -> a -> a -> a beside' dir dia1 dia2 = juxtapose dir dia1 dia2 <> dia1 -- | apply port locations: --- inputPortConst: Function --- resultPortConst: Result +-- InputPortConst: Function +-- ResultPortConst: Result -- Ports 2,3..: Arguments generalNestedDia :: SpecialBackend b n => (Colour Double -> SpecialQDiagram b n) @@ -389,13 +388,13 @@ generalNestedDia trianglePortsCircle = hsep separation $ reflectX (dia borderCol) : zipWith (makeAppInnerIcon tp False) argPortsConst (fmap pure args) ++ - [makeQualifiedPort name resultPortConst + [makeQualifiedPort name ResultPortConst <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius) ] allPorts - = makeQualifiedPort name inputPortConst <> alignL trianglePortsCircle + = makeQualifiedPort name InputPortConst <> alignL trianglePortsCircle argBox = alignL $ appArgBox borderCol (width allPorts - circleRadius) @@ -553,11 +552,11 @@ generalNestedMultiIf triangleColor lBracket bottomDia inputAndArgs = named name $ case inputAndArgs of [] -> mempty input : args -> centerXY finalDia where - finalDia = alignT (bottomDia <> makeQualifiedPort name resultPortConst) + finalDia = alignT (bottomDia <> makeQualifiedPort name ResultPortConst) <> alignB (inputIcon === (bigVerticalLine <> multiIfDia - <> makeQualifiedPort name inputPortConst)) + <> makeQualifiedPort name InputPortConst)) iconMapper (Port portNum) arg | even portNum = Right $ multiIfTriangle port ||| makeInnerIcon True arg @@ -608,8 +607,8 @@ multiIfLBracket portDia = alignL (alignT ell) <> portDia $ lwG defaultLineWidth $ lc (boolC colorScheme) (strokeLine ellShape) -- | The ports of the multiIf icon are as follows: --- inputPortConst: Top result port (not used) --- resultPortConst: Bottom result port +-- InputPortConst: Top result port (not used) +-- ResultPortConst: Bottom result port -- Ports 3,5...: The left ports for the booleans -- Ports 2,4...: The right ports for the values nestedMultiIfDia :: SpecialBackend b n => @@ -629,8 +628,8 @@ caseC :: SpecialBackend b n => caseC portDia = caseResult <> portDia -- | The ports of the case icon are as follows: --- inputPortConst: Top input port --- resultPortConst: Bottom result port +-- InputPortConst: Top input port +-- ResultPortConst: Bottom result port -- Ports 3,5...: The left ports for the results -- Ports 2,4...: The right ports for the patterns nestedCaseDia :: SpecialBackend b n => [Maybe NamedIcon] -> TransformableDia b n @@ -651,10 +650,10 @@ flatLambda paramNames (TransformParams name _ reflect angle) $ lc (regionPerimC colorScheme) $ fc (regionPerimC colorScheme) $ circle (1.5 * circleRadius) lambdaParts - = (makeQualifiedPort name inputPortConst <> resultIcon) + = (makeQualifiedPort name InputPortConst <> resultIcon) : (portIcons - ++ [makeQualifiedPort name resultPortConst <> alignR lambdaCircle]) + ++ [makeQualifiedPort name ResultPortConst <> alignR lambdaCircle]) portIcons = zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst diff --git a/glance.cabal b/glance.cabal index 9be1240..acaa12c 100644 --- a/glance.cabal +++ b/glance.cabal @@ -55,6 +55,7 @@ executable glance-exe , DrawingColors , GraphAlgorithms , SimplifySyntax + , Constants test-suite glance-test type: exitcode-stdio-1.0 @@ -96,7 +97,7 @@ test-suite glance-test , DrawingColors , GraphAlgorithms , SimplifySyntax - + , Constants source-repository head type: git diff --git a/todo.md b/todo.md index ef5366d..2e21fe5 100644 --- a/todo.md +++ b/todo.md @@ -1,7 +1,6 @@ # Todo ## Todo Now -* Remove port number magic numbers in GraphAlgorithms.hs. * Let lambda icons embed results. * Redesign case to avoid non-locality. * Add command line flags for color style, embedding, and whether to draw arrowheads.