X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Database%2FRRDtool%2FCreate.hs;h=f07797acf5f2dadc9c976cc611f457e4065d0aa4;hb=000307857df5266907964aff4ecc9e118314fe3f;hp=a3b51e54171d74e14d1ad822ece4fd8281a0c870;hpb=57b97113a93d366f14278a12b8170a1c06e258a1;p=hs-rrdtool.git diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs index a3b51e5..f07797a 100644 --- a/Database/RRDtool/Create.hs +++ b/Database/RRDtool/Create.hs @@ -1,3 +1,13 @@ +{-# LANGUAGE + ExistentialQuantification, + FlexibleContexts, + FlexibleInstances, + MultiParamTypeClasses, + OverlappingInstances, + TypeFamilies, + UndecidableInstances + #-} +{-# LANGUAGE QuasiQuotes #-} -- DELETE THIS module Database.RRDtool.Create ( DataSource , ExternalDSType(..) @@ -6,8 +16,8 @@ module Database.RRDtool.Create , createRRD -- Data.HList - , (.*.) - , HNil(..) + , (.&.) + , Nil(..) -- Database.RRDtool.Expression , Constant(..) @@ -25,9 +35,11 @@ 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 +import Types.Data.Bool -- |A single RRD can accept input from several data sources (DS), for @@ -54,7 +66,8 @@ import Database.RRDtool.Expression -- 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 @@ -86,14 +99,12 @@ data ExternalDSType -- number of messages since the last update. deriving (Show, Eq, Ord) -instance DataSource ExternalDSType - -data ExternalDataSource +data ExternalDataSource vn = ExternalDataSource { -- |The name you will use to reference this particular data -- source from an RRD. A ds name must be 1 to 19 characters -- long in the characters @[a-zA-Z0-9_]@. - edsName :: !String + edsName :: !vn -- |The type of this data source. , edsType :: !ExternalDSType -- |Defines the maximum number of seconds that may pass @@ -119,6 +130,13 @@ data ExternalDataSource } deriving (Show, Eq, Ord) +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 @@ -131,10 +149,10 @@ data ExternalDataSource -- \"computed\" columns. -- -- FIXME: doc links -data ComputedDataSource e +data ComputedDataSource vn e = ComputedDataSource { -- |See 'edsName' - cdsName :: !String + cdsName :: !vn -- |rpn-expression defines the formula used to compute the -- PDPs of a COMPUTE data source from other data sources in -- the same \. It is similar to defining a CDEF argument @@ -152,32 +170,116 @@ data ComputedDataSource e } deriving (Show, Eq, Ord) -instance IsCommonExpr e => DataSource (ComputedDataSource e) +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" --- , dsExpr = Previous :<: Const 100 --- , dsExpr = Var "foo" :<: Const 100 - , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. HNil) +-- , cdsExpr = Previous :<: Const 100 +-- , cdsExpr = Var "foo" :<: Const 100 + , 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