working on graph...

diff --git a/Data/HList/Graph.hs b/Data/HList/Graph.hs
index ee5f613f1d5b4daea8ff4ed47dad0d643d31bb54..f31659ca4671b660c95b88b3d4cfae3a21e73e18 100644 (file)
--- a/Data/HList/Graph.hs
+++ b/Data/HList/Graph.hs
@@ -1,12 +1,17 @@
 {-# LANGUAGE
+  EmptyDataDecls,
   FlexibleContexts,
   FlexibleInstances,
+  MultiParamTypeClasses,
   TypeFamilies
   #-}
 module Data.HList.Graph
     ( HNodeSet
+    , HNodeIDSet
     , HNode(..)
     , HGraph(..)
+
+    , HNodeIDA
     )
     where
 
@@ -17,17 +22,28 @@ class    HNodeSet ns
 instance HNodeSet HNil
 instance HNodeSet ns => HNodeSet (HCons n ns)
 
+-- HNodeIDSet
+class    HNoDuplicates nids => HNodeIDSet nids
+instance HNodeIDSet HNil
+instance (HOccursNot nid nids, HNodeIDSet nids) => HNodeIDSet (HCons nid nids)
+
 -- HNode
-class ( HNodeSet (HLinksFrom n)
-      )
-    => HNode n
+class HNodeIDSet (HLinksFrom n) => HNode n
     where
       type HNodeID n
       type HLinksFrom n
 
+-- HNodeIDA
+data HNodeIDA
+instance ApplyT HNodeIDA n where
+    type Apply HNodeIDA n = HNodeID n
+
 -- HGraph
 class ( HNodeSet (HNodes g)
+      , HNoDuplicates (HMap HNodeIDA g)
       )
     => HGraph g
     where
       type HNodes g
+
+--type family HGetNode g n
\ No newline at end of file

diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index dc33147be63c7de93cc58dae3df25d723c3b680b..856c677c67d629b70adea88519a41c863909d988 100644 (file)
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -43,7 +43,9 @@ module Data.HList.Prelude
     , HOccursMany1(..)
     , HOccursOpt(..)
     , HOccurs(..)
-    , HOccursNot(..)
+    , HOccursNot
+
+    , HNoDuplicates
     )
     where
 
@@ -274,6 +276,11 @@ instance HOccursNot e HNil
 instance Fail (TypeFound e) => HOccursNot e (HCons e  l)
 instance HOccursNot e l     => HOccursNot e (HCons e' l)
 
+-- HNoDuplicates
+class    HNoDuplicates l
+instance HNoDuplicates HNil
+instance HOccursNot e l => HNoDuplicates (HCons e l)
+
 {-
 {-
 "Strongly Typed Heterogeneous Collections"

diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs
index 2adeb2475a7abe86f3766eb4fff4cf5d58ed0d34..28c0bfd357dc77ca5d81a0bb42985b07b6b4a54c 100644 (file)
--- 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

diff --git a/Database/RRDtool/Expression.hs b/Database/RRDtool/Expression.hs
index 077f40fa38c177f8477a75c7a8860626216b0426..19a241fe053b69a1d9ebddaf7c04e4a33c5904b0 100644 (file)
--- a/Database/RRDtool/Expression.hs
+++ b/Database/RRDtool/Expression.hs
@@ -84,7 +84,9 @@ class ( (HLengthOf str :<=: D19) ~ True
     => IsVarName str
 -}
 type family   IsVarName str
-type instance IsVarName str = ( (HLength str :<=: D19)
+type instance IsVarName str = ( (HLength str :>: D0)
+                                :&&:
+                                (HLength str :<=: D19)
                                 :&&:
                                 (HAll IsGoodLetterForVarNameA str)
                               )
@@ -92,7 +94,7 @@ type instance IsVarName str = ( (HLength str :<=: D19)
 type family   IsGoodLetterForVarName c
 type instance IsGoodLetterForVarName c = ( ((c :>=: D65) :&&: (c :<=:  D90)) -- A-Z
                                            :||:
-                                           ((c :>=: D99) :&&: (c :<=: D122)) -- a-z
+                                           ((c :>=: D97) :&&: (c :<=: D122)) -- a-z
                                            :||:
                                            (c :==: D45) -- '-'
                                            :||:
@@ -104,9 +106,8 @@ instance ApplyT IsGoodLetterForVarNameA c where
     type Apply IsGoodLetterForVarNameA c = IsGoodLetterForVarName c
 
 -- Variable
-data Variable vn
-    = Variable !vn
-    deriving (Show, Eq, Ord)
+data Variable vn = Var !vn
+                   deriving (Show, Eq, Ord)
 
 type instance IsExpr          (Variable vn) = True
 type instance IsCommonExpr    (Variable vn) = True

diff --git a/rrdtool.cabal b/rrdtool.cabal
index a444e8f59f4425cbe1e5537a6d058410aa39f19b..7a2837da561c43dea40aebcfb7a39b301aa13364 100644 (file)
--- a/rrdtool.cabal
+++ b/rrdtool.cabal
@@ -36,19 +36,7 @@ Library
         Data.HList
         Data.HList.Graph
         Data.HList.Prelude
---        Data.HList.Record
         Data.HList.String
 
-    Extensions:
-        DeriveDataTypeable
-        EmptyDataDecls
-        ExistentialQuantification
-        FlexibleContexts
-        FlexibleInstances
-        MultiParamTypeClasses
-        TypeFamilies
-        TypeOperators
-        UndecidableInstances
-
     GHC-Options:
         -Wall
\ No newline at end of file