From: PHO Date: Sat, 24 Apr 2010 17:35:36 +0000 (+0900) Subject: working on graph... X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hs-rrdtool.git;a=commitdiff_plain;h=256aad40f96ce034bc1aebd3302ecd8a86419163 working on graph... --- diff --git a/Data/HList/Graph.hs b/Data/HList/Graph.hs index ee5f613..f31659c 100644 --- 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 dc33147..856c677 100644 --- 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 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 diff --git a/Database/RRDtool/Expression.hs b/Database/RRDtool/Expression.hs index 077f40f..19a241f 100644 --- 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 a444e8f..7a2837d 100644 --- 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