X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hs-rrdtool.git;a=blobdiff_plain;f=Database%2FRRDtool%2FCreate.hs;h=28c0bfd357dc77ca5d81a0bb42985b07b6b4a54c;hp=2adeb2475a7abe86f3766eb4fff4cf5d58ed0d34;hb=256aad40f96ce034bc1aebd3302ecd8a86419163;hpb=c788edcf6744a51cb38795e4f1959d22d10ad071

diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs
index 2adeb24..28c0bfd 100644
--- a/Database/RRDtool/Create.hs
+++ b/Database/RRDtool/Create.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE
+  ExistentialQuantification,
   FlexibleContexts,
   FlexibleInstances,
-  GADTs,
+  MultiParamTypeClasses,
   OverlappingInstances,
   TypeFamilies,
   UndecidableInstances
@@ -34,6 +35,7 @@ module Database.RRDtool.Create
     where
 
 import Data.HList
+import Data.HList.Graph
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Database.RRDtool.Expression
@@ -64,7 +66,8 @@ import Types.Data.Bool
 -- 32bit counter, DERIVE with @'dsMin' = 0@ is probably preferable. If
 -- you are using a 64bit counter, just about any max setting will
 -- eliminate the possibility of mistaking a reset for a counter wrap.
-class DataSource ds
+class DataSource ds where
+    type DSName ds
 
 data ExternalDSType
     = GAUGE    -- ^GAUGE is for things like temperatures or number of
@@ -130,7 +133,10 @@ data ExternalDataSource vn
 instance ( IsVarName vn ~ True
          )
     => DataSource (ExternalDataSource vn)
+    where
+      type DSName (ExternalDataSource vn) = vn
 
+type instance MentionedVars (ExternalDataSource vn) = HNil
 
 -- |ComputedDataSource is for storing the result of a formula applied
 -- to other data sources in the RRD. This data source is not supplied
@@ -168,6 +174,10 @@ instance ( IsVarName vn ~ True
          , IsCommonExpr e ~ True
          )
     => DataSource (ComputedDataSource vn e)
+    where
+      type DSName (ComputedDataSource vn e) = vn
+
+type instance MentionedVars (ComputedDataSource vn e) = MentionedVars e
 
 {-
 dsTest = ComputedDataSource {
@@ -195,45 +205,77 @@ 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
+         , HOccurs    RRDDataSources s
          )
     => RRDSpec s
 
 class NonEmptyDSList l
 instance ( DSList l
-         , DataSource ds
+         , DataSource d
          )
-    => NonEmptyDSList (HCons ds l)
+    => NonEmptyDSList (HCons d l)
 
 class DSList l
 instance DSList HNil
 instance ( DSList l
-         , DataSource ds
+         , DataSource d
+         )
+    => DSList (HCons d l)
+
+data RRDDataSources
+    = forall l.
+      ( NonEmptyDSList l
+      , HGraph l -- FIXME: this constraint is too weak
+      )
+    => RRDDataSources l
+
+-- RRDDataSources is a graph.
+instance ( DSList g
+         , HNodeSet g
+         , HNoDuplicates (HMap HNodeIDA g)
          )
-    => DSList (HCons ds l)
+    => HGraph g
+    where
+      type HNodes g = g
 
--- DataList would be a graph...
+instance ( HNodeIDSet (MentionedVars d)
+         , DataSource d
+         )
+    => HNode d
+    where
+      type HNodeID d    = DSName d
+      type HLinksFrom d = MentionedVars d
 
 -- |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
-             , NonEmptyDSList l
              )
-            => s -> l -> IO ()
+            => s -> IO ()
 createRRD = error "FIXME"
 
 testMain :: IO ()
 testMain = let s = RRDPath "test.rrd" .&.
                    KeepOldRRD         .&.
+                   RRDDataSources testDSList .&.
                    HNil
-               x = ComputedDataSource {
-                     cdsName = [$hString|foo|]
-                   , cdsExpr = Const 100
-                   }
-               d = x .&. HNil
            in
-             createRRD s d
+             createRRD s
+
+testDSList = let a = ComputedDataSource {
+                       cdsName = [$hString|foo|]
+                     , cdsExpr = Var [$hString|bar|]
+                     }
+                 b = ComputedDataSource {
+                       cdsName = [$hString|bar|]
+                     , cdsExpr = Var [$hString|foo|] -- shouldn't typecheck!
+                     }
+                 c = ComputedDataSource {
+                       cdsName = [$hString|baz|]
+                     , cdsExpr = Var [$hString|foo|] -- should typecheck!
+                     }
+             in a .&. b .&. HNil
\ No newline at end of file