diff --git a/DSH.cabal b/DSH.cabal --- a/DSH.cabal +++ b/DSH.cabal @@ -1,5 +1,5 @@ Name: DSH -Version: 0.8.2.2 +Version: 0.8.2.3 Synopsis: Database Supported Haskell Description: This is a Haskell library for database-supported program execution. Using @@ -7,7 +7,7 @@ a coprocessor for the Haskell programming language, especially for those program fragments that carry out data-intensive and data-parallel computations. - . + . Database executable program fragments can be written using the monad comprehension notation [2] and list processing combinators from the Haskell list prelude. Note that rather than embedding a relational language into @@ -23,15 +23,15 @@ DSH can be used to allow existing Haskell programs to operate on large scale data (e.g., larger than the available heap) or query existing database resident data with Haskell. - . + . Note that this package is flagged experimental and therefore is not suited for production use. This is a proof of concept implementation only. To learn more about DSH, our paper entitled as "Haskell Boards the Ferry: Database- Supported Program Execution for Haskell" [1] is a recommended reading. The package includes a couple of examples that demonstrate how to use DSH. . - The latest release implements new features described in our work-in- - progress paper entitled as "Algebraic Data Types for Language-Integrated + The latest release implements new features described in our work-in-progress + paper entitled as "Algebraic Data Types for Language-Integrated Queries" [3]. . 1. diff --git a/src/Database/DSH.hs b/src/Database/DSH.hs --- a/src/Database/DSH.hs +++ b/src/Database/DSH.hs @@ -15,7 +15,7 @@ module Database.DSH ( module Database.DSH.Externals - , Q, QA, Elim, elim, View, view + , Q, QA, TA, Elim, elim, View, view , module Database.DSH.TH , module Data.String , module Data.Text @@ -25,7 +25,7 @@ where import Database.DSH.Externals -import Database.DSH.Internals (Q,QA,Elim,elim,View,view) +import Database.DSH.Internals (Q,QA,TA,Elim,elim,View,view) import Database.DSH.TH import Data.String (IsString,fromString) diff --git a/src/Database/DSH/Externals.hs b/src/Database/DSH/Externals.hs --- a/src/Database/DSH/Externals.hs +++ b/src/Database/DSH/Externals.hs @@ -147,6 +147,7 @@ instance TA Double where instance TA Text where instance (BasicType a, BasicType b) => TA (a,b) where +instance (BasicType a, BasicType b, BasicType c) => TA (a,b,c) where -- Num and Fractional instances @@ -621,6 +622,7 @@ infix 0 ? deriveTupleRangeQA 4 7 +deriveTupleRangeTA 4 7 deriveTupleRangeView 4 7 deriveTupleRangeSmartConstructors 2 7 diff --git a/src/Database/DSH/Internals.hs b/src/Database/DSH/Internals.hs --- a/src/Database/DSH/Internals.hs +++ b/src/Database/DSH/Internals.hs @@ -80,8 +80,7 @@ DropWhile :: Fun (a -> Bool,[a]) [a] Cond :: Fun (Bool,(a,a)) a -data Q a where - Q :: Exp (Rep a) -> Q a +newtype Q a = Q (Exp (Rep a)) -- Classes @@ -104,7 +103,7 @@ class View a where type ToView a view :: a -> ToView a - + -- Show instances instance Show (Type a) where diff --git a/src/Database/DSH/TH.hs b/src/Database/DSH/TH.hs --- a/src/Database/DSH/TH.hs +++ b/src/Database/DSH/TH.hs @@ -3,6 +3,8 @@ module Database.DSH.TH ( deriveDSH , deriveQA , deriveTupleRangeQA + , deriveTA + , deriveTupleRangeTA , deriveView , deriveTupleRangeView , deriveElim @@ -150,6 +152,31 @@ deriveFrExpMainPat [name] = VarP name deriveFrExpMainPat names = foldr1 (\p1 p2 -> ConP 'DSH.PairE [p1,p2]) (map VarP names) +----------------- +-- Deriving TA -- +----------------- + +deriveTA :: Name -> Q [Dec] +deriveTA name = do + info <- reify name + case info of + TyConI (DataD _cxt name1 tyVarBndrs cons _names) -> + deriveTyConTA name1 tyVarBndrs cons + TyConI (NewtypeD _cxt name1 tyVarBndrs con _names) -> + deriveTyConTA name1 tyVarBndrs [con] + _ -> fail errMsgExoticType + +deriveTupleRangeTA :: Int -> Int -> Q [Dec] +deriveTupleRangeTA x y = fmap concat (mapM (deriveTA . tupleTypeName) [x .. y]) + +deriveTyConTA :: Name -> [TyVarBndr] -> [Con] -> Q [Dec] +deriveTyConTA name tyVarBndrs _cons = do + let context = map (\tv -> ClassP ''DSH.BasicType [VarT (tyVarBndrToName tv)]) + tyVarBndrs + let typ = foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs) + let instanceHead = AppT (ConT ''DSH.TA) typ + return [InstanceD context instanceHead []] + ------------------- -- Deriving View -- ------------------- @@ -328,32 +355,32 @@ deriveSmartConstructor :: Name -> [TyVarBndr] -> Int -> Int -> Con -> Q [Dec] deriveSmartConstructor typConName tyVarBndrs n i con = do let smartConName = toSmartConName (conToName con) - + let boundTyps = map (VarT . tyVarBndrToName) tyVarBndrs let resTyp = AppT (ConT ''DSH.Q) (foldl AppT (ConT typConName) boundTyps) let smartConContext = map (ClassP ''DSH.QA . return) boundTyps - + let smartConTyp = foldr (AppT . AppT ArrowT . AppT (ConT ''DSH.Q)) resTyp (conToTypes con) - + let smartConDec = SigD smartConName (ForallT tyVarBndrs smartConContext smartConTyp) ns <- mapM (\_ -> newName "e") (conToTypes con) let es = map VarE ns - + let smartConPat = map (ConP 'DSH.Q . return . VarP) ns - + let smartConExp = if null es then (ConE 'DSH.UnitE) else foldr1 (AppE . AppE (ConE 'DSH.PairE)) es smartConBody <- deriveSmartConBody n i smartConExp let smartConClause = Clause smartConPat (NormalB smartConBody) [] - + let funDec = FunD smartConName [smartConClause] - + return [smartConDec,funDec] deriveSmartConBody :: Int -- Total number of constructors