From: PHO <pho@cielonegro.org>
Date: Fri, 23 Apr 2010 08:22:30 +0000 (+0900)
Subject: HString and HLength
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hs-rrdtool.git;a=commitdiff_plain;h=a584a7c4d5ff7e6651f41070b0d2d5032d49b0dd

HString and HLength
---

diff --git a/Data/HList/Number.hs b/Data/HList/Number.hs
deleted file mode 100644
index ed9b513..0000000
--- a/Data/HList/Number.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-module Data.HList.Number
-    ( HNat
-
-    , HZero
-    , hZero
-
-    , HSucc
-    , hSucc
-    , hPred
-
-    , hNatLiteralT
-    , hNatLiteralE
-    , hNatLiteralP
-    )
-    where
-
-import Language.Haskell.TH
-
-
--- HNat
-class HNat n
-
--- HZero
-data HZero = HZero deriving Show
-
-instance HNat HZero
-
-hZero :: HZero
-hZero = HZero
-
--- HSucc
-data HSucc n = HSucc n deriving Show
-
-instance HNat n => HNat (HSucc n)
-
-hSucc :: HNat n => n -> HSucc n
-hSucc = HSucc
-
-hPred :: HNat n => HSucc n -> n
-hPred (HSucc n) = n
-
--- TH
-hNatLiteralT :: Integral n => n -> Q Type
-hNatLiteralT n
-    | n == 0    = conT (mkName "HZero")
-    | otherwise = appT (conT (mkName "HSucc"))
-                       (hNatLiteralT (n - 1))
-
-hNatLiteralE :: Integral n => n -> Q Exp
-hNatLiteralE n
-    | n == 0    = varE (mkName "hZero")
-    | otherwise = appE (varE (mkName "hSucc"))
-                       (hNatLiteralE (n - 1))
-
-hNatLiteralP :: Integral n => n -> Q Pat
-hNatLiteralP n
-    | n == 0    = varP (mkName "HZero")
-    | otherwise = conP (mkName "HSucc") [hNatLiteralP n]
diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index 3eb7e81..3ab596f 100644
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -27,10 +27,13 @@ module Data.HList.Prelude
     , HFoldrable(..)
     , HConcatable(..)
     , HMappable(..)
+
+    , HLength(..)
     )
     where
 
 import Data.Typeable
+import Types.Data.Num hiding ((:*:))
 
 
 -- HList
@@ -153,3 +156,18 @@ instance ( Applyable f x
          ) => HMappable f (HCons x xs) where
     type HMap f (HCons x xs) = HCons (Apply f x) (HMap f xs)
     hMap f (HCons x xs) = hCons (apply f x) (hMap f xs)
+
+-- HLength
+class IntegerT (HLengthOf l) => HLength l where
+    type HLengthOf l
+    hLength :: Integral n => l -> n
+
+instance HLength HNil where
+    type HLengthOf HNil = D0
+    hLength _ = 0
+
+instance ( HLength l
+         , IntegerT (Succ (HLengthOf l))
+         ) => HLength (HCons e l) where
+    type HLengthOf (HCons e l) = Succ (HLengthOf l)
+    hLength (HCons _ l) = 1 + hLength l
diff --git a/Data/HList/String.hs b/Data/HList/String.hs
index bcec59c..e3f878a 100644
--- a/Data/HList/String.hs
+++ b/Data/HList/String.hs
@@ -4,17 +4,18 @@ module Data.HList.String
     )
     where
 
-import Data.HList.Number
 import Data.HList.Prelude
 import Language.Haskell.TH
 import Language.Haskell.TH.Quote
+import Types.Data.Num.Decimal.Literals.TH
+import Types.Data.Num.Ops
 
 
 class HString s
 
 instance HString HNil
 
-instance HNat c => HString (HCons c s)
+instance IntegerT c => HString (HCons c s)
 
 hString :: QuasiQuoter
 hString = QuasiQuoter quoteStrExp quoteStrPat
@@ -22,12 +23,13 @@ hString = QuasiQuoter quoteStrExp quoteStrPat
 quoteStrExp :: String -> ExpQ
 quoteStrExp []     = varE (mkName "hNil")
 quoteStrExp (c:cs) = appsE [ varE (mkName "hCons")
-                           , hNatLiteralE (fromEnum c)
+                           , decLiteralV (toInteger $ fromEnum c)
                            , quoteStrExp cs
                            ]
 
 quoteStrPat :: String -> PatQ
 quoteStrPat []     = varP (mkName "HNil")
-quoteStrPat (c:cs) = conP (mkName "HCons") [ hNatLiteralP (fromEnum c)
-                                           , quoteStrPat cs
-                                           ]
+quoteStrPat (c:cs) = conP (mkName "HCons")
+                     [ sigP wildP (decLiteralT $ toInteger $ fromEnum c)
+                     , quoteStrPat cs
+                     ]
diff --git a/rrdtool.cabal b/rrdtool.cabal
index 2a3a029..2b3c9a7 100644
--- a/rrdtool.cabal
+++ b/rrdtool.cabal
@@ -24,9 +24,10 @@ Source-Repository head
 Library
     Build-Depends:
         base             == 4.2.*,
-        bindings-librrd  == 0.1.*,
+        bindings-librrd  == 0.2.*,
         template-haskell == 2.4.*,
-        time             == 1.1.*
+        time             == 1.1.*,
+        tfp              == 0.2.*
 
     Exposed-Modules:
         Database.RRDtool
@@ -34,7 +35,6 @@ Library
         Database.RRDtool.Expression
         Data.HList
         Data.HList.Prelude
-        Data.HList.Number
         Data.HList.String
 
     Extensions: