From c788edcf6744a51cb38795e4f1959d22d10ad071 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Sat, 24 Apr 2010 14:47:23 +0900
Subject: [PATCH] DSList

---
 Data/HList/Graph.hs        | 33 +++++++++++++++++++++++++++++++++
 Database/RRDtool/Create.hs | 38 ++++++++++++++++++++++++++++++++------
 2 files changed, 65 insertions(+), 6 deletions(-)
 create mode 100644 Data/HList/Graph.hs

diff --git a/Data/HList/Graph.hs b/Data/HList/Graph.hs
new file mode 100644
index 0000000..ee5f613
--- /dev/null
+++ b/Data/HList/Graph.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE
+  FlexibleContexts,
+  FlexibleInstances,
+  TypeFamilies
+  #-}
+module Data.HList.Graph
+    ( HNodeSet
+    , HNode(..)
+    , HGraph(..)
+    )
+    where
+
+import Data.HList.Prelude
+
+-- HNodeSet
+class    HNodeSet ns
+instance HNodeSet HNil
+instance HNodeSet ns => HNodeSet (HCons n ns)
+
+-- HNode
+class ( HNodeSet (HLinksFrom n)
+      )
+    => HNode n
+    where
+      type HNodeID n
+      type HLinksFrom n
+
+-- HGraph
+class ( HNodeSet (HNodes g)
+      )
+    => HGraph g
+    where
+      type HNodes g
diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs
index 5dd3b9f..2adeb24 100644
--- a/Database/RRDtool/Create.hs
+++ b/Database/RRDtool/Create.hs
@@ -1,9 +1,12 @@
 {-# LANGUAGE
   FlexibleContexts,
   FlexibleInstances,
+  GADTs,
+  OverlappingInstances,
   TypeFamilies,
   UndecidableInstances
   #-}
+{-# LANGUAGE QuasiQuotes #-} -- DELETE THIS
 module Database.RRDtool.Create
     ( DataSource
     , ExternalDSType(..)
@@ -192,22 +195,45 @@ newtype RRDStartTime = RRDStartTime POSIXTime
 newtype RRDInterval = RRDInterval NominalDiffTime
 
 class RRDSpec s
-instance ( HOccurs    RRDPath      s
-         , HOccursOpt KeepOldRRD   s
-         , HOccursOpt RRDStartTime s
-         , HOccursOpt RRDInterval  s
+instance ( HOccurs    RRDPath       s
+         , HOccursOpt KeepOldRRD    s
+         , HOccursOpt RRDStartTime  s
+         , HOccursOpt RRDInterval   s
          )
     => RRDSpec s
 
+class NonEmptyDSList l
+instance ( DSList l
+         , DataSource ds
+         )
+    => NonEmptyDSList (HCons ds l)
+
+class DSList l
+instance DSList HNil
+instance ( DSList l
+         , DataSource ds
+         )
+    => DSList (HCons ds l)
+
+-- DataList would be a graph...
+
 -- |The 'createRRD' function lets you set up new Round Robin Database
 -- (RRD) files. The file is created at its final, full size and filled
 -- with @*UNKNOWN*@ data.
-createRRD :: RRDSpec s => s -> IO ()
+createRRD :: ( RRDSpec s
+             , NonEmptyDSList l
+             )
+            => s -> l -> IO ()
 createRRD = error "FIXME"
 
 testMain :: IO ()
 testMain = let s = RRDPath "test.rrd" .&.
                    KeepOldRRD         .&.
                    HNil
+               x = ComputedDataSource {
+                     cdsName = [$hString|foo|]
+                   , cdsExpr = Const 100
+                   }
+               d = x .&. HNil
            in
-             createRRD s
+             createRRD s d
-- 
2.40.0