From d0cab364562ba696dfd5396a10b698de6a1a5f02 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Fri, 21 Nov 2014 19:04:03 +1100
Subject: Incorporated Grasp.Edge and Grasp.Node into the one Grasp.Graph
 module, loosely based on Data.Graph.Inductive.Graph

---
 src/Grasp/Edge.hs  |  43 ---------------
 src/Grasp/Graph.hs | 153 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Grasp/Node.hs  |  47 ----------------
 3 files changed, 153 insertions(+), 90 deletions(-)
 delete mode 100644 src/Grasp/Edge.hs
 create mode 100644 src/Grasp/Graph.hs
 delete mode 100644 src/Grasp/Node.hs

diff --git a/src/Grasp/Edge.hs b/src/Grasp/Edge.hs
deleted file mode 100644
index f0e1cc3..0000000
--- a/src/Grasp/Edge.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Grasp.Edge (
-	GEdge,
-	GEdgeType,
-
-	singleton,
-	fromStringList,
-	src,
-	dest,
-	lab
-	) where
-
-
-
-import Data.Graph.Inductive.Graph( LEdge )
-import Data.Map( Map )
-import qualified Data.Map as Map
-
-
-
-type GEdge = LEdge String
-type GEdgeType = String
-
-
-
-singleton :: Int -> Int -> String -> GEdge
-singleton f t s = (f,t,s)
-
-fromStringList :: Map String Int -> [(String,String,String)] -> [GEdge]
-fromStringList m es =
-	let change x = case (Map.lookup x m) of
-		    Just a -> a
-		    Nothing -> error "Grasp.Edge.fromStringList: no value for key " ++ x
-    in map (\(x,y,z) -> (change x, change y, z)) es
-
-src :: GEdge -> Int
-src (x,_,_) = x
-
-dest :: GEdge -> Int
-dest (_,x,_) = x
-
-lab :: GEdge -> String
-lab (_,_,x) = x
-
diff --git a/src/Grasp/Graph.hs b/src/Grasp/Graph.hs
new file mode 100644
index 0000000..0caaee7
--- /dev/null
+++ b/src/Grasp/Graph.hs
@@ -0,0 +1,153 @@
+module Grasp.Graph (
+	Node,
+	LNode,
+	UNode,
+	
+	Edge,
+	LEdge,
+	UEdge,
+	
+	Adj,
+	
+	Context,
+	MContext,
+	UContext,
+	
+	Decomp,
+	GDecomp,
+	UDecomp,
+
+	Path,
+	LPath,
+	UPath,
+
+    Gr,
+
+	empty,
+	isEmpty,
+	match,
+	mkGraph,
+	labNodes,
+	noNodes,
+	labEdges,
+	nodes
+    ) where
+
+
+
+
+import Data.List
+import qualified Data.Maybe as Maybe
+
+
+
+
+type Node = String
+
+type LNode a = (Node, a)
+
+type UNode = LNode ()
+
+type Edge = (Node, Node)
+
+type LEdge a = (Node, Node, a)
+
+type UEdge = LEdge ()
+
+type Adj b = [(b, Node)]
+
+type Context a b = (Adj b, Node, a, Adj b)
+
+type MContext a b = Maybe (Context a b)
+
+type UContext = ([Node], Node, [Node])
+
+type Decomp a b = (MContext a b, Gr a b)
+
+type GDecomp a b = (Context a b, Gr a b)
+
+type UDecomp = (Maybe UContext, Gr () ())
+
+type Path = [Node]
+
+newtype LPath a = LP [LNode a]
+
+type UPath = [UNode]
+
+
+
+
+data Gr a b = Gr { labNodes :: [LNode a]
+                 , labEdges :: [LEdge b] }
+    deriving (Show)
+
+
+
+
+instance (Eq a, Eq b) => Eq (Gr a b) where
+	a == b   =   (labNodes a == labNodes b) && (labEdges a == labEdges b)
+
+
+
+
+empty :: Gr a b
+empty = Gr [] []
+
+
+
+isEmpty :: Gr a b -> Bool
+isEmpty gr = (length (labNodes gr) == 0) && (length (labEdges gr) == 0)
+
+
+
+match :: Node -> Gr a b -> Decomp a b
+match n gr =
+    if (n `notElem` nodes gr)
+    	then (Nothing, gr)
+    	else (Just (to, n, label, from), gr)
+    where
+    	to = map edgeToAdjTo (filter (edgeTo n) (labEdges gr))
+    	label = snd . head $ (filter (\(x,y) -> x == n) (labNodes gr))
+    	from = map edgeToAdjFrom (filter (edgeFrom n) (labEdges gr))
+
+
+
+mkGraph :: [LNode a] -> [LEdge b] -> Gr a b
+mkGraph lnodes ledges =
+	let nodes = map fst lnodes
+	    edgeNodes = (map (\(x,y,z) -> x) ledges) `union` (map (\(x,y,z) -> y) ledges)
+
+	in if (all (`elem` nodes) edgeNodes)
+		then Gr lnodes ledges
+		else error "Edge Exception"
+
+
+
+noNodes :: Gr a b -> Int
+noNodes = length . labNodes
+
+
+
+nodes :: Gr a b -> [Node]
+nodes gr = (map fst) . labNodes $ gr
+
+
+
+edgeToAdjFrom :: LEdge a -> Adj a
+edgeToAdjFrom (x,y,z) = (z,y)
+
+
+
+edgeToAdjTo :: LEdge a -> Adj a
+edgeToAdjTo (x,y,z) = (z,x)
+
+
+
+edgeFrom :: Node -> LEdge a -> Bool
+edgeFrom n (x,y,z) = (y == n)
+
+
+
+edgeTo :: Node -> LEdge a -> Bool
+edgeTo n (x,y,z) = (x == n)
+
diff --git a/src/Grasp/Node.hs b/src/Grasp/Node.hs
deleted file mode 100644
index ce84163..0000000
--- a/src/Grasp/Node.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-module Grasp.Node (
-	GNode,
-	GNodeType,
-
-	singleton,
-	uSingleton,
-	fromStringList,
-	lab,
-	inst,
-	idNo
-	) where
-
-
-
-import Data.Graph.Inductive.Graph( LNode )
-import Data.Map( Map )
-import qualified Data.Map as Map
-
-
-
-type GNode = LNode (Maybe String, String)
-type GNodeType = (Maybe String, String)
-
-
-
-singleton :: Int -> String -> String -> GNode
-singleton i m s = (i,(Just m,s))
-
-uSingleton :: Int -> String -> GNode
-uSingleton i s = (i,(Nothing,s))
-
-fromStringList :: Map String Int -> [(String,String)] -> [GNode]
-fromStringList m ns =
-    let change x = case (Map.lookup x m) of
-    	    Just a -> a
-    	    Nothing -> error "Grasp.Node.fromStringList: no value for key " ++ x
-    in map (\(x,y) -> (change x, (Just x, y))) ns
-
-lab :: GNode -> Maybe String
-lab (_,(x,_)) = x
-
-inst :: GNode -> String
-inst (_,(_,x)) = x
-
-idNo :: GNode -> Int
-idNo (x,(_,_)) = x
-
-- 
cgit