From d3a9803cf89ea94975934dd8abb18bbc12408a7e Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 6 Dec 2014 00:32:49 +1100 Subject: All newtype stubs now in their own files in their own subdir --- src/Grasp/GEdge.hs | 58 ---------------------------------------- src/Grasp/GNode.hs | 60 ------------------------------------------ src/Grasp/IP.hs | 47 --------------------------------- src/Grasp/Monad.hs | 34 +++++++++++++++--------- src/Grasp/Parser.hs | 20 +++++++++----- src/Grasp/Types/EdgeLabel.hs | 23 ++++++++++++++++ src/Grasp/Types/GEdge.hs | 41 +++++++++++++++++++++++++++++ src/Grasp/Types/GNode.hs | 37 ++++++++++++++++++++++++++ src/Grasp/Types/IP.hs | 47 +++++++++++++++++++++++++++++++++ src/Grasp/Types/Instruction.hs | 32 ++++++++++++++++++++++ 10 files changed, 215 insertions(+), 184 deletions(-) delete mode 100644 src/Grasp/GEdge.hs delete mode 100644 src/Grasp/GNode.hs delete mode 100644 src/Grasp/IP.hs create mode 100644 src/Grasp/Types/EdgeLabel.hs create mode 100644 src/Grasp/Types/GEdge.hs create mode 100644 src/Grasp/Types/GNode.hs create mode 100644 src/Grasp/Types/IP.hs create mode 100644 src/Grasp/Types/Instruction.hs diff --git a/src/Grasp/GEdge.hs b/src/Grasp/GEdge.hs deleted file mode 100644 index fcd826a..0000000 --- a/src/Grasp/GEdge.hs +++ /dev/null @@ -1,58 +0,0 @@ -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 deleted file mode 100644 index 3c8161e..0000000 --- a/src/Grasp/GNode.hs +++ /dev/null @@ -1,60 +0,0 @@ -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 deleted file mode 100644 index 4f042a1..0000000 --- a/src/Grasp/IP.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Grasp.IP ( - IP, - - singleton, - empty, - isEmpty, - peek, - push, - pop, - shift - ) where - - - - -import Grasp.GNode( GNode ) - - - - -newtype IP = IP [GNode] - deriving (Eq, Show) - - - - -singleton :: GNode -> IP -singleton n = IP [n] - -empty :: IP -empty = IP [] - -isEmpty :: IP -> Bool -isEmpty (IP p) = (length p == 0) - -peek :: IP -> Maybe GNode -peek (IP p) = if (length p == 0) then Nothing else Just (head p) - -push :: GNode -> IP -> IP -push n (IP p) = IP (n:p) - -pop :: IP -> IP -pop (IP p) = if (length p == 0) then empty else IP (tail p) - -shift :: GNode -> IP -> IP -shift n (IP p) = if (length p == 0) then empty else IP (n:(tail p)) - diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs index 9b0d65a..d8ffff8 100644 --- a/src/Grasp/Monad.hs +++ b/src/Grasp/Monad.hs @@ -18,6 +18,7 @@ module Grasp.Monad ( + import System.IO( Handle, FilePath, IOMode ) import qualified System.IO as IO @@ -40,14 +41,20 @@ import qualified Data.Map as Map import Grasp.Graph( Node, LNode, LEdge, Gr ) import qualified Grasp.Graph as Graph -import Grasp.IP( IP ) -import qualified Grasp.IP as IP +import Grasp.Types.IP( IP ) +import qualified Grasp.Types.IP as IP + +import Grasp.Types.GNode( GNode ) +import qualified Grasp.Types.GNode as GN -import Grasp.GNode( GNode, Instruction ) -import qualified Grasp.GNode as GN +import Grasp.Types.GEdge( GEdge ) +import qualified Grasp.Types.GEdge as GE -import Grasp.GEdge( GEdge, EdgeLabel ) -import qualified Grasp.GEdge as GE +import Grasp.Types.Instruction( Instruction ) +import qualified Grasp.Types.Instruction as IN + +import Grasp.Types.EdgeLabel( EdgeLabel ) +import qualified Grasp.Types.EdgeLabel as EL @@ -56,6 +63,7 @@ type GraspM a = StateT GraspProgram IO a + data GraspProgram = GraspProgram { programGraph :: Gr Instruction EdgeLabel , instPtrs :: [IP] , fileHandles :: Map FilePath Handle } @@ -86,7 +94,7 @@ finalise s = do (mapM_ IO.hClose) . Map.elems . fileHandles $ p let gr = programGraph p (nodes, edges) = (Graph.labNodes gr, Graph.labEdges gr) - return (map GN.mkGNode nodes, map GE.mkGEdge edges) + return (map GN.mk nodes, map GE.mk edges) @@ -113,14 +121,14 @@ multiNames ns es = numericName :: [GNode] -> [GEdge] -> Bool numericName ns es = let names = map snd (nameNodeList ns es) - in any (\x -> Maybe.isJust (GN.instToFloat (GN.toInst x))) names + in any (\x -> Maybe.isJust (IN.toFloat (GN.toInst x))) names noMain :: [GNode] -> [GEdge] -> Bool noMain ns es = let names = map snd (nameNodeList ns es) - mains = filter ((== (GN.mkInst "grasp:main")) . GN.toInst) names + mains = filter ((== (IN.mk "grasp:main")) . GN.toInst) names in length mains /= 0 @@ -172,7 +180,7 @@ 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 ((== (GE.mkLabel "name")) . GE.toLabel) es + let nameEdges = filter ((== (EL.mk "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 @@ -180,7 +188,7 @@ nameNodeList ns es = nodesWithName :: [GNode] -> [GEdge] -> String -> [GNode] nodesWithName ns es name = - (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (GN.mkInst name))) $ (nameNodeList ns es) + (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (IN.mk name))) $ (nameNodeList ns es) @@ -189,7 +197,7 @@ updateIP = do program <- State.get curNode <- peekIP Monad.when (Maybe.isJust curNode) (do - nexts <- nodesOut (GE.mkLabel "next") (Maybe.fromJust curNode) + nexts <- nodesOut (EL.mk "next") (Maybe.fromJust curNode) r <- liftIO (Random.getStdRandom (Random.randomR (0, length nexts - 1))) let ips = instPtrs program @@ -247,7 +255,7 @@ nodesOut s n = do let gr = programGraph program nout = Graph.lsuc gr (GN.toNode (Maybe.fromJust curNode)) filtered = filter ((== s) . snd) nout - result = map (\(x,y) -> GN.mkGNode (x, Maybe.fromJust (Graph.lab gr x))) filtered + result = map (\(x,y) -> GN.mk (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 86a1858..7274919 100644 --- a/src/Grasp/Parser.hs +++ b/src/Grasp/Parser.hs @@ -3,15 +3,23 @@ module Grasp.Parser ( ) where + + import Control.Applicative( some ) import Data.Char( toLower, toUpper ) import Text.ParserCombinators.Parsec -import Grasp.GNode( GNode ) -import qualified Grasp.GNode as GN +import Grasp.Types.GNode( GNode ) +import qualified Grasp.Types.GNode as GN + +import Grasp.Types.GEdge( GEdge ) +import qualified Grasp.Types.GEdge as GE + +import Grasp.Types.Instruction( Instruction ) +import qualified Grasp.Types.Instruction as IN -import Grasp.GEdge( GEdge ) -import qualified Grasp.GEdge as GE +import Grasp.Types.EdgeLabel( EdgeLabel ) +import qualified Grasp.Types.EdgeLabel as EL @@ -130,7 +138,7 @@ node = do a <- attrList optional (char ';') whiteSpace - return (GN.mkGNode (n, GN.mkInst a)) + return (GN.mk (n, IN.mk a)) edge = do @@ -140,7 +148,7 @@ edge = do c <- attrList optional (char ';') whiteSpace - return (GE.mkGEdge (a,b, GE.mkLabel c)) + return (GE.mk (a,b, EL.mk c)) edgeOp = string "->" >> whiteSpace >> return "->" diff --git a/src/Grasp/Types/EdgeLabel.hs b/src/Grasp/Types/EdgeLabel.hs new file mode 100644 index 0000000..4fbdd27 --- /dev/null +++ b/src/Grasp/Types/EdgeLabel.hs @@ -0,0 +1,23 @@ +module Grasp.Types.EdgeLabel ( + EdgeLabel, + + mk, + + toString + ) where + + + + +newtype EdgeLabel = EdgeLabel String + deriving (Show, Eq) + + + + +mk :: String -> EdgeLabel +mk = EdgeLabel + +toString :: EdgeLabel -> String +toString (EdgeLabel e) = e + diff --git a/src/Grasp/Types/GEdge.hs b/src/Grasp/Types/GEdge.hs new file mode 100644 index 0000000..38ce596 --- /dev/null +++ b/src/Grasp/Types/GEdge.hs @@ -0,0 +1,41 @@ +module Grasp.Types.GEdge ( + GEdge, + + mk, + + toSrc, + toDest, + toLabel, + toLEdge + ) where + + + + +import Grasp.Graph( Node, LEdge ) +import Grasp.Types.EdgeLabel( EdgeLabel ) + + + + +newtype GEdge = GEdge (LEdge EdgeLabel) + deriving (Show, Eq) + + + + +mk :: LEdge EdgeLabel -> GEdge +mk = GEdge + +toSrc :: GEdge -> Node +toSrc (GEdge (x,_,_)) = x + +toDest :: GEdge -> Node +toDest (GEdge (_,y,_)) = y + +toLabel :: GEdge -> EdgeLabel +toLabel (GEdge (_,_,z)) = z + +toLEdge :: GEdge -> LEdge EdgeLabel +toLEdge (GEdge e) = e + diff --git a/src/Grasp/Types/GNode.hs b/src/Grasp/Types/GNode.hs new file mode 100644 index 0000000..92c070e --- /dev/null +++ b/src/Grasp/Types/GNode.hs @@ -0,0 +1,37 @@ +module Grasp.Types.GNode ( + GNode, + + mk, + + toNode, + toInst, + toLNode + ) where + + + + +import Grasp.Graph( Node, LNode ) +import Grasp.Types.Instruction( Instruction ) + + + + +newtype GNode = GNode (LNode Instruction) + deriving (Show, Eq) + + + + +mk :: LNode Instruction -> GNode +mk = GNode + +toNode :: GNode -> Node +toNode (GNode n) = fst n + +toInst :: GNode -> Instruction +toInst (GNode n) = snd n + +toLNode :: GNode -> LNode Instruction +toLNode (GNode n) = n + diff --git a/src/Grasp/Types/IP.hs b/src/Grasp/Types/IP.hs new file mode 100644 index 0000000..c7d3e4b --- /dev/null +++ b/src/Grasp/Types/IP.hs @@ -0,0 +1,47 @@ +module Grasp.Types.IP ( + IP, + + singleton, + empty, + isEmpty, + peek, + push, + pop, + shift + ) where + + + + +import Grasp.Types.GNode( GNode ) + + + + +newtype IP = IP [GNode] + deriving (Eq, Show) + + + + +singleton :: GNode -> IP +singleton n = IP [n] + +empty :: IP +empty = IP [] + +isEmpty :: IP -> Bool +isEmpty (IP p) = (length p == 0) + +peek :: IP -> Maybe GNode +peek (IP p) = if (length p == 0) then Nothing else Just (head p) + +push :: GNode -> IP -> IP +push n (IP p) = IP (n:p) + +pop :: IP -> IP +pop (IP p) = if (length p == 0) then empty else IP (tail p) + +shift :: GNode -> IP -> IP +shift n (IP p) = if (length p == 0) then empty else IP (n:(tail p)) + diff --git a/src/Grasp/Types/Instruction.hs b/src/Grasp/Types/Instruction.hs new file mode 100644 index 0000000..0ff4002 --- /dev/null +++ b/src/Grasp/Types/Instruction.hs @@ -0,0 +1,32 @@ +module Grasp.Types.Instruction ( + Instruction, + + mk, + + toString, + toFloat + ) where + + + + +import Text.Read( readMaybe ) + + + + +newtype Instruction = Instruction String + deriving (Show, Eq) + + + + +mk :: String -> Instruction +mk = Instruction + +toString :: Instruction -> String +toString (Instruction i) = i + +toFloat :: Instruction -> Maybe Float +toFloat (Instruction i) = readMaybe i + -- cgit