working on graphs...

[hs-rrdtool.git] / Types / Data / Graph / RootPath.hs

diff --git a/Types/Data/Graph/RootPath.hs b/Types/Data/Graph/RootPath.hs
new file mode 100644 (file)
index 0000000..753f331
--- /dev/null
+++ b/Types/Data/Graph/RootPath.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE
+  EmptyDataDecls,
+  TypeFamilies,
+  UndecidableInstances
+  #-}
+module Types.Data.Graph.RootPath
+    ( GetLPath
+    , GetDistance
+    , GetLPathNodes
+    )
+    where
+
+import qualified Types.Data.List     as L
+import qualified Types.Data.List.Ops as L
+
+import Types.Data.Bool
+import Types.Data.Graph
+import Types.Data.Ord
+
+-- NodeID
+type family   NodeID lNode
+type instance NodeID (LNode nodeID nodeLabel) = nodeID
+
+-- NodeIDA
+data NodeIDA
+type instance L.App NodeIDA lNode = NodeID lNode
+
+-- NodeLabel
+type family   NodeLabel lNode
+type instance NodeLabel (LNode nodeID nodeLabel) = nodeLabel
+
+-- FindP
+type family   FindP node lPaths
+type instance FindP n L.Null                     = L.Null
+type instance FindP n (L.Cons (LPath L.Null) ps) = FindP n ps
+type instance FindP n (L.Cons (LPath (L.Cons (LNode n' l) ns)) ps)
+    = If (n :==: n')
+         (L.Cons (LNode n' l) ns)
+         (FindP n ps)
+
+-- GetLPath
+type GetLPath node lPaths
+    = LPath (GetLPath' node lPaths)
+
+-- GetLPath'
+type GetLPath' node lPaths
+    = L.Reverse (FindP node lPaths)
+
+-- GetDistance
+type GetDistance node lPaths
+    = NodeLabel (L.Head (FindP node lPaths))
+
+-- GetLPathNodes
+type GetLPathNodes node lPaths
+    = L.Map NodeIDA (GetLPath' node lPaths)