rgleichman/glance
1
1
Fork 0
mirror of https://github.com/rgleichman/glance.git synced 2024-11-27 03:02:44 +03:00
Code Issues Projects Releases Wiki Activity

Simplify syntaxGraphToFglGraph.

Browse Source
This commit is contained in:
Robbie Gleichman 2016-12-06 17:22:36 -08:00
parent 5e1d724418
commit dca1434c68
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
app/TranslateCore.hs
View File

@ -28,13 +28,13 @@ module TranslateCore(
import Control.Monad.State(State) import Control.Monad.State(State)
import Data.Either(partitionEithers) import Data.Either(partitionEithers)
import qualified Data.Graph.Inductive.PatriciaTree as FGR import qualified Data.Graph.Inductive.PatriciaTree as FGR
import qualified Data.Graph.Inductive.Graph as ING
import Data.List(find) import Data.List(find)
import Data.Semigroup(Semigroup, (<>)) import Data.Semigroup(Semigroup, (<>))
import Diagrams.TwoD.GraphViz as DiaGV
import Types(Icon, SyntaxNode(..), Edge(..), EdgeOption(..), import Types(Icon, SyntaxNode(..), Edge(..), EdgeOption(..),
NameAndPort(..), IDState, getId, SgNamedNode, NodeName(..), Port(..)) NameAndPort(..), IDState, getId, SgNamedNode, NodeName(..), Port(..))
import Util(noEnds, nameAndPort, makeSimpleEdge, justName, fromMaybeError, maybeBoolToBool) import Util(noEnds, nameAndPort, makeSimpleEdge, justName, maybeBoolToBool)
import Icons(Icon(..)) import Icons(Icon(..))
-- OVERVIEW -- -- OVERVIEW --
@ -211,13 +211,13 @@ findArg currentPort ((argName, _), Edge _ _ (NameAndPort fromName fromPort, Name
| argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort | argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort
| otherwise = False -- This case should never happen | otherwise = False -- This case should never happen
makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
makeLNode namedNode@(NodeName name, _) = (name, namedNode)
syntaxGraphToFglGraph :: SyntaxGraph -> FGR.Gr SgNamedNode Edge syntaxGraphToFglGraph :: SyntaxGraph -> FGR.Gr SgNamedNode Edge
syntaxGraphToFglGraph (SyntaxGraph nodes edges _ _) = syntaxGraphToFglGraph (SyntaxGraph nodes edges _ _) =
DiaGV.mkGraph nodes labeledEdges where ING.mkGraph (fmap makeLNode nodes) labeledEdges where
labeledEdges = fmap makeLabeledEdge edges labeledEdges = fmap makeLabeledEdge edges
makeLabeledEdge e@(Edge _ _ (NameAndPort name1 _, NameAndPort name2 _)) =
((name1, lookupInNodes name1), (name2, lookupInNodes name2), e) where makeLabeledEdge e@(Edge _ _ (NameAndPort (NodeName name1) _, NameAndPort (NodeName name2) _)) =
lookupInNodes name = fromMaybeError errorString (lookup name nodes) where (name1, name2, e)
errorString =
"syntaxGraphToFglGraph edge connects to non-existent node. Node Name ="
++ show name ++ " Edge=" ++ show e