]> gitweb @ CieloNegro.org - hs-rrdtool.git/blobdiff - Database/RRDtool/Create.hs
major rename
[hs-rrdtool.git] / Database / RRDtool / Create.hs
index 5dd3b9f8fc12aadee9c64bef068dd335ee99b289..f07797acf5f2dadc9c976cc611f457e4065d0aa4 100644 (file)
@@ -1,9 +1,13 @@
 {-# LANGUAGE
+  ExistentialQuantification,
   FlexibleContexts,
   FlexibleInstances,
+  MultiParamTypeClasses,
+  OverlappingInstances,
   TypeFamilies,
   UndecidableInstances
   #-}
+{-# LANGUAGE QuasiQuotes #-} -- DELETE THIS
 module Database.RRDtool.Create
     ( DataSource
     , ExternalDSType(..)
@@ -13,7 +17,7 @@ module Database.RRDtool.Create
 
     -- Data.HList
     , (.&.)
-    , HNil(..)
+    , Nil(..)
 
     -- Database.RRDtool.Expression
     , Constant(..)
@@ -31,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
@@ -61,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
@@ -127,7 +133,10 @@ data ExternalDataSource vn
 instance ( IsVarName vn ~ True
          )
     => DataSource (ExternalDataSource vn)
+    where
+      type DSName (ExternalDataSource vn) = vn
 
+type instance MentionedVars (ExternalDataSource vn) = Nil
 
 -- |ComputedDataSource is for storing the result of a formula applied
 -- to other data sources in the RRD. This data source is not supplied
@@ -165,13 +174,17 @@ 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 {
            cdsName = "foo"
 --         , cdsExpr = Previous :<: Const 100
 --         , cdsExpr = Var "foo" :<: Const 100
-         , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. HNil)
+         , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. Nil)
          }
 -}
 
@@ -192,22 +205,81 @@ 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 ( Occurs    RRDPath        s
+         , OccursOpt KeepOldRRD     s
+         , OccursOpt RRDStartTime   s
+         , OccursOpt RRDInterval    s
+         , Occurs    RRDDataSources s
          )
     => RRDSpec s
 
+class NonEmptyDSList l
+instance ( DSList l
+         , DataSource d
+         )
+    => NonEmptyDSList (Cons d l)
+
+class DSList l
+instance DSList Nil
+instance ( DSList l
+         , DataSource d
+         )
+    => DSList (Cons d l)
+
+data RRDDataSources
+    = forall l.
+      ( NonEmptyDSList l
+      , Graph l -- FIXME: this constraint is too weak
+      )
+    => RRDDataSources l
+
+-- RRDDataSources is a graph.
+instance ( DSList g
+         , NodeSet g
+         , NoDuplicates (Map NodeIDA g)
+         )
+    => Graph g
+    where
+      type Empty g = Nil
+      type Nodes g = g
+
+type instance IsEmpty Nil        = True
+type instance IsEmpty (Cons e l) = False
+
+instance ( NodeIDSet (MentionedVars d)
+         , DataSource d
+         )
+    => Node d
+    where
+      type NodeID d    = DSName d
+      type LinksFrom 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 => s -> IO ()
+createRRD :: ( RRDSpec s
+             )
+            => s -> IO ()
 createRRD = error "FIXME"
 
 testMain :: IO ()
 testMain = let s = RRDPath "test.rrd" .&.
                    KeepOldRRD         .&.
-                   HNil
+                   RRDDataSources testDSList .&.
+                   Nil
            in
              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 .&. Nil
\ No newline at end of file