X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Database%2FRRDtool%2FCreate.hs;h=f07797acf5f2dadc9c976cc611f457e4065d0aa4;hb=000307857df5266907964aff4ecc9e118314fe3f;hp=3c403db46f99de5ad8af3c9bfb41b90145692361;hpb=f34eed5749bdaf7ff7b33230557b30115ae343f3;p=hs-rrdtool.git

diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs
index 3c403db..f07797a 100644
--- a/Database/RRDtool/Create.hs
+++ b/Database/RRDtool/Create.hs
@@ -1,7 +1,13 @@
 {-# LANGUAGE
+  ExistentialQuantification,
+  FlexibleContexts,
+  FlexibleInstances,
+  MultiParamTypeClasses,
+  OverlappingInstances,
   TypeFamilies,
   UndecidableInstances
   #-}
+{-# LANGUAGE QuasiQuotes #-} -- DELETE THIS
 module Database.RRDtool.Create
     ( DataSource
     , ExternalDSType(..)
@@ -10,8 +16,8 @@ module Database.RRDtool.Create
     , createRRD
 
     -- Data.HList
-    , (.*.)    
-    , HNil(..)
+    , (.&.)
+    , Nil(..)
 
     -- Database.RRDtool.Expression
     , Constant(..)
@@ -29,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
@@ -59,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
@@ -125,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
@@ -163,32 +174,112 @@ 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)
          }
 -}
 
+-- |The name of the RRD you want to create. RRD files should end with
+-- the extension @.rrd@. However, RRDtool will accept any filename.
+newtype RRDPath = RRDPath FilePath
+
+-- |Do not clobber an existing file of the same name.
+data KeepOldRRD = KeepOldRRD
+
+-- |Specifies the time in seconds since @1970-01-01 UTC@ when the
+-- first value should be added to the RRD. RRDtool will not accept any
+-- data timed before or at the time specified. (default: @now - 10s@)
+newtype RRDStartTime = RRDStartTime POSIXTime
+
+-- |Specifies the base interval in seconds with which data will be fed
+-- into the RRD. (default: 300 sec)
+newtype RRDInterval = RRDInterval NominalDiffTime
+
+class RRDSpec 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
-    :: FilePath -- ^The name of the RRD you want to create. RRD files
-                -- should end with the extension @.rrd@. However,
-                -- RRDtool will accept any filename.
-    -> Bool -- ^Do not clobber an existing file of the same name.
-    -> Maybe POSIXTime -- ^Specifies the time in seconds since
-                       -- @1970-01-01 UTC@ when the first value should
-                       -- be added to the RRD. RRDtool will not accept
-                       -- any data timed before or at the time
-                       -- specified. (default: @now - 10s@)
-    -> Maybe NominalDiffTime -- ^Specifies the base interval in
-                             -- seconds with which data will be fed
-                             -- into the RRD. (default: 300 sec)
---    -> [DataSource] -- ^Data sources to accept input from.
-    -> IO ()
+createRRD :: ( RRDSpec s
+             )
+            => s -> IO ()
 createRRD = error "FIXME"
+
+testMain :: IO ()
+testMain = let s = RRDPath "test.rrd" .&.
+                   KeepOldRRD         .&.
+                   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