mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 10:50:24 +03:00
Move functions out of Types.hs.
This commit is contained in:
parent
959be858a7
commit
e0554fb819
@ -12,9 +12,9 @@ import Data.List(foldl', find)
|
||||
import Data.Maybe(catMaybes, isJust, fromMaybe)
|
||||
--import qualified Debug.Trace
|
||||
|
||||
import Types(SyntaxNode(..), sgNamedNodeToSyntaxNode, IngSyntaxGraph, Edge(..),
|
||||
import Types(SyntaxNode(..), IngSyntaxGraph, Edge(..),
|
||||
CaseOrGuardTag(..), Port(..), NameAndPort(..), SgNamedNode(..))
|
||||
import Util(maybeBoolToBool)
|
||||
import Util(maybeBoolToBool, sgNamedNodeToSyntaxNode)
|
||||
--import Util(printSelf)
|
||||
|
||||
-- See graph_algs.txt for pseudocode
|
||||
|
@ -25,9 +25,10 @@ import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..), S
|
||||
edgesForRefPortList, makeApplyGraph,
|
||||
namesInPattern, lookupReference, deleteBindings, makeEdges,
|
||||
makeBox, nTupleString, nListString,
|
||||
syntaxGraphToFglGraph, getUniqueString, bindsToSyntaxGraph, graphAndRefToGraph)
|
||||
syntaxGraphToFglGraph, getUniqueString, bindsToSyntaxGraph, graphAndRefToGraph,
|
||||
initialIdState)
|
||||
import Types(NameAndPort(..), IDState,
|
||||
initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode(..),
|
||||
Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode(..),
|
||||
LikeApplyFlavor(..))
|
||||
import Util(makeSimpleEdge, nameAndPort, justName)
|
||||
|
||||
|
@ -24,11 +24,12 @@ module TranslateCore(
|
||||
nTupleString,
|
||||
nListString,
|
||||
syntaxGraphToFglGraph,
|
||||
nodeToIcon
|
||||
nodeToIcon,
|
||||
initialIdState
|
||||
) where
|
||||
|
||||
import Control.Arrow(second)
|
||||
import Control.Monad.State(State)
|
||||
import Control.Monad.State(State, state)
|
||||
import Data.Either(partitionEithers)
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
import qualified Data.Graph.Inductive.Graph as ING
|
||||
@ -36,9 +37,9 @@ import Data.List(find)
|
||||
import Data.Semigroup(Semigroup, (<>))
|
||||
|
||||
import Types(Icon, SyntaxNode(..), Edge(..), EdgeOption(..),
|
||||
NameAndPort(..), IDState, getId, SgNamedNode(..), NodeName(..), Port(..), nodeNameToInt,
|
||||
LikeApplyFlavor(..), CaseOrGuardTag(..))
|
||||
import Util(noEnds, nameAndPort, makeSimpleEdge, justName, maybeBoolToBool, mapNodeInNamedNode)
|
||||
NameAndPort(..), IDState, SgNamedNode(..), NodeName(..), Port(..),
|
||||
LikeApplyFlavor(..), CaseOrGuardTag(..), IDState(..))
|
||||
import Util(noEnds, nameAndPort, makeSimpleEdge, justName, maybeBoolToBool, mapNodeInNamedNode, nodeNameToInt)
|
||||
import Icons(Icon(..))
|
||||
|
||||
-- OVERVIEW --
|
||||
@ -104,12 +105,29 @@ graphAndRefToGraph (GraphAndRef g _) = g
|
||||
|
||||
-- END Constructors and Destructors
|
||||
|
||||
-- BEGIN IDState
|
||||
|
||||
initialIdState :: IDState
|
||||
initialIdState = IDState 0
|
||||
|
||||
getId :: State IDState Int
|
||||
getId = state incrementer where
|
||||
incrementer (IDState x) = (x, IDState checkedIncrement) where
|
||||
xPlusOne = x + 1
|
||||
checkedIncrement = if xPlusOne > x
|
||||
then xPlusOne
|
||||
else error "getId: the ID state has overflowed."
|
||||
|
||||
|
||||
|
||||
getUniqueName :: State IDState NodeName
|
||||
getUniqueName = fmap NodeName getId
|
||||
|
||||
getUniqueString :: String -> State IDState String
|
||||
getUniqueString base = fmap ((base ++). show) getId
|
||||
|
||||
-- END IDState
|
||||
|
||||
-- TODO: Refactor with combineExpressions
|
||||
edgesForRefPortList :: Bool -> [(Reference, NameAndPort)] -> SyntaxGraph
|
||||
edgesForRefPortList inPattern portExpPairs = mconcat $ fmap makeGraph portExpPairs where
|
||||
|
25
app/Types.hs
25
app/Types.hs
@ -11,18 +11,14 @@ module Types (
|
||||
EdgeOption(..),
|
||||
EdgeEnd(..),
|
||||
Drawing(..),
|
||||
IDState,
|
||||
IDState(..),
|
||||
SpecialQDiagram,
|
||||
SpecialBackend,
|
||||
SpecialNum,
|
||||
SgNamedNode(..),
|
||||
IngSyntaxGraph,
|
||||
LikeApplyFlavor(..),
|
||||
CaseOrGuardTag(..),
|
||||
initialIdState,
|
||||
getId,
|
||||
sgNamedNodeToSyntaxNode,
|
||||
nodeNameToInt
|
||||
CaseOrGuardTag(..)
|
||||
) where
|
||||
|
||||
import Diagrams.Prelude(QDiagram, V2, Any, Renderable, Path, IsName)
|
||||
@ -104,20 +100,3 @@ type SpecialBackend b n = (SpecialNum n, Renderable (Path V2 n) b, Renderable (T
|
||||
type SpecialQDiagram b n = QDiagram b V2 n Any
|
||||
|
||||
type IngSyntaxGraph gr = gr SgNamedNode Edge
|
||||
|
||||
sgNamedNodeToSyntaxNode :: SgNamedNode -> SyntaxNode
|
||||
sgNamedNodeToSyntaxNode (SgNamedNode _ n) = n
|
||||
|
||||
initialIdState :: IDState
|
||||
initialIdState = IDState 0
|
||||
|
||||
getId :: State IDState Int
|
||||
getId = state incrementer where
|
||||
incrementer (IDState x) = (x, IDState checkedIncrement) where
|
||||
xPlusOne = x + 1
|
||||
checkedIncrement = if xPlusOne > x
|
||||
then xPlusOne
|
||||
else error "getId: the ID state has overflowed."
|
||||
|
||||
nodeNameToInt :: NodeName -> Int
|
||||
nodeNameToInt (NodeName x) = x
|
||||
|
16
app/Util.hs
16
app/Util.hs
@ -16,7 +16,9 @@ module Util (
|
||||
printSelf,
|
||||
eitherToMaybes,
|
||||
maybeBoolToBool,
|
||||
mapNodeInNamedNode
|
||||
mapNodeInNamedNode,
|
||||
sgNamedNodeToSyntaxNode,
|
||||
nodeNameToInt
|
||||
)where
|
||||
|
||||
import Control.Arrow(first)
|
||||
@ -24,7 +26,7 @@ import Control.Arrow(first)
|
||||
import Data.Maybe(fromMaybe)
|
||||
import qualified Debug.Trace
|
||||
|
||||
import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName, Port,
|
||||
import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName(..), Port,
|
||||
SyntaxNode, SgNamedNode(..))
|
||||
|
||||
mapFst :: Functor f => (a -> b) -> f (a, c) -> f (b, c)
|
||||
@ -42,7 +44,7 @@ nameAndPort n p = NameAndPort n (Just p)
|
||||
justName :: NodeName -> NameAndPort
|
||||
justName n = NameAndPort n Nothing
|
||||
|
||||
-- Edge constructors --
|
||||
-- BEGIN Edge constructors --
|
||||
portToPort :: NodeName -> Port -> NodeName -> Port -> Edge
|
||||
portToPort a b c d = makeSimpleEdge (nameAndPort a b, nameAndPort c d)
|
||||
|
||||
@ -64,6 +66,8 @@ iconToIconEnds a b c d = Edge [] (b, d) (justName a, justName c)
|
||||
iconTailToPort :: NodeName -> EdgeEnd -> NodeName -> Port -> Edge
|
||||
iconTailToPort a endTail c d = Edge [] (endTail, EndNone) (justName a, nameAndPort c d)
|
||||
|
||||
-- END Edge constructors --
|
||||
|
||||
fromMaybeError :: String -> Maybe a -> a
|
||||
fromMaybeError s = fromMaybe (error s)
|
||||
|
||||
@ -80,3 +84,9 @@ maybeBoolToBool = or
|
||||
|
||||
mapNodeInNamedNode :: (SyntaxNode -> a) -> SgNamedNode -> (NodeName, a)
|
||||
mapNodeInNamedNode f (SgNamedNode name node) = (name, f node)
|
||||
|
||||
sgNamedNodeToSyntaxNode :: SgNamedNode -> SyntaxNode
|
||||
sgNamedNodeToSyntaxNode (SgNamedNode _ n) = n
|
||||
|
||||
nodeNameToInt :: NodeName -> Int
|
||||
nodeNameToInt (NodeName x) = x
|
||||
|
Loading…
Reference in New Issue
Block a user