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/Graph.hs | 153 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 153 insertions(+)
 create mode 100644 src/Grasp/Graph.hs

(limited to 'src/Grasp/Graph.hs')

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)
+
-- 
cgit