From: PHO <pho@cielonegro.org>
Date: Mon, 26 Apr 2010 10:29:02 +0000 (+0900)
Subject: InsNode
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=4ab5e37719b3dc47ede5055a18be4eb544c21b40;p=hs-rrdtool.git

InsNode
---

diff --git a/Types/Data/Graph.hs b/Types/Data/Graph.hs
index 8c5fc57..9c5e65e 100644
--- a/Types/Data/Graph.hs
+++ b/Types/Data/Graph.hs
@@ -4,16 +4,24 @@
   UndecidableInstances
   #-}
 module Types.Data.Graph
-    ( Context
+    ( -- * Type Constructors
+      Context
     , Decomp
     , LNode
+    , LEdge
     , LPath
     , Graph
 
-    , Empty
+      -- * Operations
+      -- ** Graph inspection
     , IsEmpty
-
     , Match
+
+      -- ** Graph construction
+    , Empty
+    , Merge
+    , InsNode
+    , InsEdge
     )
     where
 
@@ -37,6 +45,9 @@ data Decomp mContext graph
 -- nodeID: natural number
 data LNode nodeID nodeLabel
 
+--
+data LEdge nodeID1 nodeID2 edgeLabel
+
 -- lNodes: list of LNode
 data LPath lNodes
 
@@ -47,21 +58,63 @@ type Empty = Graph M.Empty
 type family   IsEmpty g
 type instance IsEmpty (Graph m) = M.Null m
 
+-- Merge
+type family   Merge context g
+type instance Merge (Context ps n l ss) (Graph g)
+    = Graph (AddPred (AddSucc (M.Insert n (Context ps n l ss) g) n ps) n ss)
+
+-- InsNode
+type family   InsNode lNode g
+type instance InsNode (LNode n l) g
+    = Merge (Context M.Empty n l M.Empty) g
+
+-- InsEdge
+type family   InsEdge lEdge g
+type instance InsEdge (LEdge n1 n2 l) g
+    = InsEdge' n1 n2 l (Match n1 g)
+
+type family   InsEdge' n1 n2 l decomp
+type instance InsEdge' n1 n2 l (Decomp (Just (Context ps n' l' ss)) g')
+    = Merge (Context ps n1 l' (M.Insert n2 l ss)) g'
+
+-- AddSucc
+type AddSucc g n ps = M.FoldlWithKey (AddSucc' n) g ps
+
+data AddSucc' n
+type instance L.App3 (AddSucc' n) g p l
+    = M.Adjust (AddSucc'' n l) p g
+
+data AddSucc'' n l
+type instance L.App (AddSucc'' n l) (Context ps n' l' ss)
+    = Context ps n' l' (M.Insert n l ss)
+
+-- AddPred
+type AddPred g n ss = M.FoldlWithKey (AddPred' n) g ss
+
+data AddPred' n
+type instance L.App3 (AddPred' n) g s l
+    = M.Adjust (AddPred'' n l) s g
+
+data AddPred'' n l
+type instance L.App (AddPred'' n l) (Context ps n' l' ss)
+    = Context (M.Insert n l ss) n' l' ss
+
 -- Match
-type Match node g = Match' (M.Lookup node g) node g
+type family   Match node g
+type instance Match node (Graph g) = Match' (M.Lookup node g) node (Graph g)
 
 type family   Match' mContext node g
 type instance Match' Nothing                          node g = Decomp Nothing g
-type instance Match' (Just (Context p node' label s)) node g
+type instance Match' (Just (Context p node' label s)) node (Graph g)
     = Decomp (Just (Context (M.Delete node p)
                             node
                             label
                             (M.Delete node s)))
-             (ClearSucc (ClearPred (M.Delete node g)
-                                   node
-                                   (M.Keys (M.Delete node s)))
-                        node
-                        (M.Keys (M.Delete node p)))
+             (Graph (ClearSucc (ClearPred (M.Delete node g)
+                                          node
+                                          (M.Keys (M.Delete node s)))
+                               node
+                               (M.Keys (M.Delete node p))))
 
 -- ClearSucc
 type family   ClearSucc g n ns
diff --git a/Types/Data/Graph/Dijkstra.hs b/Types/Data/Graph/Dijkstra.hs
index 9a70ee9..e25aaa0 100644
--- a/Types/Data/Graph/Dijkstra.hs
+++ b/Types/Data/Graph/Dijkstra.hs
@@ -58,3 +58,8 @@ type SpLength node1 node2 graph
 -- Sp
 type Sp node1 node2 graph
     = GetLPathNodes node2 (SpTree node1 graph)
+
+
+
+test :: Match D1 (InsNode (LNode D0 True) Empty)
+test = undefined