From: PHO <pho@cielonegro.org>
Date: Fri, 23 Apr 2010 02:14:25 +0000 (+0900)
Subject: module splitting
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=b7e8a37aa24e9bda11995613c45187e6e19e0c01;p=hs-rrdtool.git

module splitting
---

diff --git a/Data/HList.hs b/Data/HList.hs
index 05dd901..56f961d 100644
--- a/Data/HList.hs
+++ b/Data/HList.hs
@@ -1,144 +1,19 @@
 module Data.HList
-    ( HList
+    ( -- Data.HList.Prelude
+      HList
     , HNil(..)
     , hNil
     , (:*:)(..)
     , (.*.)
 
-    , HExtendable(..)
-    , HAppendable(..)
+    , (:++:)
+    , (.++.)
 
     , Applyable(..)
-    , Applyable2(..)
 
-    , Id(..)
-    , ApplyHAppend(..)
-
-    , HFoldrable(..)
-    , HConcatable(..)
-    , HMappable(..)
+    , HConcat
+    , HMap
     )
     where
 
-import Data.Typeable
-
--- HList
-class HList l
-
--- HNil
-data HNil
-    = HNil
-      deriving (Show, Eq, Ord, Read, Typeable)
-
-instance HList HNil
-
-hNil :: HNil
-hNil = HNil
-
--- :*:
-infixr 2 :*:
-infixr 2 .*.
-
-data e :*: l
-    = e :*: l
-      deriving (Show, Eq, Ord, Read, Typeable)
-
-instance HList l => HList (e :*: l)
-
-(.*.) :: HList l => e -> l -> e :*: l
-(.*.) = (:*:)
-
--- HExtendable
-class HExtendable e l where
-    type HExtend e l
-    hExtend :: e -> l -> HExtend e l
-
-instance HExtendable e HNil where
-    type HExtend e HNil = e :*: HNil
-    hExtend e nil = e .*. nil
-
-instance HList l => HExtendable e (e' :*: l) where
-    type HExtend e (e' :*: l) = e :*: e' :*: l
-    hExtend e (e' :*: l) = e .*. e' .*. l
-
--- HAppendable
-infixr 1 :++:
-infixr 1 .++.
-
-class HAppendable l l' where
-    type l :++: l'
-    (.++.) :: l -> l' -> l :++: l'
-
-instance HList l => HAppendable HNil l where
-    type HNil :++: l = l
-    _ .++. l = l
-
-instance ( HAppendable l l'
-         , HList (l :++: l')
-         ) => HAppendable (e :*: l) l' where
-    type (e :*: l) :++: l' = e :*: (l :++: l')
-    (e :*: l) .++. l' = e .*. (l .++. l')
-
--- Applyable
-class Applyable f a where
-    type Apply f a
-    apply :: f -> a -> Apply f a
-
--- Applyable2
-class Applyable2 f a b where
-    type Apply2 f a b
-    apply2 :: f -> a -> b -> Apply2 f a b
-
--- Id
-data Id = Id
-
-instance Applyable Id a where
-    type Apply Id a = a
-    apply _ a = a
-
--- ApplyHAppend
-data ApplyHAppend = ApplyHAppend
-
-instance HAppendable a b => Applyable2 ApplyHAppend a b where
-    type Apply2 ApplyHAppend a b = a :++: b
-    apply2 _ a b = a .++. b
-
--- HFoldrable
-class HFoldrable f v l where
-    type HFoldr f v l
-    hFoldr :: f -> v -> l -> HFoldr f v l
-
-instance HFoldrable f v HNil where
-    type HFoldr f v HNil = v
-    hFoldr _ v _ = v
-
-instance ( HFoldrable f v l
-         , Applyable2 f e (HFoldr f v l)
-         ) => HFoldrable f v (e :*: l) where
-    type HFoldr f v (e :*: l) = Apply2 f e (HFoldr f v l)
-    hFoldr f v (e :*: l) = apply2 f e (hFoldr f v l)
-
--- HConcatable
-class HConcatable ls where
-    type HConcat ls
-    hConcat :: ls -> HConcat ls
-
-instance HFoldrable ApplyHAppend HNil ls => HConcatable ls where
-    type HConcat ls = HFoldr ApplyHAppend HNil ls
-    hConcat ls = hFoldr ApplyHAppend hNil ls
-
--- HMappable
-class HMappable f l where
-    type HMap f l
-    hMap :: f -> l -> HMap f l
-
-instance HMappable f HNil where
-    type HMap f HNil = HNil
-    hMap _ _ = HNil
-
-instance ( HList (HMap f xs)
-         , Applyable f x
-         , HMappable f xs
-         ) => HMappable f (x :*: xs) where
-    type HMap f (x :*: xs) = Apply f x :*: HMap f xs
-    hMap f (x :*: xs) = apply f x .*. hMap f xs
+import Data.HList.Prelude
diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
new file mode 100644
index 0000000..b3e6b95
--- /dev/null
+++ b/Data/HList/Prelude.hs
@@ -0,0 +1,145 @@
+module Data.HList.Prelude
+    ( HList
+    , HNil(..)
+    , hNil
+    , (:*:)(..)
+    , (.*.)
+
+    , HExtendable(..)
+    , HAppendable(..)
+
+    , Applyable(..)
+    , Applyable2(..)
+
+    , Id(..)
+    , ApplyHAppend(..)
+
+    , HFoldrable(..)
+    , HConcatable(..)
+    , HMappable(..)
+    )
+    where
+
+import Data.Typeable
+
+
+-- HList
+class HList l
+
+-- HNil
+data HNil
+    = HNil
+      deriving (Show, Eq, Ord, Read, Typeable)
+
+instance HList HNil
+
+hNil :: HNil
+hNil = HNil
+
+-- :*:
+infixr 2 :*:
+infixr 2 .*.
+
+data e :*: l
+    = e :*: l
+      deriving (Show, Eq, Ord, Read, Typeable)
+
+instance HList l => HList (e :*: l)
+
+(.*.) :: HList l => e -> l -> e :*: l
+(.*.) = (:*:)
+
+-- HExtendable
+class HExtendable e l where
+    type HExtend e l
+    hExtend :: e -> l -> HExtend e l
+
+instance HExtendable e HNil where
+    type HExtend e HNil = e :*: HNil
+    hExtend e nil = e .*. nil
+
+instance HList l => HExtendable e (e' :*: l) where
+    type HExtend e (e' :*: l) = e :*: e' :*: l
+    hExtend e (e' :*: l) = e .*. e' .*. l
+
+-- HAppendable
+infixr 1 :++:
+infixr 1 .++.
+
+class HAppendable l l' where
+    type l :++: l'
+    (.++.) :: l -> l' -> l :++: l'
+
+instance HList l => HAppendable HNil l where
+    type HNil :++: l = l
+    _ .++. l = l
+
+instance ( HAppendable l l'
+         , HList (l :++: l')
+         ) => HAppendable (e :*: l) l' where
+    type (e :*: l) :++: l' = e :*: (l :++: l')
+    (e :*: l) .++. l' = e .*. (l .++. l')
+
+-- Applyable
+class Applyable f a where
+    type Apply f a
+    apply :: f -> a -> Apply f a
+
+-- Applyable2
+class Applyable2 f a b where
+    type Apply2 f a b
+    apply2 :: f -> a -> b -> Apply2 f a b
+
+-- Id
+data Id = Id
+
+instance Applyable Id a where
+    type Apply Id a = a
+    apply _ a = a
+
+-- ApplyHAppend
+data ApplyHAppend = ApplyHAppend
+
+instance HAppendable a b => Applyable2 ApplyHAppend a b where
+    type Apply2 ApplyHAppend a b = a :++: b
+    apply2 _ a b = a .++. b
+
+-- HFoldrable
+class HFoldrable f v l where
+    type HFoldr f v l
+    hFoldr :: f -> v -> l -> HFoldr f v l
+
+instance HFoldrable f v HNil where
+    type HFoldr f v HNil = v
+    hFoldr _ v _ = v
+
+instance ( HFoldrable f v l
+         , Applyable2 f e (HFoldr f v l)
+         ) => HFoldrable f v (e :*: l) where
+    type HFoldr f v (e :*: l) = Apply2 f e (HFoldr f v l)
+    hFoldr f v (e :*: l) = apply2 f e (hFoldr f v l)
+
+-- HConcatable
+class HConcatable ls where
+    type HConcat ls
+    hConcat :: ls -> HConcat ls
+
+instance HFoldrable ApplyHAppend HNil ls => HConcatable ls where
+    type HConcat ls = HFoldr ApplyHAppend HNil ls
+    hConcat ls = hFoldr ApplyHAppend hNil ls
+
+-- HMappable
+class HMappable f l where
+    type HMap f l
+    hMap :: f -> l -> HMap f l
+
+instance HMappable f HNil where
+    type HMap f HNil = HNil
+    hMap _ _ = HNil
+
+instance ( HList (HMap f xs)
+         , Applyable f x
+         , HMappable f xs
+         ) => HMappable f (x :*: xs) where
+    type HMap f (x :*: xs) = Apply f x :*: HMap f xs
+    hMap f (x :*: xs) = apply f x .*. hMap f xs
diff --git a/Data/HList/String.hs b/Data/HList/String.hs
new file mode 100644
index 0000000..ecb93ed
--- /dev/null
+++ b/Data/HList/String.hs
@@ -0,0 +1,4 @@
+module Data.HList.String
+    (
+    )
+    where
diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs
index e0146c0..cb41c21 100644
--- a/Database/RRDtool/Create.hs
+++ b/Database/RRDtool/Create.hs
@@ -1,5 +1,8 @@
 module Database.RRDtool.Create
-    ( DataSource(..)
+    ( DataSource
+    , ExternalDSType(..)
+    , ExternalDataSource(..)
+    , ComputedDataSource(..)
     , createRRD
 
     -- Data.HList
@@ -51,24 +54,58 @@ 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.
-data DataSource
-    = -- |GAUGE is for things like temperatures or number of people in
-      -- a room or the value of a RedHat share.
-    GAUGE {
+class DataSource ds
+
+data ExternalDSType
+    = GAUGE    -- ^GAUGE is for things like temperatures or number of
+               -- people in a room or the value of a RedHat share.
+    | COUNTER  -- ^COUNTER is for continuous incrementing counters
+               -- like the ifInOctets counter in a router. The COUNTER
+               -- data source assumes that the counter never
+               -- decreases, except when a counter overflows. The
+               -- update function takes the overflow into account. The
+               -- counter is stored as a per-second rate. When the
+               -- counter overflows, RRDtool checks if the overflow
+               -- happened at the 32bit or 64bit border and acts
+               -- accordingly by adding an appropriate value to the
+               -- result.
+    | DERIVE   -- ^DERIVE will store the derivative of the line going
+               -- from the last to the current value of the data
+               -- source. This can be useful for gauges, for example,
+               -- to measure the rate of people entering or leaving a
+               -- room. Internally, derive works exactly like COUNTER
+               -- but without overflow checks. So if your counter does
+               -- not reset at 32 or 64 bit you might want to use
+               -- DERIVE and combine it with a 'dsMin' value of 0.
+    | ABSOLUTE -- ^ABSOLUTE is for counters which get reset upon
+               -- reading. This is used for fast counters which tend
+               -- to overflow. So instead of reading them normally you
+               -- reset them after every read to make sure you have a
+               -- maximum time available before the next
+               -- overflow. Another usage is for things you count like
+               -- number of messages since the last update.
+    deriving (Show, Eq, Ord)
+
+instance DataSource ExternalDSType
+
+data ExternalDataSource
+    = ExternalDataSource {
         -- |The name you will use to reference this particular data
-        -- source from an RRD. A ds-name must be 1 to 19 characters
+        -- source from an RRD. A ds name must be 1 to 19 characters
         -- long in the characters @[a-zA-Z0-9_]@.
-        dsName :: !String
-        -- |Defines the maximum number of seconds that may
-        -- pass between two updates of this data source before the
-        -- value of the data source is assumed to be @*UNKNOWN*@.
-      , dsHeartbeat :: !NominalDiffTime
-        -- |'dsMin' and 'dsMax' Define the expected range values for
-        -- data supplied by a data source. If 'dsMin' and\/or 'dsMax'
+        edsName :: !String
+        -- |The type of this data source.
+      , edsType :: !ExternalDSType
+        -- |Defines the maximum number of seconds that may pass
+        -- between two updates of this data source before the value of
+        -- the data source is assumed to be @*UNKNOWN*@.
+      , edsHeartbeat :: !NominalDiffTime
+        -- |'edsMin' and 'edsMax' Define the expected range values for
+        -- data supplied by a data source. If 'edsMin' and\/or 'edsMax'
         -- any value outside the defined range will be regarded as
-        -- @*UNKNOWN*@. If you do not know or care about 'dsMin' and
-        -- 'dsMax', set them to 'Nothing' for unknown. Note that
-        -- 'dsMin' and 'dsMax' always refer to the processed values of
+        -- @*UNKNOWN*@. If you do not know or care about 'edsMin' and
+        -- 'edsMax', set them to 'Nothing' for unknown. Note that
+        -- 'edsMin' and 'edsMax' always refer to the processed values of
         -- the DS. For a traffic-'COUNTER' type DS this would be the
         -- maximum and minimum data-rate expected from the device.
         --
@@ -76,62 +113,28 @@ data DataSource
         -- available, always set the min and\/or max properties. This
         -- will help RRDtool in doing a simple sanity check on the
         -- data supplied when running update.
-      , dsMin :: !(Maybe Double)
-        -- |See 'dsMin'.
-      , dsMax :: !(Maybe Double)
-    }
-    -- |COUNTER is for continuous incrementing counters like the
-    -- ifInOctets counter in a router. The COUNTER data source assumes
-    -- that the counter never decreases, except when a counter
-    -- overflows. The update function takes the overflow into
-    -- account. The counter is stored as a per-second rate. When the
-    -- counter overflows, RRDtool checks if the overflow happened at
-    -- the 32bit or 64bit border and acts accordingly by adding an
-    -- appropriate value to the result.
-    | COUNTER {
-        dsName      :: !String
-      , dsHeartbeat :: !NominalDiffTime
-      , dsMin       :: !(Maybe Double)
-      , dsMax       :: !(Maybe Double)
-    }
-    -- |DERIVE will store the derivative of the line going from the
-    -- last to the current value of the data source. This can be
-    -- useful for gauges, for example, to measure the rate of people
-    -- entering or leaving a room. Internally, derive works exactly
-    -- like COUNTER but without overflow checks. So if your counter
-    -- does not reset at 32 or 64 bit you might want to use DERIVE and
-    -- combine it with a 'dsMin' value of 0.
-    | DERIVE {
-        dsName      :: !String
-      , dsHeartbeat :: !NominalDiffTime
-      , dsMin       :: !(Maybe Double)
-      , dsMax       :: !(Maybe Double)
-    }
-    -- |ABSOLUTE is for counters which get reset upon reading. This is
-    -- used for fast counters which tend to overflow. So instead of
-    -- reading them normally you reset them after every read to make
-    -- sure you have a maximum time available before the next
-    -- overflow. Another usage is for things you count like number of
-    -- messages since the last update.
-    | ABSOLUTE {
-        dsName      :: !String
-      , dsHeartbeat :: !NominalDiffTime
-      , dsMin       :: !(Maybe Double)
-      , dsMax       :: !(Maybe Double)
-    }
-    -- |COMPUTE is for storing the result of a formula applied to
-    -- other data sources in the RRD. This data source is not supplied
-    -- a value on update, but rather its Primary Data Points (PDPs)
-    -- are computed from the PDPs of the data sources according to the
-    -- rpn-expression that defines the formula. Consolidation
-    -- functions are then applied normally to the PDPs of the COMPUTE
-    -- data source (that is the rpn-expression is only applied to
-    -- generate PDPs). In database software, such data sets are
-    -- referred to as \"virtual\" or \"computed\" columns.
-    --
-    -- FIXME: doc links
-    | forall a. IsCommonExpr a => COMPUTE {
-        dsName :: !String
+      , edsMin :: !(Maybe Double)
+        -- |See 'edsMin'.
+      , edsMax :: !(Maybe Double)
+      }
+    deriving (Show, Eq, Ord)
+
+
+-- |ComputedDataSource is for storing the result of a formula applied
+-- to other data sources in the RRD. This data source is not supplied
+-- a value on update, but rather its Primary Data Points (PDPs) are
+-- computed from the PDPs of the data sources according to the
+-- rpn-expression that defines the formula. Consolidation functions
+-- are then applied normally to the PDPs of the COMPUTE data source
+-- (that is the rpn-expression is only applied to generate PDPs). In
+-- database software, such data sets are referred to as \"virtual\" or
+-- \"computed\" columns.
+--
+-- FIXME: doc links
+data ComputedDataSource e
+    = ComputedDataSource {
+        -- |See 'edsName'
+        cdsName :: !String
         -- |rpn-expression defines the formula used to compute the
         -- PDPs of a COMPUTE data source from other data sources in
         -- the same \<RRD\>. It is similar to defining a CDEF argument
@@ -145,15 +148,18 @@ data DataSource
         -- graph command.
         -- 
         -- FIXME: doc links
-      , dsExpr :: !a
+      , cdsExpr :: !e
     }
+    deriving (Show, Eq, Ord)
+
+instance IsCommonExpr e => DataSource (ComputedDataSource e)
+
 
-dsTest :: DataSource
-dsTest = COMPUTE {
-           dsName = "foo"
---         , dsExpr = Previous :<: Const 100
---         , dsExpr = Var "foo" :<: Const 100
-           , dsExpr = AverageOf (Const 100 .*. Const 200 .*. HNil)
+dsTest = ComputedDataSource {
+           cdsName = "foo"
+--       , dsExpr = Previous :<: Const 100
+--       , dsExpr = Var "foo" :<: Const 100
+         , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. HNil)
          }
 
 -- |The 'createRRD' function lets you set up new Round Robin Database
@@ -172,6 +178,6 @@ createRRD
     -> 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.
+--    -> [DataSource] -- ^Data sources to accept input from.
     -> IO ()
 createRRD = error "FIXME"
diff --git a/rrdtool.cabal b/rrdtool.cabal
index 7682b25..83d74d5 100644
--- a/rrdtool.cabal
+++ b/rrdtool.cabal
@@ -32,6 +32,8 @@ Library
         Database.RRDtool.Create
         Database.RRDtool.Expression
         Data.HList
+        Data.HList.Prelude
+        Data.HList.String
 
     Extensions:
         DeriveDataTypeable