From 2aa0bab498cffbc12d485d2c59f7aed04c69c409 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 5 Dec 2014 19:59:04 +1100 Subject: GNode and GEdge types now have their own files... again... --- src/Grasp/GEdge.hs | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++ src/Grasp/GNode.hs | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Grasp/IP.hs | 2 +- src/Grasp/Monad.hs | 48 +++++++++++++++++------------------------- src/Grasp/Parser.hs | 11 +++++++--- src/Grasp/Types.hs | 54 ----------------------------------------------- 6 files changed, 146 insertions(+), 87 deletions(-) create mode 100644 src/Grasp/GEdge.hs create mode 100644 src/Grasp/GNode.hs delete mode 100644 src/Grasp/Types.hs 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 - -- cgit