GNode and GEdge types now have their own files... again...

6 files changed, 146 insertions, 87 deletions

diff --git a/src/Grasp/GEdge.hs b/src/Grasp/GEdge.hs
new file mode 100644
index 0000000..fcd826a
--- /dev/null
+++ b/src/Grasp/GEdge.hs
@@ -0,0 +1,58 @@
+module Grasp.GEdge (
+	GEdge,
+	EdgeLabel,
+
+	mkGEdge,
+	mkLabel,
+
+	toSrc,
+	toDest,
+	toLabel,
+	toLEdge
+	) where
+
+
+
+
+import Grasp.Graph( Node, LEdge )
+
+
+
+
+newtype EdgeLabel = EdgeLabel String
+    deriving (Show, Eq)
+
+newtype GEdge = GEdge (LEdge EdgeLabel)
+    deriving (Show, Eq)
+
+
+
+
+mkGEdge :: LEdge EdgeLabel -> GEdge
+mkGEdge = GEdge
+
+
+
+mkLabel :: String -> EdgeLabel
+mkLabel = EdgeLabel
+
+
+
+toSrc :: GEdge -> String
+toSrc (GEdge (x,_,_)) = x
+
+
+
+toDest :: GEdge -> String
+toDest (GEdge (_,y,_)) = y
+
+
+
+toLabel :: GEdge -> EdgeLabel
+toLabel (GEdge (_,_,z)) = z
+
+
+
+toLEdge :: GEdge -> LEdge EdgeLabel
+toLEdge (GEdge e) = e
+
diff --git a/src/Grasp/GNode.hs b/src/Grasp/GNode.hs
new file mode 100644
index 0000000..3c8161e
--- /dev/null
+++ b/src/Grasp/GNode.hs
@@ -0,0 +1,60 @@
+module Grasp.GNode (
+	GNode,
+	Instruction,
+
+    mkGNode,
+    mkInst,
+
+	toNode,
+	toInst,
+	toLNode,
+
+	instToFloat
+	) where
+
+
+
+
+import Grasp.Graph( Node, LNode )
+import Text.Read( readMaybe )
+
+
+
+
+newtype Instruction = Instruction String
+    deriving (Show, Eq)
+
+newtype GNode = GNode (LNode Instruction)
+    deriving (Show, Eq)
+
+
+
+
+mkGNode :: LNode Instruction -> GNode
+mkGNode = GNode
+
+
+
+mkInst :: String -> Instruction
+mkInst = Instruction
+
+
+
+toNode :: GNode -> Node
+toNode (GNode n) = fst n
+
+
+
+toInst :: GNode -> Instruction
+toInst (GNode n) = snd n
+
+
+
+toLNode :: GNode -> LNode Instruction
+toLNode (GNode n) = n
+
+
+
+instToFloat :: Instruction -> Maybe Float
+instToFloat (Instruction i) = readMaybe i
+
diff --git a/src/Grasp/IP.hs b/src/Grasp/IP.hs
index 294c92d..4f042a1 100644
--- a/src/Grasp/IP.hs
+++ b/src/Grasp/IP.hs
@@ -13,7 +13,7 @@ module Grasp.IP (
 
 
 
-import Grasp.Types( GNode )
+import Grasp.GNode( GNode )
 
 
 
diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index ea6cfee..9b0d65a 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -30,8 +30,6 @@ import qualified Control.Monad as Monad
 
 import Control.Monad.IO.Class( liftIO )
 
-import Text.Read( readMaybe )
-
 import qualified Data.Maybe as Maybe
 
 import qualified Data.List as List
@@ -45,8 +43,11 @@ import qualified Grasp.Graph as Graph
 import Grasp.IP( IP )
 import qualified Grasp.IP as IP
 
-import Grasp.Types( Instruction(..), EdgeLabel(..), GNode(..), GEdge(..) )
-import qualified Grasp.Types as Types
+import Grasp.GNode( GNode, Instruction )
+import qualified Grasp.GNode as GN
+
+import Grasp.GEdge( GEdge, EdgeLabel )
+import qualified Grasp.GEdge as GE
 
 
 
@@ -71,7 +72,7 @@ construct (n,e) = do
     Monad.when (numericName n e) (error "node with a numeric name")
     Monad.when (noMain n e) (error "could not find grasp:main")
 
-    let graph = Graph.mkGraph (map toLNode n) (map toLEdge e)
+    let graph = Graph.mkGraph (map GN.toLNode n) (map GE.toLEdge e)
         ips = map IP.singleton (nodesWithName n e "grasp:main")
         handles = Map.empty
 
@@ -85,29 +86,19 @@ finalise s = do
     (mapM_ IO.hClose) . Map.elems . fileHandles $ p
     let gr = programGraph p
         (nodes, edges) = (Graph.labNodes gr, Graph.labEdges gr)
-    return (map GNode nodes, map GEdge edges)
-
-
-
-toLNode :: GNode -> LNode Instruction
-toLNode n = (Types.gnode n, Types.gninst n)
-
-
-
-toLEdge :: GEdge -> LEdge EdgeLabel
-toLEdge e = (Types.gefrom e, Types.geto e, Types.gelabel e)
+    return (map GN.mkGNode nodes, map GE.mkGEdge edges)
 
 
 
 multiNodes :: [GNode] -> Bool
-multiNodes ns = (ns == (List.nubBy (\x y -> Types.gnode x == Types.gnode y) ns))
+multiNodes ns = (ns == (List.nubBy (\x y -> GN.toNode x == GN.toNode y) ns))
 
 
 
 unconnected :: [GNode] -> [GEdge] -> Bool
 unconnected ns es =
-    let nodeList = map Types.gnode ns
-        unconnectedEdges = filter (\x -> Types.gefrom x `notElem` nodeList || Types.geto x `notElem` nodeList) es
+    let nodeList = map GN.toNode ns
+        unconnectedEdges = filter (\x -> GE.toSrc x `notElem` nodeList || GE.toDest x `notElem` nodeList) es
     in unconnectedEdges /= []
 
 
@@ -122,15 +113,14 @@ multiNames ns es =
 numericName :: [GNode] -> [GEdge] -> Bool
 numericName ns es =
     let names = map snd (nameNodeList ns es)
-        test (Instruction x) = readMaybe x :: Maybe Float
-    in any (\x -> Maybe.isJust (test (Types.gninst x))) names
+    in any (\x -> Maybe.isJust (GN.instToFloat (GN.toInst x))) names
 
 
 
 noMain :: [GNode] -> [GEdge] -> Bool
 noMain ns es =
     let names = map snd (nameNodeList ns es)
-        mains = filter ((== (Instruction "grasp:main")) . Types.gninst) names
+        mains = filter ((== (GN.mkInst "grasp:main")) . GN.toInst) names
     in length mains /= 0
 
 
@@ -182,15 +172,15 @@ getReadHandle path = do
 -- fix this later so it doesn't required unconnected edge checking first
 nameNodeList :: [GNode] -> [GEdge] -> [(GNode,GNode)]
 nameNodeList ns es =
-    let nameEdges = filter ((== (EdgeLabel "name")) . Types.gelabel) es
-        findNode n = Maybe.fromJust (List.find ((== n) . Types.gnode) ns)
-    in map (\x -> (findNode (Types.gefrom x), findNode (Types.geto x))) nameEdges
+    let nameEdges = filter ((== (GE.mkLabel "name")) . GE.toLabel) es
+        findNode n = Maybe.fromJust (List.find ((== n) . GN.toNode) ns)
+    in map (\x -> (findNode (GE.toSrc x), findNode (GE.toDest x))) nameEdges
 
 
 
 nodesWithName :: [GNode] -> [GEdge] -> String -> [GNode]
 nodesWithName ns es name =
-    (map fst) . (filter (\x -> (Types.gninst . snd $ x) == (Instruction name))) $ (nameNodeList ns es)
+    (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (GN.mkInst name))) $ (nameNodeList ns es)
 
 
 
@@ -199,7 +189,7 @@ updateIP = do
     program <- State.get
     curNode <- peekIP
     Monad.when (Maybe.isJust curNode) (do
-        nexts <- nodesOut (EdgeLabel "next") (Maybe.fromJust curNode)
+        nexts <- nodesOut (GE.mkLabel "next") (Maybe.fromJust curNode)
         r <- liftIO (Random.getStdRandom (Random.randomR (0, length nexts - 1)))
 
         let ips = instPtrs program
@@ -255,9 +245,9 @@ nodesOut s n = do
     curNode <- peekIP
 
     let gr = programGraph program
-        nout = Graph.lsuc gr (Types.gnode (Maybe.fromJust curNode))
+        nout = Graph.lsuc gr (GN.toNode (Maybe.fromJust curNode))
         filtered = filter ((== s) . snd) nout
-        result = map (\(x,y) -> GNode (x, Maybe.fromJust (Graph.lab gr x))) filtered
+        result = map (\(x,y) -> GN.mkGNode (x, Maybe.fromJust (Graph.lab gr x))) filtered
 
     if (Maybe.isNothing curNode) then return [] else return result
 
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs
index 8c0e4b4..86a1858 100644
--- a/src/Grasp/Parser.hs
+++ b/src/Grasp/Parser.hs
@@ -6,7 +6,12 @@ module Grasp.Parser (
 import Control.Applicative( some )
 import Data.Char( toLower, toUpper )
 import Text.ParserCombinators.Parsec
-import Grasp.Types( Instruction(..), EdgeLabel(..), GNode(..), GEdge(..) )
+
+import Grasp.GNode( GNode )
+import qualified Grasp.GNode as GN
+
+import Grasp.GEdge( GEdge )
+import qualified Grasp.GEdge as GE
 
 
 
@@ -125,7 +130,7 @@ node = do
     a <- attrList
     optional (char ';')
     whiteSpace
-    return (GNode (n, Instruction a))
+    return (GN.mkGNode (n, GN.mkInst a))
 
 
 edge = do
@@ -135,7 +140,7 @@ edge = do
     c <- attrList
     optional (char ';')
     whiteSpace
-    return (GEdge (a,b, EdgeLabel c))
+    return (GE.mkGEdge (a,b, GE.mkLabel c))
 
 
 edgeOp = string "->" >> whiteSpace >> return "->"
diff --git a/src/Grasp/Types.hs b/src/Grasp/Types.hs
deleted file mode 100644
index 62d8043..0000000
--- a/src/Grasp/Types.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-module Grasp.Types (
-	Instruction(..),
-	EdgeLabel(..),
-	GNode(..),
-	GEdge(..),
-
-	gnode,
-	gninst,
-	gefrom,
-	geto,
-	gelabel
-    ) where
-
-
-
-
-import Grasp.Graph( Node, LNode, LEdge )
-
-
-
-
-newtype Instruction = Instruction String
-    deriving (Eq, Show)
-
-newtype EdgeLabel = EdgeLabel String
-    deriving (Eq, Show)
-
-newtype GNode = GNode (LNode Instruction)
-    deriving (Eq, Show)
-
-newtype GEdge = GEdge (LEdge EdgeLabel)
-    deriving (Eq, Show)
-
-
-
-
-gnode :: GNode -> Node
-gnode (GNode a) = fst a
-
-gninst :: GNode -> Instruction
-gninst (GNode a) = snd a
-
-
-
-
-gefrom :: GEdge -> Node
-gefrom (GEdge (a,_,_)) = a
-
-geto :: GEdge -> Node
-geto (GEdge (_,b,_)) = b
-
-gelabel :: GEdge -> EdgeLabel
-gelabel (GEdge (_,_,c)) = c
-