mirror of
https://github.com/rgleichman/glance.git
synced 2024-10-05 19:58:30 +03:00
Update stackage, fix warnings and format some app files with Ormolu.
This commit is contained in:
parent
a6a9fb988c
commit
0b3efb0262
557
app/Translate.hs
557
app/Translate.hs
@ -1,44 +1,85 @@
|
||||
{-# LANGUAGE NoMonomorphismRestriction, TupleSections #-}
|
||||
module Translate(
|
||||
translateStringToSyntaxGraph,
|
||||
-- This file is formatted with Ormolu
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE NoMonomorphismRestriction #-}
|
||||
|
||||
module Translate
|
||||
( translateStringToSyntaxGraph,
|
||||
translateStringToCollapsedGraphAndDecl,
|
||||
translateModuleToCollapsedGraphs,
|
||||
customParseDecl
|
||||
) where
|
||||
customParseDecl,
|
||||
)
|
||||
where
|
||||
|
||||
import Diagrams.Prelude((<>))
|
||||
|
||||
import Control.Monad(replicateM)
|
||||
import Control.Monad.State(State, evalState)
|
||||
import Data.Either(partitionEithers)
|
||||
import Control.Monad (replicateM)
|
||||
import Control.Monad.State (State, evalState)
|
||||
import Data.Either (partitionEithers)
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
import Data.List(unzip5, partition, intercalate)
|
||||
import Data.List (intercalate, partition, unzip5)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe(fromMaybe, mapMaybe)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import GraphAlgorithms (annotateGraph, collapseAnnotatedGraph)
|
||||
import Icons
|
||||
( argumentPorts,
|
||||
casePatternPorts,
|
||||
caseRhsPorts,
|
||||
inputPort,
|
||||
resultPort,
|
||||
)
|
||||
import qualified Language.Haskell.Exts as Exts
|
||||
import qualified Language.Haskell.Exts.Pretty as PExts
|
||||
|
||||
import GraphAlgorithms(annotateGraph, collapseAnnotatedGraph)
|
||||
import Icons(inputPort, resultPort, argumentPorts, caseRhsPorts,
|
||||
casePatternPorts)
|
||||
import SimplifySyntax(SimpAlt(..), stringToSimpDecl, SimpExp(..), SimpPat(..)
|
||||
, qNameToString, nameToString, customParseDecl
|
||||
, SimpDecl(..), hsDeclToSimpDecl, SelectorAndVal(..))
|
||||
import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..)
|
||||
, SgSink(..), syntaxGraphFromNodes
|
||||
, syntaxGraphFromNodesEdges, getUniqueName
|
||||
, edgesForRefPortList, makeApplyGraph, makeMultiIfGraph
|
||||
, combineExpressions, namesInPattern, lookupReference
|
||||
, deleteBindings, makeEdges, makeBox, syntaxGraphToFglGraph
|
||||
, getUniqueString, bindsToSyntaxGraph, SgBind(..)
|
||||
, graphAndRefToGraph, initialIdState)
|
||||
import Types(AnnotatedGraph, Labeled(..), NameAndPort(..), IDState,
|
||||
Edge, SyntaxNode(..), NodeName, SgNamedNode,
|
||||
LikeApplyFlavor(..), CaseOrMultiIfTag(..), Named(..)
|
||||
, mkEmbedder)
|
||||
import Util(makeSimpleEdge, nameAndPort, justName)
|
||||
import SimplifySyntax
|
||||
( SelectorAndVal (..),
|
||||
SimpAlt (..),
|
||||
SimpDecl (..),
|
||||
SimpExp (..),
|
||||
SimpPat (..),
|
||||
customParseDecl,
|
||||
hsDeclToSimpDecl,
|
||||
nameToString,
|
||||
qNameToString,
|
||||
stringToSimpDecl,
|
||||
)
|
||||
import TranslateCore
|
||||
( EvalContext,
|
||||
GraphAndRef (..),
|
||||
Reference,
|
||||
SgBind (..),
|
||||
SgSink (..),
|
||||
SyntaxGraph (..),
|
||||
bindsToSyntaxGraph,
|
||||
combineExpressions,
|
||||
deleteBindings,
|
||||
edgesForRefPortList,
|
||||
getUniqueName,
|
||||
getUniqueString,
|
||||
graphAndRefToGraph,
|
||||
initialIdState,
|
||||
lookupReference,
|
||||
makeApplyGraph,
|
||||
makeBox,
|
||||
makeEdges,
|
||||
makeMultiIfGraph,
|
||||
namesInPattern,
|
||||
syntaxGraphFromNodes,
|
||||
syntaxGraphFromNodesEdges,
|
||||
syntaxGraphToFglGraph,
|
||||
)
|
||||
import Types
|
||||
( AnnotatedGraph,
|
||||
CaseOrMultiIfTag (..),
|
||||
Edge,
|
||||
IDState,
|
||||
Labeled (..),
|
||||
LikeApplyFlavor (..),
|
||||
NameAndPort (..),
|
||||
Named (..),
|
||||
NodeName,
|
||||
SgNamedNode,
|
||||
SyntaxNode (..),
|
||||
mkEmbedder,
|
||||
)
|
||||
import Util (justName, makeSimpleEdge, nameAndPort)
|
||||
|
||||
{-# ANN module "HLint: ignore Use record patterns" #-}
|
||||
|
||||
@ -52,8 +93,8 @@ import Util(makeSimpleEdge, nameAndPort, justName)
|
||||
-- | Make a syntax graph that has the bindings for a list of "as pattern" (@)
|
||||
-- names.
|
||||
makeAsBindGraph :: Reference -> [Maybe String] -> SyntaxGraph
|
||||
makeAsBindGraph ref asNames
|
||||
= bindsToSyntaxGraph $ mapMaybe makeBind asNames
|
||||
makeAsBindGraph ref asNames =
|
||||
bindsToSyntaxGraph $ mapMaybe makeBind asNames
|
||||
where
|
||||
makeBind mName = case mName of
|
||||
Nothing -> Nothing
|
||||
@ -63,22 +104,22 @@ grNamePortToGrRef :: (SyntaxGraph, NameAndPort) -> GraphAndRef
|
||||
grNamePortToGrRef (graph, np) = GraphAndRef graph (Right np)
|
||||
|
||||
-- TODO Find a better name for bindOrAltHelper
|
||||
bindOrAltHelper :: Show l =>
|
||||
EvalContext
|
||||
-> SimpPat l
|
||||
-> SimpExp l
|
||||
-> State IDState ((GraphAndRef, Maybe String), GraphAndRef)
|
||||
bindOrAltHelper ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
SimpPat l ->
|
||||
SimpExp l ->
|
||||
State IDState ((GraphAndRef, Maybe String), GraphAndRef)
|
||||
bindOrAltHelper c pat e = do
|
||||
patGraphAndRef <- evalPattern pat
|
||||
let
|
||||
rhsContext = namesInPattern patGraphAndRef <> c
|
||||
let rhsContext = namesInPattern patGraphAndRef <> c
|
||||
rhsGraphAndRef <- evalExp rhsContext e
|
||||
pure (patGraphAndRef, rhsGraphAndRef)
|
||||
|
||||
|
||||
patternName :: (GraphAndRef, Maybe String) -> String
|
||||
patternName (GraphAndRef _ ref, mStr) = fromMaybe
|
||||
(case ref of
|
||||
patternName (GraphAndRef _ ref, mStr) =
|
||||
fromMaybe
|
||||
( case ref of
|
||||
Left str -> str
|
||||
Right _ -> ""
|
||||
)
|
||||
@ -118,10 +159,10 @@ asNameBind (GraphAndRef _ ref, mAsName) = case mAsName of
|
||||
Just asName -> Just $ SgBind asName ref
|
||||
|
||||
patternArgumentMapper ::
|
||||
((GraphAndRef, Maybe String), t)
|
||||
-> (String, Either (GraphAndRef, t) (SgNamedNode, SyntaxGraph))
|
||||
patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port)
|
||||
= (patName, eitherVal)
|
||||
((GraphAndRef, Maybe String), t) ->
|
||||
(String, Either (GraphAndRef, t) (SgNamedNode, SyntaxGraph))
|
||||
patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port) =
|
||||
(patName, eitherVal)
|
||||
where
|
||||
graph = graphAndRefToGraph graphAndRef
|
||||
patName = patternName asGraphAndRef
|
||||
@ -130,38 +171,37 @@ patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port)
|
||||
(SyntaxGraph [namedNode] [] _ _ _) -> Right (namedNode, graph)
|
||||
_ -> Left (graphAndRef, port)
|
||||
|
||||
|
||||
graphToTuple ::
|
||||
SyntaxGraph
|
||||
-> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
|
||||
SyntaxGraph ->
|
||||
([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
|
||||
graphToTuple (SyntaxGraph a b c d e) = (a, b, c, d, e)
|
||||
|
||||
graphsToComponents ::
|
||||
[SyntaxGraph]
|
||||
-> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
|
||||
graphsToComponents graphs
|
||||
= (mconcat a, mconcat b, mconcat c, mconcat d, mconcat e)
|
||||
[SyntaxGraph] ->
|
||||
([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
|
||||
graphsToComponents graphs =
|
||||
(mconcat a, mconcat b, mconcat c, mconcat d, mconcat e)
|
||||
where
|
||||
(a, b, c, d, e) = unzip5 $ fmap graphToTuple graphs
|
||||
|
||||
makeNestedPatternGraph ::
|
||||
NodeName
|
||||
-> String
|
||||
-> [(GraphAndRef, Maybe String)]
|
||||
-> (SyntaxGraph, NameAndPort)
|
||||
NodeName ->
|
||||
String ->
|
||||
[(GraphAndRef, Maybe String)] ->
|
||||
(SyntaxGraph, NameAndPort)
|
||||
makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
|
||||
where
|
||||
dummyNode = PatternApplyNode "" []
|
||||
|
||||
argsAndPorts
|
||||
= zip argVals $ map (nameAndPort applyIconName) $ argumentPorts dummyNode
|
||||
argsAndPorts =
|
||||
zip argVals $ map (nameAndPort applyIconName) $ argumentPorts dummyNode
|
||||
mappedArgs = fmap patternArgumentMapper argsAndPorts
|
||||
|
||||
(unnestedArgsAndPort, nestedNamedNodesAndGraphs)
|
||||
= partitionEithers (fmap snd mappedArgs)
|
||||
(unnestedArgsAndPort, nestedNamedNodesAndGraphs) =
|
||||
partitionEithers (fmap snd mappedArgs)
|
||||
|
||||
(nestedArgs, _, nestedSinks, nestedBinds, nestedEMaps)
|
||||
= graphsToComponents $ fmap snd nestedNamedNodesAndGraphs
|
||||
(nestedArgs, _, nestedSinks, nestedBinds, nestedEMaps) =
|
||||
graphsToComponents $ fmap snd nestedNamedNodesAndGraphs
|
||||
|
||||
argListMapper (str, arg) = case arg of
|
||||
Left _ -> Labeled Nothing str
|
||||
@ -177,24 +217,28 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
|
||||
asNameBinds = mapMaybe asNameBind argVals
|
||||
allBinds = nestedBinds <> asNameBinds
|
||||
|
||||
newEMap = Map.fromList
|
||||
newEMap =
|
||||
Map.fromList
|
||||
((\(Named n _) -> (n, applyIconName)) <$> nestedArgs)
|
||||
<> nestedEMaps
|
||||
|
||||
newGraph = SyntaxGraph
|
||||
newGraph =
|
||||
SyntaxGraph
|
||||
icons
|
||||
[]
|
||||
nestedSinks
|
||||
allBinds
|
||||
newEMap
|
||||
nestedApplyResult = (newGraph <> combinedGraph
|
||||
, nameAndPort applyIconName (resultPort pAppNode))
|
||||
nestedApplyResult =
|
||||
( newGraph <> combinedGraph,
|
||||
nameAndPort applyIconName (resultPort pAppNode)
|
||||
)
|
||||
|
||||
|
||||
evalPApp :: Show l =>
|
||||
Exts.QName l
|
||||
-> [SimpPat l]
|
||||
-> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalPApp ::
|
||||
Show l =>
|
||||
Exts.QName l ->
|
||||
[SimpPat l] ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalPApp name patterns = case patterns of
|
||||
[] -> makeBox constructorName
|
||||
_ -> do
|
||||
@ -226,22 +270,29 @@ evalPLit ::
|
||||
evalPLit sign l = case sign of
|
||||
Exts.Signless _ -> evalLit l
|
||||
Exts.Negative _ -> makeBox ('-' : showLiteral l)
|
||||
|
||||
-- END evalPLit
|
||||
|
||||
evalPAsPat :: Show l =>
|
||||
Exts.Name l -> SimpPat l -> State IDState (GraphAndRef, Maybe String)
|
||||
evalPAsPat ::
|
||||
Show l =>
|
||||
Exts.Name l ->
|
||||
SimpPat l ->
|
||||
State IDState (GraphAndRef, Maybe String)
|
||||
evalPAsPat n p = do
|
||||
(GraphAndRef evaledPatGraph evaledPatRef, mInnerName) <- evalPattern p
|
||||
let
|
||||
outerName = nameToString n
|
||||
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))
|
||||
makePatternResult ::
|
||||
Functor f =>
|
||||
f (SyntaxGraph, NameAndPort) ->
|
||||
f (GraphAndRef, Maybe String)
|
||||
makePatternResult =
|
||||
fmap (\(graph, namePort) -> (GraphAndRef graph (Right namePort), Nothing))
|
||||
|
||||
evalPattern :: Show l => SimpPat l -> State IDState (GraphAndRef, Maybe String)
|
||||
evalPattern p = case p of
|
||||
@ -250,7 +301,8 @@ evalPattern p = case p of
|
||||
SpApp _ name patterns -> makePatternResult $ evalPApp name patterns
|
||||
SpAsPat _ name pat -> evalPAsPat name pat
|
||||
SpWildCard _ -> makePatternResult $ makeBox "_"
|
||||
-- _ -> error ("evalPattern todo: " <> show p)
|
||||
|
||||
-- _ -> error ("evalPattern todo: " <> show p)
|
||||
|
||||
-- END evalPattern
|
||||
|
||||
@ -258,8 +310,10 @@ evalPattern p = case p of
|
||||
|
||||
-- strToGraphRef is not in TranslateCore, since it is only used by evalQName.
|
||||
strToGraphRef :: EvalContext -> String -> State IDState GraphAndRef
|
||||
strToGraphRef c str = fmap mapper (makeBox str) where
|
||||
mapper gr = if str `elem` c
|
||||
strToGraphRef c str = fmap mapper (makeBox str)
|
||||
where
|
||||
mapper gr =
|
||||
if str `elem` c
|
||||
then GraphAndRef mempty (Left str)
|
||||
else grNamePortToGrRef gr
|
||||
|
||||
@ -267,28 +321,33 @@ strToGraphRef c str = fmap mapper (makeBox str) where
|
||||
|
||||
-- BEGIN apply and compose helper functions
|
||||
|
||||
evalFunExpAndArgs :: Show l =>
|
||||
EvalContext
|
||||
-> LikeApplyFlavor
|
||||
-> (SimpExp l, [SimpExp l])
|
||||
-> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalFunExpAndArgs ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
LikeApplyFlavor ->
|
||||
(SimpExp l, [SimpExp l]) ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalFunExpAndArgs c flavor (funExp, argExps) = do
|
||||
funVal <- evalExp c funExp
|
||||
argVals <- mapM (evalExp c) argExps
|
||||
applyIconName <- getUniqueName
|
||||
pure
|
||||
$ makeApplyGraph (length argExps) flavor False applyIconName funVal argVals
|
||||
pure $
|
||||
makeApplyGraph (length argExps) flavor False applyIconName funVal argVals
|
||||
|
||||
-- END apply and compose helper functions
|
||||
|
||||
evalFunctionComposition :: Show l =>
|
||||
EvalContext -> [SimpExp l] -> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalFunctionComposition ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
[SimpExp l] ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalFunctionComposition c functions = do
|
||||
let reversedFunctios = reverse functions
|
||||
evaluatedFunctions <- mapM (evalExp c) reversedFunctios
|
||||
neverUsedPort <- Left <$> getUniqueString "unusedArgument"
|
||||
applyIconName <- getUniqueName
|
||||
pure $ makeApplyGraph
|
||||
pure $
|
||||
makeApplyGraph
|
||||
(length evaluatedFunctions)
|
||||
ComposeNodeFlavor
|
||||
False
|
||||
@ -299,8 +358,8 @@ evalFunctionComposition c functions = do
|
||||
-- | Turn (a . b . c) into [a, b, c]
|
||||
compositionToList :: SimpExp l -> [SimpExp l]
|
||||
compositionToList e = case e of
|
||||
(SeApp _ (SeApp _ (SeName _ ".") f1) f2)
|
||||
-> f1 : compositionToList f2
|
||||
(SeApp _ (SeApp _ (SeName _ ".") f1) f2) ->
|
||||
f1 : compositionToList f2
|
||||
x -> [x]
|
||||
|
||||
-- BEGIN evaluateAppExpression
|
||||
@ -309,7 +368,8 @@ compositionToList e = case e of
|
||||
-- return the nesting depth if (f x) is rendered with
|
||||
-- the (normal apply icon, compose apply icon)
|
||||
applyComposeScoreHelper :: SimpExp l -> SimpExp l -> (Int, Int)
|
||||
applyComposeScoreHelper exp1 exp2 = (appScore, compScore) where
|
||||
applyComposeScoreHelper exp1 exp2 = (appScore, compScore)
|
||||
where
|
||||
(e1App, e1Comp) = applyComposeScore exp1
|
||||
(e2App, e2Comp) = applyComposeScore exp2
|
||||
|
||||
@ -323,8 +383,8 @@ applyComposeScoreHelper exp1 exp2 = (appScore, compScore) where
|
||||
|
||||
compScore = max leftComp rightComp
|
||||
|
||||
|
||||
-- TODO Consider putting this logic in a separate "simplifyExpression" function.
|
||||
|
||||
-- | Returns the amount of nesting if the App is converted to
|
||||
-- (applyNode, composeNode)
|
||||
applyComposeScore :: SimpExp l -> (Int, Int)
|
||||
@ -333,6 +393,7 @@ applyComposeScore e = case e of
|
||||
_ -> (0, 0)
|
||||
|
||||
-- Todo add test for this function
|
||||
|
||||
-- | Given an App expression, return
|
||||
-- (function, list of arguments)
|
||||
appExpToFuncArgs :: SimpExp l -> (SimpExp l, [SimpExp l])
|
||||
@ -351,16 +412,18 @@ appExpToArgFuncs e = case e of
|
||||
(argExp, funcs) = appExpToArgFuncs exp2
|
||||
simpleExp -> (simpleExp, [])
|
||||
|
||||
|
||||
-- TODO Refactor this and all sub-expressions
|
||||
evalApp :: Show l =>
|
||||
EvalContext -> SimpExp l
|
||||
-> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalApp ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
SimpExp l ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalApp c expr = case expr of
|
||||
-- TODO This pattern for "." appears at least twice in this file. Refactor?
|
||||
(SeApp _ (SeApp _ (SeName _ ".") _) _)
|
||||
-> evalFunctionComposition c (compositionToList expr)
|
||||
_ -> if appScore <= compScore
|
||||
(SeApp _ (SeApp _ (SeName _ ".") _) _) ->
|
||||
evalFunctionComposition c (compositionToList expr)
|
||||
_ ->
|
||||
if appScore <= compScore
|
||||
then evalFunExpAndArgs c ApplyNodeFlavor (appExpToFuncArgs expr)
|
||||
else evalFunExpAndArgs c ComposeNodeFlavor (appExpToArgFuncs expr)
|
||||
where
|
||||
@ -372,93 +435,104 @@ evalApp c expr = case expr of
|
||||
|
||||
getBoundVarName :: Show l => SimpDecl l -> [String]
|
||||
getBoundVarName d = case d of
|
||||
SdPatBind _ pat _ -> namesInPattern
|
||||
SdPatBind _ pat _ ->
|
||||
namesInPattern
|
||||
-- TODO Should evalState be used here?
|
||||
$ evalState (evalPattern pat) initialIdState
|
||||
$
|
||||
evalState (evalPattern pat) initialIdState
|
||||
SdTypeSig _ _ _ -> []
|
||||
SdCatchAll _ -> []
|
||||
|
||||
evalDecls :: Show l =>
|
||||
EvalContext -> [SimpDecl l] -> State IDState (SyntaxGraph, EvalContext)
|
||||
evalDecls ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
[SimpDecl l] ->
|
||||
State IDState (SyntaxGraph, EvalContext)
|
||||
evalDecls c decls =
|
||||
let
|
||||
boundNames = concatMap getBoundVarName decls
|
||||
let boundNames = concatMap getBoundVarName decls
|
||||
augmentedContext = boundNames <> c
|
||||
in
|
||||
(,augmentedContext) . mconcat <$> mapM (evalDecl augmentedContext) decls
|
||||
in (,augmentedContext) . mconcat <$> mapM (evalDecl augmentedContext) decls
|
||||
|
||||
evalLet :: Show l =>
|
||||
EvalContext
|
||||
-> [SimpDecl l]
|
||||
-> SimpExp l
|
||||
-> State IDState GraphAndRef
|
||||
evalLet ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
[SimpDecl l] ->
|
||||
SimpExp l ->
|
||||
State IDState GraphAndRef
|
||||
evalLet c decls expr = do
|
||||
(bindGraph, bindContext) <- evalDecls c decls
|
||||
expVal <- evalExp bindContext expr
|
||||
let
|
||||
GraphAndRef expGraph expResult = expVal
|
||||
let GraphAndRef expGraph expResult = expVal
|
||||
newGraph = deleteBindings . makeEdges $ expGraph <> bindGraph
|
||||
bindings = sgBinds bindGraph
|
||||
pure $ GraphAndRef newGraph (lookupReference bindings expResult)
|
||||
|
||||
-- END evalGeneralLet
|
||||
|
||||
evalSelectorAndVal :: Show l =>
|
||||
EvalContext -> SelectorAndVal l -> State IDState (GraphAndRef, GraphAndRef)
|
||||
evalSelectorAndVal c SelectorAndVal{svSelector=sel, svVal=val}
|
||||
= (,) <$> evalExp c sel <*> evalExp c val
|
||||
evalSelectorAndVal ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
SelectorAndVal l ->
|
||||
State IDState (GraphAndRef, GraphAndRef)
|
||||
evalSelectorAndVal c SelectorAndVal {svSelector = sel, svVal = val} =
|
||||
(,) <$> evalExp c sel <*> evalExp c val
|
||||
|
||||
evalMultiIf :: Show l =>
|
||||
EvalContext -> [SelectorAndVal l] -> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalMultiIf c selectorsAndVals = let
|
||||
evaledRhss = unzip <$> mapM (evalSelectorAndVal c) selectorsAndVals
|
||||
in
|
||||
makeMultiIfGraph (length selectorsAndVals)
|
||||
<$>
|
||||
getUniqueName
|
||||
<*>
|
||||
fmap fst evaledRhss
|
||||
<*>
|
||||
fmap snd evaledRhss
|
||||
evalMultiIf ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
[SelectorAndVal l] ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalMultiIf c selectorsAndVals =
|
||||
let evaledRhss = unzip <$> mapM (evalSelectorAndVal c) selectorsAndVals
|
||||
in makeMultiIfGraph (length selectorsAndVals)
|
||||
<$> getUniqueName
|
||||
<*> fmap fst evaledRhss
|
||||
<*> fmap snd evaledRhss
|
||||
|
||||
-- BEGIN evalCase
|
||||
|
||||
-- TODO patRhsAreConnected is sometimes incorrectly true if the pat is just a
|
||||
-- name
|
||||
-- returns (combined graph, pattern reference, rhs reference)
|
||||
evalAlt :: Show l =>
|
||||
EvalContext
|
||||
-> SimpAlt l
|
||||
-> State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
|
||||
evalAlt ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
SimpAlt l ->
|
||||
State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
|
||||
evalAlt c (SimpAlt pat rhs) = do
|
||||
((GraphAndRef patGraph patRef, mPatAsName), GraphAndRef rhsGraph rhsRef) <-
|
||||
bindOrAltHelper c pat rhs
|
||||
let
|
||||
grWithEdges = makeEdges (rhsGraph <> patGraph)
|
||||
let grWithEdges = makeEdges (rhsGraph <> patGraph)
|
||||
lookedUpRhsRef = lookupReference (sgBinds grWithEdges) rhsRef
|
||||
-- The pattern and rhs are conneted if makeEdges added extra edges, or if
|
||||
-- the rhsRef refers to a source in the pattern.
|
||||
patRhsAreConnected
|
||||
= (rhsRef /= lookedUpRhsRef)
|
||||
patRhsAreConnected =
|
||||
(rhsRef /= lookedUpRhsRef)
|
||||
|| ( length (sgEdges grWithEdges)
|
||||
>
|
||||
(length (sgEdges rhsGraph) + length (sgEdges patGraph)))
|
||||
pure (patRhsAreConnected
|
||||
, deleteBindings grWithEdges
|
||||
, patRef
|
||||
, lookedUpRhsRef
|
||||
, mPatAsName)
|
||||
> (length (sgEdges rhsGraph) + length (sgEdges patGraph))
|
||||
)
|
||||
pure
|
||||
( patRhsAreConnected,
|
||||
deleteBindings grWithEdges,
|
||||
patRef,
|
||||
lookedUpRhsRef,
|
||||
mPatAsName
|
||||
)
|
||||
|
||||
evalCaseHelper ::
|
||||
Int
|
||||
-> NodeName
|
||||
-> [NodeName]
|
||||
-> GraphAndRef
|
||||
-> [(Bool, SyntaxGraph, Reference, Reference, Maybe String)]
|
||||
-> (SyntaxGraph, NameAndPort)
|
||||
evalCaseHelper numAlts caseIconName resultIconNames
|
||||
(GraphAndRef expGraph expRef) evaledAlts
|
||||
= result
|
||||
Int ->
|
||||
NodeName ->
|
||||
[NodeName] ->
|
||||
GraphAndRef ->
|
||||
[(Bool, SyntaxGraph, Reference, Reference, Maybe String)] ->
|
||||
(SyntaxGraph, NameAndPort)
|
||||
evalCaseHelper
|
||||
numAlts
|
||||
caseIconName
|
||||
resultIconNames
|
||||
(GraphAndRef expGraph expRef)
|
||||
evaledAlts =
|
||||
result
|
||||
where
|
||||
(patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
|
||||
combindedAltGraph = mconcat altGraphs
|
||||
@ -467,8 +541,10 @@ evalCaseHelper numAlts caseIconName resultIconNames
|
||||
caseGraph = syntaxGraphFromNodes icons
|
||||
expEdge = (expRef, nameAndPort caseIconName (inputPort caseNode))
|
||||
patEdges = zip patRefs $ map (nameAndPort caseIconName) casePatternPorts
|
||||
rhsEdges = zip patRhsConnected $ zip rhsRefs
|
||||
$ map (nameAndPort caseIconName) caseRhsPorts
|
||||
rhsEdges =
|
||||
zip patRhsConnected $
|
||||
zip rhsRefs $
|
||||
map (nameAndPort caseIconName) caseRhsPorts
|
||||
(connectedRhss, unConnectedRhss) = partition fst rhsEdges
|
||||
|
||||
makeCaseResult :: NodeName -> Reference -> SyntaxGraph
|
||||
@ -480,40 +556,41 @@ evalCaseHelper numAlts caseIconName resultIconNames
|
||||
rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
|
||||
|
||||
caseResultGraphs =
|
||||
mconcat
|
||||
$ zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
|
||||
mconcat $
|
||||
zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
|
||||
filteredRhsEdges = fmap snd unConnectedRhss
|
||||
patternEdgesGraph = edgesForRefPortList True patEdges
|
||||
caseEdgeGraph = edgesForRefPortList False (expEdge : filteredRhsEdges)
|
||||
|
||||
bindGraph = makeAsBindGraph expRef asNames
|
||||
|
||||
finalGraph = deleteBindings $ makeEdges $ mconcat [bindGraph
|
||||
, patternEdgesGraph
|
||||
, caseResultGraphs
|
||||
, expGraph
|
||||
, caseEdgeGraph
|
||||
, caseGraph
|
||||
, combindedAltGraph]
|
||||
finalGraph =
|
||||
deleteBindings $
|
||||
makeEdges $
|
||||
mconcat
|
||||
[ bindGraph,
|
||||
patternEdgesGraph,
|
||||
caseResultGraphs,
|
||||
expGraph,
|
||||
caseEdgeGraph,
|
||||
caseGraph,
|
||||
combindedAltGraph
|
||||
]
|
||||
result = (finalGraph, nameAndPort caseIconName (resultPort caseNode))
|
||||
|
||||
|
||||
evalCase :: Show l =>
|
||||
EvalContext -> SimpExp l -> [SimpAlt l]
|
||||
-> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalCase ::
|
||||
Show l =>
|
||||
EvalContext ->
|
||||
SimpExp l ->
|
||||
[SimpAlt l] ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalCase c e alts =
|
||||
let
|
||||
numAlts = length alts
|
||||
in
|
||||
evalCaseHelper (length alts)
|
||||
<$>
|
||||
getUniqueName
|
||||
<*>
|
||||
replicateM numAlts getUniqueName
|
||||
<*>
|
||||
evalExp c e
|
||||
<*>
|
||||
mapM (evalAlt c) alts
|
||||
let numAlts = length alts
|
||||
in evalCaseHelper (length alts)
|
||||
<$> getUniqueName
|
||||
<*> replicateM numAlts getUniqueName
|
||||
<*> evalExp c e
|
||||
<*> mapM (evalAlt c) alts
|
||||
|
||||
-- END evalCase
|
||||
|
||||
@ -524,22 +601,21 @@ asBindGraphZipper :: Maybe String -> NameAndPort -> SyntaxGraph
|
||||
asBindGraphZipper asName nameNPort = makeAsBindGraph (Right nameNPort) [asName]
|
||||
|
||||
-- TODO Refactor evalLambda
|
||||
evalLambda :: Show l
|
||||
=> l
|
||||
-> EvalContext
|
||||
-> [SimpPat l]
|
||||
-> SimpExp l
|
||||
-> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalLambda ::
|
||||
Show l =>
|
||||
l ->
|
||||
EvalContext ->
|
||||
[SimpPat l] ->
|
||||
SimpExp l ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalLambda _ context patterns expr = do
|
||||
lambdaName <- getUniqueName
|
||||
patternValsWithAsNames <- mapM evalPattern patterns
|
||||
let
|
||||
patternVals = fmap fst patternValsWithAsNames
|
||||
let patternVals = fmap fst patternValsWithAsNames
|
||||
patternStrings = concatMap namesInPattern patternValsWithAsNames
|
||||
rhsContext = patternStrings <> context
|
||||
GraphAndRef rhsRawGraph rhsRef <- evalExp rhsContext expr
|
||||
let
|
||||
paramNames = fmap patternName patternValsWithAsNames
|
||||
let paramNames = fmap patternName patternValsWithAsNames
|
||||
enclosedNodeNames = Set.fromList $ naName <$> sgNodes combinedGraph
|
||||
lambdaNode = FunctionDefNode paramNames enclosedNodeNames
|
||||
lambdaPorts = map (nameAndPort lambdaName) $ argumentPorts lambdaNode
|
||||
@ -556,12 +632,15 @@ evalLambda _ context patterns expr = do
|
||||
(makeSimpleEdge (rhsPort, returnPort) : patternEdges, mempty)
|
||||
finalGraph = SyntaxGraph icons newEdges newSinks newBinds mempty
|
||||
|
||||
asBindGraph = mconcat $ zipWith
|
||||
asBindGraph =
|
||||
mconcat $
|
||||
zipWith
|
||||
asBindGraphZipper
|
||||
(fmap snd patternValsWithAsNames)
|
||||
lambdaPorts
|
||||
combinedGraph = deleteBindings . makeEdges
|
||||
$ (asBindGraph <> rhsRawGraph <> patternGraph <> finalGraph)
|
||||
combinedGraph =
|
||||
deleteBindings . makeEdges $
|
||||
(asBindGraph <> rhsRawGraph <> patternGraph <> finalGraph)
|
||||
|
||||
pure (combinedGraph, nameAndPort lambdaName (resultPort lambdaNode))
|
||||
where
|
||||
@ -584,18 +663,22 @@ evalExp c x = case x of
|
||||
SeLambda l patterns e -> grNamePortToGrRef <$> evalLambda l c patterns e
|
||||
SeLet _ decls expr -> evalLet c decls expr
|
||||
SeCase _ expr alts -> grNamePortToGrRef <$> evalCase c expr alts
|
||||
SeMultiIf _ selectorsAndVals
|
||||
-> grNamePortToGrRef <$> evalMultiIf c selectorsAndVals
|
||||
SeMultiIf _ selectorsAndVals ->
|
||||
grNamePortToGrRef <$> evalMultiIf c selectorsAndVals
|
||||
|
||||
-- BEGIN evalDecl
|
||||
|
||||
evalPatBind :: Show l =>
|
||||
l -> EvalContext -> SimpPat l -> SimpExp l -> State IDState SyntaxGraph
|
||||
evalPatBind ::
|
||||
Show l =>
|
||||
l ->
|
||||
EvalContext ->
|
||||
SimpPat l ->
|
||||
SimpExp l ->
|
||||
State IDState SyntaxGraph
|
||||
evalPatBind _ c pat e = do
|
||||
((GraphAndRef patGraph patRef, mPatAsName), GraphAndRef rhsGraph rhsRef) <-
|
||||
bindOrAltHelper c pat e
|
||||
let
|
||||
(newEdges, newSinks, bindings) = case patRef of
|
||||
let (newEdges, newSinks, bindings) = case patRef of
|
||||
(Left s) -> (mempty, mempty, [SgBind s rhsRef])
|
||||
(Right patPort) -> case rhsRef of
|
||||
(Left rhsStr) -> (mempty, [SgSink rhsStr patPort], mempty)
|
||||
@ -606,13 +689,17 @@ evalPatBind _ c pat e = do
|
||||
|
||||
-- Pretty printing the entire type sig results in extra whitespace in the middle
|
||||
-- TODO May want to trim whitespace from (prettyPrint typeForNames)
|
||||
evalTypeSig :: Show l =>
|
||||
[Exts.Name l] -> Exts.Type l
|
||||
-> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalTypeSig names typeForNames = makeBox
|
||||
(intercalate "," (fmap prettyPrintWithoutNewlines names)
|
||||
evalTypeSig ::
|
||||
Show l =>
|
||||
[Exts.Name l] ->
|
||||
Exts.Type l ->
|
||||
State IDState (SyntaxGraph, NameAndPort)
|
||||
evalTypeSig names typeForNames =
|
||||
makeBox
|
||||
( intercalate "," (fmap prettyPrintWithoutNewlines names)
|
||||
++ " :: "
|
||||
++ prettyPrintWithoutNewlines typeForNames)
|
||||
++ prettyPrintWithoutNewlines typeForNames
|
||||
)
|
||||
where
|
||||
-- TODO Make custom version of prettyPrint for type signitures.
|
||||
-- Use (unwords . words) to convert consecutive whitspace characters to one
|
||||
@ -631,13 +718,11 @@ evalDecl c d = case d of
|
||||
|
||||
showTopLevelBinds :: SyntaxGraph -> State IDState SyntaxGraph
|
||||
showTopLevelBinds gr = do
|
||||
let
|
||||
binds = sgBinds gr
|
||||
let binds = sgBinds gr
|
||||
addBind (SgBind _ (Left _)) = pure mempty
|
||||
addBind (SgBind patName (Right port)) = do
|
||||
uniquePatName <- getUniqueName
|
||||
let
|
||||
icons = [Named uniquePatName $ mkEmbedder (BindNameNode patName)]
|
||||
let icons = [Named uniquePatName $ mkEmbedder (BindNameNode patName)]
|
||||
edges = [makeSimpleEdge (port, justName uniquePatName)]
|
||||
edgeGraph = syntaxGraphFromNodesEdges icons edges
|
||||
pure edgeGraph
|
||||
@ -645,7 +730,8 @@ showTopLevelBinds gr = do
|
||||
pure $ newGraph <> gr
|
||||
|
||||
translateDeclToSyntaxGraph :: Show l => SimpDecl l -> SyntaxGraph
|
||||
translateDeclToSyntaxGraph d = graph where
|
||||
translateDeclToSyntaxGraph d = graph
|
||||
where
|
||||
evaluatedDecl = evalDecl mempty d >>= showTopLevelBinds
|
||||
graph = evalState evaluatedDecl initialIdState
|
||||
|
||||
@ -654,27 +740,32 @@ translateStringToSyntaxGraph :: String -> SyntaxGraph
|
||||
translateStringToSyntaxGraph = translateDeclToSyntaxGraph . stringToSimpDecl
|
||||
|
||||
syntaxGraphToCollapsedGraph :: SyntaxGraph -> AnnotatedGraph FGR.Gr
|
||||
syntaxGraphToCollapsedGraph
|
||||
= collapseAnnotatedGraph . annotateGraph . syntaxGraphToFglGraph
|
||||
-- = annotateGraph . syntaxGraphToFglGraph
|
||||
syntaxGraphToCollapsedGraph =
|
||||
collapseAnnotatedGraph . annotateGraph . syntaxGraphToFglGraph
|
||||
|
||||
-- = annotateGraph . syntaxGraphToFglGraph
|
||||
|
||||
translateDeclToCollapsedGraph :: Show l => Exts.Decl l -> AnnotatedGraph FGR.Gr
|
||||
translateDeclToCollapsedGraph
|
||||
= syntaxGraphToCollapsedGraph . translateDeclToSyntaxGraph . hsDeclToSimpDecl
|
||||
translateDeclToCollapsedGraph =
|
||||
syntaxGraphToCollapsedGraph . translateDeclToSyntaxGraph . hsDeclToSimpDecl
|
||||
|
||||
-- Profiling: At one point, this was about 1.5% of total time.
|
||||
translateStringToCollapsedGraphAndDecl ::
|
||||
String -> (AnnotatedGraph FGR.Gr, Exts.Decl Exts.SrcSpanInfo)
|
||||
translateStringToCollapsedGraphAndDecl s = (drawing, decl) where
|
||||
translateStringToCollapsedGraphAndDecl s = (drawing, decl)
|
||||
where
|
||||
decl = customParseDecl s -- :: ParseResult Module
|
||||
drawing = translateDeclToCollapsedGraph decl
|
||||
|
||||
translateModuleToCollapsedGraphs :: Show l =>
|
||||
Exts.Module l -> [AnnotatedGraph FGR.Gr]
|
||||
translateModuleToCollapsedGraphs (Exts.Module _ _ _ _ decls)
|
||||
= fmap translateDeclToCollapsedGraph decls
|
||||
translateModuleToCollapsedGraphs moduleSyntax
|
||||
= error $ "Unsupported syntax in translateModuleToCollapsedGraphs: "
|
||||
translateModuleToCollapsedGraphs ::
|
||||
Show l =>
|
||||
Exts.Module l ->
|
||||
[AnnotatedGraph FGR.Gr]
|
||||
translateModuleToCollapsedGraphs (Exts.Module _ _ _ _ decls) =
|
||||
fmap translateDeclToCollapsedGraph decls
|
||||
translateModuleToCollapsedGraphs moduleSyntax =
|
||||
error $
|
||||
"Unsupported syntax in translateModuleToCollapsedGraphs: "
|
||||
<> show moduleSyntax
|
||||
|
||||
-- END Exported functions
|
||||
|
@ -1,10 +1,11 @@
|
||||
module TranslateCore(
|
||||
Reference,
|
||||
SyntaxGraph(..),
|
||||
-- This file is formatted with Ormolu
|
||||
module TranslateCore
|
||||
( Reference,
|
||||
SyntaxGraph (..),
|
||||
EvalContext,
|
||||
GraphAndRef(..),
|
||||
SgSink(..),
|
||||
SgBind(..),
|
||||
GraphAndRef (..),
|
||||
SgSink (..),
|
||||
SgBind (..),
|
||||
syntaxGraphFromNodes,
|
||||
syntaxGraphFromNodesEdges,
|
||||
bindsToSyntaxGraph,
|
||||
@ -25,27 +26,49 @@ module TranslateCore(
|
||||
nListString,
|
||||
syntaxGraphToFglGraph,
|
||||
nodeToIcon,
|
||||
initialIdState
|
||||
) where
|
||||
initialIdState,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.State(State, state)
|
||||
import Data.Either(partitionEithers)
|
||||
import Control.Monad.State (State, state)
|
||||
import Data.Either (partitionEithers)
|
||||
import qualified Data.Graph.Inductive.Graph as ING
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
import Data.List(find)
|
||||
import Data.List (find)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Semigroup(Semigroup, (<>))
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Icons(inputPort, resultPort, argumentPorts, multiIfRhsPorts
|
||||
, multiIfBoolPorts)
|
||||
import Types(Labeled(..), Icon(..), SyntaxNode(..), Edge(..), EdgeOption(..)
|
||||
, NameAndPort(..), IDState, SgNamedNode, NodeName(..), Port
|
||||
, LikeApplyFlavor(..), CaseOrMultiIfTag(..), IDState(..)
|
||||
, Embedder(..), mkEmbedder, Named(..)
|
||||
, EmbedderSyntaxNode)
|
||||
import Util(nameAndPort, makeSimpleEdge, justName, maybeBoolToBool
|
||||
, nodeNameToInt)
|
||||
import Icons
|
||||
( argumentPorts,
|
||||
inputPort,
|
||||
multiIfBoolPorts,
|
||||
multiIfRhsPorts,
|
||||
resultPort,
|
||||
)
|
||||
import Types
|
||||
( CaseOrMultiIfTag (..),
|
||||
Edge (..),
|
||||
EdgeOption (..),
|
||||
Embedder (..),
|
||||
EmbedderSyntaxNode,
|
||||
IDState (..),
|
||||
Icon (..),
|
||||
Labeled (..),
|
||||
LikeApplyFlavor (..),
|
||||
NameAndPort (..),
|
||||
Named (..),
|
||||
NodeName (..),
|
||||
Port,
|
||||
SgNamedNode,
|
||||
SyntaxNode (..),
|
||||
mkEmbedder,
|
||||
)
|
||||
import Util
|
||||
( justName,
|
||||
makeSimpleEdge,
|
||||
maybeBoolToBool,
|
||||
nameAndPort,
|
||||
nodeNameToInt,
|
||||
)
|
||||
|
||||
{-# ANN module "HLint: ignore Use list comprehension" #-}
|
||||
|
||||
@ -63,23 +86,25 @@ data SgBind = SgBind String Reference deriving (Eq, Show, Ord)
|
||||
data SgSink = SgSink String NameAndPort deriving (Eq, Ord, Show)
|
||||
|
||||
-- TODO Replace lists with sets
|
||||
|
||||
-- | 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],
|
||||
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 :: Map.Map NodeName NodeName
|
||||
} deriving (Show, Eq)
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Semigroup SyntaxGraph where
|
||||
(<>)
|
||||
(SyntaxGraph icons1 edges1 sinks1 sources1 map1)
|
||||
(SyntaxGraph icons2 edges2 sinks2 sources2 map2)
|
||||
= SyntaxGraph
|
||||
(SyntaxGraph icons2 edges2 sinks2 sources2 map2) =
|
||||
SyntaxGraph
|
||||
(icons1 <> icons2)
|
||||
(edges1 <> edges2)
|
||||
(sinks1 <> sinks2)
|
||||
@ -104,8 +129,8 @@ syntaxGraphFromNodes :: [SgNamedNode] -> SyntaxGraph
|
||||
syntaxGraphFromNodes icons = SyntaxGraph icons mempty mempty mempty mempty
|
||||
|
||||
syntaxGraphFromNodesEdges :: [SgNamedNode] -> [Edge] -> SyntaxGraph
|
||||
syntaxGraphFromNodesEdges icons edges
|
||||
= SyntaxGraph icons edges mempty mempty mempty
|
||||
syntaxGraphFromNodesEdges icons edges =
|
||||
SyntaxGraph icons edges mempty mempty mempty
|
||||
|
||||
bindsToSyntaxGraph :: [SgBind] -> SyntaxGraph
|
||||
bindsToSyntaxGraph binds = SyntaxGraph mempty mempty mempty binds mempty
|
||||
@ -127,10 +152,13 @@ initialIdState :: IDState
|
||||
initialIdState = IDState 0
|
||||
|
||||
getId :: State IDState Int
|
||||
getId = state incrementer where
|
||||
incrementer (IDState x) = (x, IDState checkedIncrement) where
|
||||
getId = state incrementer
|
||||
where
|
||||
incrementer (IDState x) = (x, IDState checkedIncrement)
|
||||
where
|
||||
xPlusOne = x + 1
|
||||
checkedIncrement = if xPlusOne > x
|
||||
checkedIncrement =
|
||||
if xPlusOne > x
|
||||
then xPlusOne
|
||||
else error "getId: the ID state has overflowed."
|
||||
|
||||
@ -139,69 +167,74 @@ getUniqueName = fmap NodeName getId
|
||||
|
||||
-- TODO Should getUniqueString prepend an illegal character?
|
||||
getUniqueString :: String -> State IDState String
|
||||
getUniqueString base = fmap ((base ++). show) getId
|
||||
getUniqueString base = fmap ((base ++) . show) getId
|
||||
|
||||
-- END IDState
|
||||
|
||||
-- TODO: Refactor with combineExpressions
|
||||
edgesForRefPortList :: Bool -> [(Reference, NameAndPort)] -> SyntaxGraph
|
||||
edgesForRefPortList inPattern portExpPairs
|
||||
= mconcat $ fmap makeGraph portExpPairs
|
||||
edgesForRefPortList inPattern portExpPairs =
|
||||
mconcat $ fmap makeGraph portExpPairs
|
||||
where
|
||||
edgeOpts = if inPattern then [EdgeInPattern] else []
|
||||
makeGraph (ref, port) = case ref of
|
||||
Left str -> if inPattern
|
||||
Left str ->
|
||||
if inPattern
|
||||
then bindsToSyntaxGraph [SgBind str (Right port)]
|
||||
else sinksToSyntaxGraph [SgSink str port]
|
||||
Right resPort -> edgesToSyntaxGraph [Edge edgeOpts connection]
|
||||
where
|
||||
connection = if inPattern
|
||||
-- If in a pattern, then the port on the case icon is
|
||||
connection =
|
||||
if inPattern
|
||||
then -- If in a pattern, then the port on the case icon is
|
||||
-- the data source.
|
||||
then (port, resPort)
|
||||
(port, resPort)
|
||||
else (resPort, port)
|
||||
|
||||
combineExpressions :: Bool -> [(GraphAndRef, NameAndPort)] -> SyntaxGraph
|
||||
combineExpressions inPattern portExpPairs
|
||||
= mconcat $ fmap makeGraph portExpPairs
|
||||
combineExpressions inPattern portExpPairs =
|
||||
mconcat $ fmap makeGraph portExpPairs
|
||||
where
|
||||
edgeOpts = if inPattern then [EdgeInPattern] else []
|
||||
makeGraph (GraphAndRef graph ref, port) = graph <> case ref of
|
||||
Left str -> if inPattern
|
||||
makeGraph (GraphAndRef graph ref, port) =
|
||||
graph <> case ref of
|
||||
Left str ->
|
||||
if inPattern
|
||||
then bindsToSyntaxGraph [SgBind str (Right port)]
|
||||
else sinksToSyntaxGraph [SgSink str port]
|
||||
Right resPort -> edgesToSyntaxGraph [Edge edgeOpts (resPort, port)]
|
||||
|
||||
makeApplyGraph ::
|
||||
Int
|
||||
-> LikeApplyFlavor
|
||||
-> Bool
|
||||
-> NodeName
|
||||
-> GraphAndRef
|
||||
-> [GraphAndRef]
|
||||
-> (SyntaxGraph, NameAndPort)
|
||||
makeApplyGraph numArgs applyFlavor inPattern applyIconName funVal argVals
|
||||
= (newGraph <> combinedGraph
|
||||
, nameAndPort applyIconName (resultPort applyNode)
|
||||
Int ->
|
||||
LikeApplyFlavor ->
|
||||
Bool ->
|
||||
NodeName ->
|
||||
GraphAndRef ->
|
||||
[GraphAndRef] ->
|
||||
(SyntaxGraph, NameAndPort)
|
||||
makeApplyGraph numArgs applyFlavor inPattern applyIconName funVal argVals =
|
||||
( newGraph <> combinedGraph,
|
||||
nameAndPort applyIconName (resultPort applyNode)
|
||||
)
|
||||
where
|
||||
applyNode = ApplyNode applyFlavor numArgs
|
||||
argumentNamePorts
|
||||
= map (nameAndPort applyIconName) (argumentPorts applyNode)
|
||||
argumentNamePorts =
|
||||
map (nameAndPort applyIconName) (argumentPorts applyNode)
|
||||
functionPort = nameAndPort applyIconName (inputPort applyNode)
|
||||
combinedGraph = combineExpressions inPattern
|
||||
$ zip (funVal:argVals) (functionPort:argumentNamePorts)
|
||||
combinedGraph =
|
||||
combineExpressions inPattern $
|
||||
zip (funVal : argVals) (functionPort : argumentNamePorts)
|
||||
icons = [Named applyIconName (mkEmbedder applyNode)]
|
||||
newGraph = syntaxGraphFromNodes icons
|
||||
|
||||
makeMultiIfGraph ::
|
||||
Int
|
||||
-> NodeName
|
||||
-> [GraphAndRef]
|
||||
-> [GraphAndRef]
|
||||
-> (SyntaxGraph, NameAndPort)
|
||||
makeMultiIfGraph numPairs multiIfName bools exps
|
||||
= (newGraph, nameAndPort multiIfName (resultPort multiIfNode))
|
||||
Int ->
|
||||
NodeName ->
|
||||
[GraphAndRef] ->
|
||||
[GraphAndRef] ->
|
||||
(SyntaxGraph, NameAndPort)
|
||||
makeMultiIfGraph numPairs multiIfName bools exps =
|
||||
(newGraph, nameAndPort multiIfName (resultPort multiIfNode))
|
||||
where
|
||||
multiIfNode = CaseOrMultiIfNode MultiIfTag numPairs
|
||||
expsWithPorts = zip exps $ map (nameAndPort multiIfName) multiIfRhsPorts
|
||||
@ -226,9 +259,10 @@ namesInPattern (graphAndRef, mName) = case mName of
|
||||
-- TODO: Might want to present some indication if there is a reference cycle.
|
||||
lookupReference :: [SgBind] -> Reference -> Reference
|
||||
lookupReference _ ref@(Right _) = ref
|
||||
lookupReference bindings ref@(Left originalS) = lookupHelper ref where
|
||||
lookupReference bindings ref@(Left originalS) = lookupHelper ref
|
||||
where
|
||||
lookupHelper newRef@(Right _) = newRef
|
||||
lookupHelper newRef@(Left s)= case lookup s (fmap sgBindToTuple bindings) of
|
||||
lookupHelper newRef@(Left s) = case lookup s (fmap sgBindToTuple bindings) of
|
||||
Just r -> failIfCycle r $ lookupHelper r
|
||||
Nothing -> newRef
|
||||
where
|
||||
@ -242,23 +276,24 @@ makeEdgesCore :: [SgSink] -> [SgBind] -> ([SgSink], [Edge])
|
||||
makeEdgesCore sinks bindings = partitionEithers $ fmap renameOrMakeEdge sinks
|
||||
where
|
||||
renameOrMakeEdge :: SgSink -> Either SgSink Edge
|
||||
renameOrMakeEdge orig@(SgSink s destPort)
|
||||
= case lookup s (fmap sgBindToTuple bindings) of
|
||||
renameOrMakeEdge orig@(SgSink s destPort) =
|
||||
case lookup s (fmap sgBindToTuple bindings) of
|
||||
Just ref -> case lookupReference bindings ref of
|
||||
Right sourcePort -> Right $ makeSimpleEdge (sourcePort, destPort)
|
||||
Left newStr -> Left $ SgSink newStr destPort
|
||||
Nothing -> Left orig
|
||||
|
||||
makeEdges :: SyntaxGraph -> SyntaxGraph
|
||||
makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph where
|
||||
makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph
|
||||
where
|
||||
(newSinks, newEdges) = makeEdgesCore sinks bindings
|
||||
newGraph = SyntaxGraph icons (newEdges <> edges) newSinks bindings eMap
|
||||
|
||||
makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
|
||||
makeBox str = do
|
||||
name <- getUniqueName
|
||||
let graph
|
||||
= syntaxGraphFromNodes [Named name (mkEmbedder (LiteralNode str))]
|
||||
let graph =
|
||||
syntaxGraphFromNodes [Named name (mkEmbedder (LiteralNode str))]
|
||||
pure (graph, justName name)
|
||||
|
||||
nTupleString :: Int -> String
|
||||
@ -266,16 +301,17 @@ nTupleString n = '(' : replicate (n -1) ',' ++ ")"
|
||||
|
||||
-- TODO Unit tests for this
|
||||
nTupleSectionString :: [Bool] -> String
|
||||
nTupleSectionString bools = '(' : (commas ++ ")") where
|
||||
nTupleSectionString bools = '(' : (commas ++ ")")
|
||||
where
|
||||
commas = case concatMap trueToUnderscore bools of
|
||||
[] -> []
|
||||
(_:xs) -> xs
|
||||
(_ : xs) -> xs
|
||||
|
||||
trueToUnderscore x = if x
|
||||
trueToUnderscore x =
|
||||
if x
|
||||
then ",_"
|
||||
else ","
|
||||
|
||||
|
||||
nListString :: Int -> String
|
||||
-- TODO: Use something better than [_]
|
||||
nListString 1 = "[_]"
|
||||
@ -283,24 +319,26 @@ nListString n = '[' : replicate (n -1) ',' ++ "]"
|
||||
|
||||
nodeToIcon :: EmbedderSyntaxNode -> Icon
|
||||
nodeToIcon (Embedder embeddedNodes node) = case node of
|
||||
(ApplyNode flavor x)
|
||||
-> nestedApplySyntaxNodeToIcon flavor x embeddedNodes
|
||||
(PatternApplyNode s children)
|
||||
-> nestedPatternNodeToIcon s children
|
||||
(ApplyNode flavor x) ->
|
||||
nestedApplySyntaxNodeToIcon flavor x embeddedNodes
|
||||
(PatternApplyNode s children) ->
|
||||
nestedPatternNodeToIcon s children
|
||||
(NameNode s) -> TextBoxIcon s
|
||||
(BindNameNode s) -> BindTextBoxIcon s
|
||||
(LiteralNode s) -> TextBoxIcon s
|
||||
(FunctionDefNode labels bodyNodes)
|
||||
-> nestedLambdaToIcon labels embeddedNodes bodyNodes
|
||||
(FunctionDefNode labels bodyNodes) ->
|
||||
nestedLambdaToIcon labels embeddedNodes bodyNodes
|
||||
CaseResultNode -> CaseResultIcon
|
||||
(CaseOrMultiIfNode tag x)
|
||||
-> nestedCaseOrMultiIfNodeToIcon tag x embeddedNodes
|
||||
(CaseOrMultiIfNode tag x) ->
|
||||
nestedCaseOrMultiIfNodeToIcon tag x embeddedNodes
|
||||
|
||||
-- | Helper for makeArg
|
||||
findArg :: Port -> (NodeName, Edge) -> Bool
|
||||
findArg currentPort
|
||||
(argName
|
||||
, Edge _ (NameAndPort fromName fromPort, NameAndPort toName toPort))
|
||||
findArg
|
||||
currentPort
|
||||
( 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
|
||||
@ -308,10 +346,11 @@ findArg currentPort
|
||||
makeArg :: Set.Set (NodeName, Edge) -> Port -> Maybe NodeName
|
||||
makeArg args port = fst <$> find (findArg port) args
|
||||
|
||||
nestedApplySyntaxNodeToIcon :: LikeApplyFlavor
|
||||
-> Int
|
||||
-> Set.Set (NodeName, Edge)
|
||||
-> Icon
|
||||
nestedApplySyntaxNodeToIcon ::
|
||||
LikeApplyFlavor ->
|
||||
Int ->
|
||||
Set.Set (NodeName, Edge) ->
|
||||
Icon
|
||||
nestedApplySyntaxNodeToIcon flavor numArgs args =
|
||||
NestedApply flavor headIcon argList
|
||||
where
|
||||
@ -320,10 +359,11 @@ nestedApplySyntaxNodeToIcon flavor numArgs args =
|
||||
headIcon = makeArg args (inputPort dummyNode)
|
||||
argList = fmap (makeArg args) argPorts
|
||||
|
||||
nestedLambdaToIcon :: [String] -- labels
|
||||
-> Set.Set (NodeName, Edge) -- embedded icons
|
||||
-> Set.Set NodeName -- body nodes
|
||||
-> Icon
|
||||
nestedLambdaToIcon ::
|
||||
[String] -> -- labels
|
||||
Set.Set (NodeName, Edge) -> -- embedded icons
|
||||
Set.Set NodeName -> -- body nodes
|
||||
Icon
|
||||
nestedLambdaToIcon labels embeddedNodes =
|
||||
LambdaIcon labels embeddedBodyNode
|
||||
where
|
||||
@ -331,10 +371,10 @@ nestedLambdaToIcon labels embeddedNodes =
|
||||
embeddedBodyNode = makeArg embeddedNodes (inputPort dummyNode)
|
||||
|
||||
nestedCaseOrMultiIfNodeToIcon ::
|
||||
CaseOrMultiIfTag
|
||||
-> Int
|
||||
-> Set.Set (NodeName, Edge)
|
||||
-> Icon
|
||||
CaseOrMultiIfTag ->
|
||||
Int ->
|
||||
Set.Set (NodeName, Edge) ->
|
||||
Icon
|
||||
nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
|
||||
CaseTag -> NestedCaseIcon argList
|
||||
MultiIfTag -> NestedMultiIfIcon argList
|
||||
@ -344,29 +384,38 @@ nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
|
||||
argList = fmap (makeArg args) (inputPort dummyNode : argPorts)
|
||||
|
||||
nestedPatternNodeToIcon :: String -> [Labeled (Maybe SgNamedNode)] -> Icon
|
||||
nestedPatternNodeToIcon str children = NestedPApp
|
||||
nestedPatternNodeToIcon str children =
|
||||
NestedPApp
|
||||
(pure (Just (Named (NodeName (-1)) (TextBoxIcon str))))
|
||||
-- Why so many fmaps?
|
||||
( (fmap . fmap . fmap . fmap) nodeToIcon children)
|
||||
((fmap . fmap . fmap . fmap) nodeToIcon children)
|
||||
|
||||
makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
|
||||
makeLNode namedNode@(Named (NodeName name) _) = (name, namedNode)
|
||||
|
||||
lookupInEmbeddingMap :: NodeName -> Map.Map NodeName NodeName -> NodeName
|
||||
lookupInEmbeddingMap origName eMap = lookupHelper origName where
|
||||
lookupInEmbeddingMap origName eMap = lookupHelper origName
|
||||
where
|
||||
lookupHelper name = case Map.lookup name eMap of
|
||||
Nothing -> name
|
||||
Just parent -> if parent == origName
|
||||
then error $ "lookupInEmbeddingMap: Found cycle. Node = "
|
||||
++ show origName ++ "\nEmbedding Map = " ++ show eMap
|
||||
Just parent ->
|
||||
if parent == origName
|
||||
then
|
||||
error $
|
||||
"lookupInEmbeddingMap: Found cycle. Node = "
|
||||
++ show origName
|
||||
++ "\nEmbedding Map = "
|
||||
++ show eMap
|
||||
else lookupHelper parent
|
||||
|
||||
syntaxGraphToFglGraph :: SyntaxGraph -> FGR.Gr SgNamedNode Edge
|
||||
syntaxGraphToFglGraph (SyntaxGraph nodes edges _ _ eMap) =
|
||||
ING.mkGraph (fmap makeLNode nodes) labeledEdges where
|
||||
ING.mkGraph (fmap makeLNode nodes) labeledEdges
|
||||
where
|
||||
labeledEdges = fmap makeLabeledEdge edges
|
||||
|
||||
makeLabeledEdge e@(Edge _ (NameAndPort name1 _, NameAndPort name2 _)) =
|
||||
(nodeNameToInt $ lookupInEmbeddingMap name1 eMap
|
||||
, nodeNameToInt $ lookupInEmbeddingMap name2 eMap
|
||||
, e)
|
||||
( nodeNameToInt $ lookupInEmbeddingMap name1 eMap,
|
||||
nodeNameToInt $ lookupInEmbeddingMap name2 eMap,
|
||||
e
|
||||
)
|
||||
|
94
app/Types.hs
94
app/Types.hs
@ -1,47 +1,50 @@
|
||||
{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, ConstraintKinds #-}
|
||||
-- This file is formatted with Ormolu
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoMonomorphismRestriction #-}
|
||||
|
||||
module Types (
|
||||
Named(..),
|
||||
module Types
|
||||
( Named (..),
|
||||
NamedIcon,
|
||||
IconInfo,
|
||||
Icon(..),
|
||||
SyntaxNode(..),
|
||||
NodeName(..),
|
||||
Port(..),
|
||||
NameAndPort(..),
|
||||
Icon (..),
|
||||
SyntaxNode (..),
|
||||
NodeName (..),
|
||||
Port (..),
|
||||
NameAndPort (..),
|
||||
Connection,
|
||||
Edge(..),
|
||||
EdgeOption(..),
|
||||
Drawing(..),
|
||||
IDState(..),
|
||||
Edge (..),
|
||||
EdgeOption (..),
|
||||
Drawing (..),
|
||||
IDState (..),
|
||||
SpecialQDiagram,
|
||||
SpecialBackend,
|
||||
SpecialNum,
|
||||
SgNamedNode,
|
||||
IngSyntaxGraph,
|
||||
LikeApplyFlavor(..),
|
||||
CaseOrMultiIfTag(..),
|
||||
Labeled(..),
|
||||
EmbedDirection(..),
|
||||
EmbedInfo(..),
|
||||
LikeApplyFlavor (..),
|
||||
CaseOrMultiIfTag (..),
|
||||
Labeled (..),
|
||||
EmbedDirection (..),
|
||||
EmbedInfo (..),
|
||||
AnnotatedGraph,
|
||||
NodeInfo(..),
|
||||
Embedder(..),
|
||||
NodeInfo (..),
|
||||
Embedder (..),
|
||||
mkEmbedder,
|
||||
EmbedderSyntaxNode,
|
||||
) where
|
||||
)
|
||||
where
|
||||
|
||||
import Diagrams.Prelude(QDiagram, V2, Any, Renderable, Path, IsName)
|
||||
import Diagrams.TwoD.Text(Text)
|
||||
|
||||
import Control.Applicative(Applicative(..))
|
||||
import qualified Data.Graph.Inductive as ING
|
||||
import qualified Data.IntMap as IM
|
||||
import Data.Set(Set, empty)
|
||||
import Data.Typeable(Typeable)
|
||||
import Data.Set (Set, empty)
|
||||
import Data.Typeable (Typeable)
|
||||
import Diagrams.Prelude (Any, IsName, Path, QDiagram, Renderable, V2)
|
||||
import Diagrams.TwoD.Text (Text)
|
||||
|
||||
newtype NodeName = NodeName Int deriving (Typeable, Eq, Ord, Show)
|
||||
|
||||
instance IsName NodeName
|
||||
|
||||
data Named a = Named {naName :: NodeName, naVal :: a}
|
||||
@ -63,7 +66,8 @@ type IconInfo = IM.IntMap Icon
|
||||
|
||||
-- | A datatype that represents an icon.
|
||||
-- The TextBoxIcon's data is the text that appears in the text box.
|
||||
data Icon = TextBoxIcon String
|
||||
data Icon
|
||||
= TextBoxIcon String
|
||||
| MultiIfIcon
|
||||
Int -- Number of alternatives
|
||||
| LambdaIcon
|
||||
@ -90,9 +94,10 @@ data LikeApplyFlavor = ApplyNodeFlavor | ComposeNodeFlavor
|
||||
data CaseOrMultiIfTag = CaseTag | MultiIfTag deriving (Show, Eq, Ord)
|
||||
|
||||
-- TODO The full edge does not need to be included, just the port.
|
||||
data Embedder a = Embedder {
|
||||
emEmbedded :: Set (NodeName, Edge) -- ^ Set of embedded nodes
|
||||
, emNode :: a
|
||||
data Embedder a = Embedder
|
||||
{ -- | Set of embedded nodes
|
||||
emEmbedded :: Set (NodeName, Edge),
|
||||
emNode :: a
|
||||
}
|
||||
deriving (Show, Eq, Ord, Functor)
|
||||
|
||||
@ -104,8 +109,8 @@ type EmbedderSyntaxNode = Embedder SyntaxNode
|
||||
type SgNamedNode = Named EmbedderSyntaxNode
|
||||
|
||||
-- TODO remove Ints from SyntaxNode data constructors.
|
||||
data SyntaxNode =
|
||||
-- Function application, composition, and applying to a composition
|
||||
data SyntaxNode
|
||||
= -- Function application, composition, and applying to a composition
|
||||
-- The list of nodes is unordered (replace with a map?)
|
||||
ApplyNode LikeApplyFlavor Int
|
||||
| PatternApplyNode String [Labeled (Maybe SgNamedNode)]
|
||||
@ -120,6 +125,7 @@ data SyntaxNode =
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
newtype Port = Port Int deriving (Typeable, Eq, Ord, Show)
|
||||
|
||||
instance IsName Port
|
||||
|
||||
data NameAndPort = NameAndPort NodeName (Maybe Port) deriving (Show, Eq, Ord)
|
||||
@ -131,8 +137,10 @@ data EdgeOption = EdgeInPattern 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]
|
||||
, edgeConnection :: Connection}
|
||||
data Edge = Edge
|
||||
{ edgeOptions :: [EdgeOption],
|
||||
edgeConnection :: Connection
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- | A drawing is a map from names to Icons, a list of edges,
|
||||
@ -143,19 +151,19 @@ data Drawing = Drawing [NamedIcon] [Edge] deriving (Show, Eq)
|
||||
-- unique id.
|
||||
newtype IDState = IDState Int deriving (Eq, Show)
|
||||
|
||||
type SpecialNum n
|
||||
= (Floating n, RealFrac n, RealFloat n, Typeable n, Show n, Enum n)
|
||||
type SpecialNum n =
|
||||
(Floating n, RealFrac n, RealFloat n, Typeable n, Show n, Enum n)
|
||||
|
||||
-- Note that SpecialBackend is a constraint synonym, not a type synonym.
|
||||
type SpecialBackend b n
|
||||
= (SpecialNum n, Renderable (Path V2 n) b, Renderable (Text n) b)
|
||||
type SpecialBackend b n =
|
||||
(SpecialNum n, Renderable (Path V2 n) b, Renderable (Text n) b)
|
||||
|
||||
type SpecialQDiagram b n = QDiagram b V2 n Any
|
||||
|
||||
type IngSyntaxGraph gr = gr SgNamedNode Edge
|
||||
|
||||
data EmbedDirection =
|
||||
EdEmbedFrom -- The tail
|
||||
data EmbedDirection
|
||||
= EdEmbedFrom -- The tail
|
||||
| EdEmbedTo -- The head
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -165,8 +173,8 @@ data EmbedInfo a = EmbedInfo {eiEmbedDir :: Maybe EmbedDirection, eiVal :: a}
|
||||
|
||||
type AnnotatedGraph gr = gr (NodeInfo SgNamedNode) (EmbedInfo Edge)
|
||||
|
||||
data NodeInfo a = NodeInfo {
|
||||
niParent :: Maybe ING.Node
|
||||
, niVal :: a
|
||||
data NodeInfo a = NodeInfo
|
||||
{ niParent :: Maybe ING.Node,
|
||||
niVal :: a
|
||||
}
|
||||
deriving (Show, Eq, Functor, Ord)
|
||||
|
@ -1,7 +1,7 @@
|
||||
# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
|
||||
|
||||
# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
|
||||
resolver: lts-16.18
|
||||
resolver: lts-16.27
|
||||
|
||||
# Local packages, usually specified by relative directory name
|
||||
packages:
|
||||
|
Loading…
Reference in New Issue
Block a user