From: PHO Date: Fri, 23 Apr 2010 04:37:37 +0000 (+0900) Subject: implementing type-level strings... X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=4611522487b382b839a53e75e3feb2aac8764074;p=hs-rrdtool.git implementing type-level strings... --- diff --git a/Data/HList/Number.hs b/Data/HList/Number.hs new file mode 100644 index 0000000..ed9b513 --- /dev/null +++ b/Data/HList/Number.hs @@ -0,0 +1,58 @@ +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 b3a88fd..3eb7e81 100644 --- a/Data/HList/Prelude.hs +++ b/Data/HList/Prelude.hs @@ -1,3 +1,11 @@ +{-# LANGUAGE DeriveDataTypeable, + FlexibleContexts, + FlexibleInstances, + MultiParamTypeClasses, + TypeFamilies, + TypeOperators, + UndecidableInstances + #-} module Data.HList.Prelude ( HList diff --git a/Data/HList/String.hs b/Data/HList/String.hs index a51457e..bcec59c 100644 --- a/Data/HList/String.hs +++ b/Data/HList/String.hs @@ -1,6 +1,33 @@ module Data.HList.String - ( + ( HString + , hString ) where ---import Data.HList.Prelude +import Data.HList.Number +import Data.HList.Prelude +import Language.Haskell.TH +import Language.Haskell.TH.Quote + + +class HString s + +instance HString HNil + +instance HNat c => HString (HCons c s) + +hString :: QuasiQuoter +hString = QuasiQuoter quoteStrExp quoteStrPat + +quoteStrExp :: String -> ExpQ +quoteStrExp [] = varE (mkName "hNil") +quoteStrExp (c:cs) = appsE [ varE (mkName "hCons") + , hNatLiteralE (fromEnum c) + , quoteStrExp cs + ] + +quoteStrPat :: String -> PatQ +quoteStrPat [] = varP (mkName "HNil") +quoteStrPat (c:cs) = conP (mkName "HCons") [ hNatLiteralP (fromEnum c) + , quoteStrPat cs + ] diff --git a/rrdtool.cabal b/rrdtool.cabal index 83d74d5..2a3a029 100644 --- a/rrdtool.cabal +++ b/rrdtool.cabal @@ -23,9 +23,10 @@ Source-Repository head Library Build-Depends: - base == 4.2.*, - bindings-librrd == 0.1.*, - time == 1.1.* + base == 4.2.*, + bindings-librrd == 0.1.*, + template-haskell == 2.4.*, + time == 1.1.* Exposed-Modules: Database.RRDtool @@ -33,6 +34,7 @@ Library Database.RRDtool.Expression Data.HList Data.HList.Prelude + Data.HList.Number Data.HList.String Extensions: