diff --git a/DSH.cabal b/DSH.cabal --- a/DSH.cabal +++ b/DSH.cabal @@ -1,5 +1,5 @@ Name: DSH -Version: 0.8.1.0 +Version: 0.8.2.0 Synopsis: Database Supported Haskell Description: This is a Haskell library for database-supported program execution. Using @@ -32,7 +32,7 @@ reading. The package includes a couple of examples that demonstrate how to use DSH. . - This is a highly experimental realise supporting our work-in-progress paper on + This is a highly experimental release supporting our work-in-progress paper on "Algebraic Data Types for Language-Integrated Queries". . 1. diff --git a/examples/Example01.hs b/examples/Example01.hs --- a/examples/Example01.hs +++ b/examples/Example01.hs @@ -12,13 +12,13 @@ ints = toQ [1 .. 10] query1 :: Q [(Integer,Integer)] -query1 = [ tuple (i1,i2) +query1 = [ pair i1 i2 | i1 <- ints , i2 <- ints ] query2 :: Q [(Integer,Integer)] -query2 = [ tuple (i1,i2) +query2 = [ pair i1 i2 | (view -> (i1,i2)) <- query1 , i1 == i2 ] diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -1,6 +1,7 @@ all: clean ghc -Wall -O3 --make Example01.hs + ghc -Wall -O3 --make Example02.hs rm -rf *.hi *.o clean: - rm -rf *.hi *.o Example01 + rm -rf *.hi *.o Example01 Example02 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, fromView + , Q, QA, 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,fromView) +import Database.DSH.Internals (Q,QA,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 @@ -51,12 +51,18 @@ frExp (TextE t) = t frExp _ = $impossible -instance (QA a, QA b) => QA (a,b) where +instance (QA a,QA b) => QA (a,b) where type Rep (a,b) = (Rep a,Rep b) toExp (a,b) = PairE (toExp a) (toExp b) frExp (PairE a b) = (frExp a,frExp b) frExp _ = $impossible +instance (QA a,QA b,QA c) => QA (a,b,c) where + type Rep (a,b,c) = (Rep a,(Rep b,Rep c)) + toExp (a,b,c) = PairE (toExp a) (PairE (toExp b) (toExp c)) + frExp (PairE a (PairE b c)) = (frExp a,frExp b,frExp c) + frExp _ = $impossible + instance (QA a) => QA [a] where type Rep [a] = [Rep a] toExp as = ListE (P.map toExp as) @@ -194,53 +200,37 @@ -- View instances -instance View (Q ()) (Q ()) where +instance View (Q ()) where type ToView (Q ()) = Q () - type FromView (Q ()) = Q () view = id - fromView = id -instance View (Q Bool) (Q Bool) where +instance View (Q Bool) where type ToView (Q Bool) = Q Bool - type FromView (Q Bool) = Q Bool view = id - fromView = id -instance View (Q Char) (Q Char) where +instance View (Q Char) where type ToView (Q Char) = Q Char - type FromView (Q Char) = Q Char view = id - fromView = id -instance View (Q Integer) (Q Integer) where +instance View (Q Integer) where type ToView (Q Integer) = Q Integer - type FromView (Q Integer) = Q Integer view = id - fromView = id -instance View (Q Double) (Q Double) where +instance View (Q Double) where type ToView (Q Double) = Q Double - type FromView (Q Double) = Q Double view = id - fromView = id -instance View (Q Text) (Q Text) where +instance View (Q Text) where type ToView (Q Text) = Q Text - type FromView (Q Text) = Q Text view = id - fromView = id -instance (QA a, QA b) => View (Q (a,b)) (Q a,Q b) where +instance (QA a, QA b) => View (Q (a,b)) where type ToView (Q (a,b)) = (Q a,Q b) - type FromView (Q a,Q b) = (Q (a,b)) view (Q e) = (Q (AppE Fst e),Q (AppE Snd e)) - fromView (Q a,Q b) = Q (PairE a b) -instance (QA a,QA b,QA c) => View (Q (a,b,c)) (Q a,Q b,Q c) where +instance (QA a,QA b,QA c) => View (Q (a,b,c)) where type ToView (Q (a,b,c)) = (Q a,Q b,Q c) - type FromView (Q a,Q b,Q c) = (Q (a,b,c)) view (Q e) = (Q (AppE Fst e),Q (AppE Fst (AppE Snd e)),Q (AppE Snd (AppE Snd e))) - fromView (Q a,Q b,Q c) = Q (PairE a (PairE b c)) -- IsString instances @@ -390,10 +380,10 @@ eitherToPair (Q a) = Q a left :: (QA a,QA b) => Q a -> Q (Either a b) -left a = pairToEither (tuple (singleton a,nil)) +left a = pairToEither (pair (singleton a) nil) right :: (QA a,QA b) => Q b -> Q (Either a b) -right a = pairToEither (tuple (nil,singleton a)) +right a = pairToEither (pair nil (singleton a)) isLeft :: (QA a,QA b) => Q (Either a b) -> Q Bool isLeft = null . snd . eitherToPair @@ -413,7 +403,7 @@ rights = concatMap (snd . eitherToPair) partitionEithers :: (QA a,QA b) => Q [Either a b] -> Q ([a], [b]) -partitionEithers es = tuple (lefts es,rights es) +partitionEithers es = pair (lefts es) (rights es) -- * List Construction @@ -563,16 +553,16 @@ unzip as = pair (map fst as) (map snd as) zip3 :: (QA a,QA b,QA c) => Q [a] -> Q [b] -> Q [c] -> Q [(a,b,c)] -zip3 as bs cs = map (\abc -> fromView (fst abc,fst (snd abc),snd (snd abc))) (zip as (zip bs cs)) +zip3 as bs cs = map (\abc -> triple (fst abc) (fst (snd abc)) (snd (snd abc))) (zip as (zip bs cs)) zipWith3 :: (QA a,QA b,QA c,QA d) => (Q a -> Q b -> Q c -> Q d) -> Q [a] -> Q [b] -> Q [c] -> Q [d] zipWith3 f as bs cs = map (\e -> (case view e of (a,b,c) -> f a b c)) (zip3 as bs cs) unzip3 :: (QA a,QA b,QA c) => Q [(a,b,c)] -> Q ([a],[b],[c]) -unzip3 abcs = fromView ( map (\e -> (case view e of (a,_,_) -> a)) abcs - , map (\e -> (case view e of (_,b,_) -> b)) abcs - , map (\e -> (case view e of (_,_,c) -> c)) abcs) +unzip3 abcs = triple (map (\e -> (case view e of (a,_,_) -> a)) abcs) + (map (\e -> (case view e of (_,b,_) -> b)) abcs) + (map (\e -> (case view e of (_,_,c) -> c)) abcs) -- * Set-oriented operations @@ -587,9 +577,6 @@ snd :: (QA a,QA b) => Q (a,b) -> Q b snd (Q e) = Q (AppE Snd e) -pair :: (QA a,QA b) => Q a -> Q b -> Q (a,b) -pair (Q a) (Q b) = Q (PairE a b) - -- * Conversions between numeric types integerToDouble :: Q Integer -> Q Double @@ -612,13 +599,13 @@ guard :: Q Bool -> Q [()] guard c = cond c (singleton unit) nil --- * Construction of tuples and records +-- * Construction of tuples -tuple :: (View a b) => b -> a -tuple = fromView +pair :: (QA a,QA b) => Q a -> Q b -> Q (a,b) +pair (Q a) (Q b) = Q (PairE a b) -record :: (View a b) => b -> a -record = fromView +triple :: (QA a,QA b,QA c) => Q a -> Q b -> Q c -> Q (a,b,c) +triple (Q a) (Q b) (Q c)= Q (PairE a (PairE b c)) infixl 9 !! infixr 5 ++, <|, |> @@ -627,7 +614,9 @@ infixr 2 || infix 0 ? -deriveTupleRangeQA 3 16 +deriveTupleRangeQA 4 7 +deriveTupleRangeView 4 7 +deriveTupleRangeSmartConstructors 2 7 -- * Missing functions 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 @@ -96,12 +96,10 @@ class TA a where -class (ToView a ~ b, FromView b ~ a) => View a b where +class View a where type ToView a - type FromView b - view :: a -> b - fromView :: b -> 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 @@ -1,10 +1,19 @@ -module Database.DSH.TH (deriveDSH, deriveQA, deriveTupleRangeQA, deriveElim) where +module Database.DSH.TH ( deriveDSH + , deriveQA + , deriveTupleRangeQA + , deriveView + , deriveTupleRangeView + , deriveElim + , deriveSmartConstructors + , deriveTupleRangeSmartConstructors + ) where import qualified Database.DSH.Internals as DSH import qualified Database.DSH.Impossible as DSH import Language.Haskell.TH import Control.Monad +import Data.Char ----------------------------------------- -- Deriving all DSH-relevant instances -- @@ -12,9 +21,14 @@ deriveDSH :: Name -> Q [Dec] deriveDSH n = do - qa <- deriveQA n - el <- deriveElim n - return (qa ++ el) + qaDecs <- deriveQA n + elimDecs <- deriveElim n + cc <- countConstructors n + viewDecs <- if cc == 1 + then deriveView n + else return [] + scDecs <- deriveSmartConstructors n + return (qaDecs ++ elimDecs ++ viewDecs ++ scDecs) ----------------- -- Deriving QA -- @@ -24,13 +38,19 @@ deriveQA name = do info <- reify name case info of - TyConI (DataD _cxt name1 tyVarBndrs cons _names) -> deriveTyConQA name1 tyVarBndrs cons - TyConI (NewtypeD _cxt name1 tyVarBndrs con _names) -> deriveTyConQA name1 tyVarBndrs [con] - _ -> fail errMsgExoticType + TyConI (DataD _cxt name1 tyVarBndrs cons _names) -> + deriveTyConQA name1 tyVarBndrs cons + TyConI (NewtypeD _cxt name1 tyVarBndrs con _names) -> + deriveTyConQA name1 tyVarBndrs [con] + _ -> fail errMsgExoticType +deriveTupleRangeQA :: Int -> Int -> Q [Dec] +deriveTupleRangeQA x y = fmap concat (mapM (deriveQA . tupleTypeName) [x .. y]) + deriveTyConQA :: Name -> [TyVarBndr] -> [Con] -> Q [Dec] deriveTyConQA name tyVarBndrs cons = do - let context = map (\tv -> ClassP ''DSH.QA [VarT (tyVarBndrToName tv)]) tyVarBndrs + let context = map (\tv -> ClassP ''DSH.QA [VarT (tyVarBndrToName tv)]) + tyVarBndrs let typ = foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs) let instanceHead = AppT (ConT ''DSH.QA) typ let repDec = deriveRep typ cons @@ -38,9 +58,6 @@ frExpDec <- deriveFrExp cons return [InstanceD context instanceHead [repDec,toExpDec,frExpDec]] -deriveTupleRangeQA :: Int -> Int -> Q [Dec] -deriveTupleRangeQA x y = fmap concat (mapM (deriveQA . tupleTypeName) [x .. y]) - -- Deriving the Rep type function deriveRep :: Type -> [Con] -> Dec @@ -81,7 +98,9 @@ let exp1 = deriveToExpMainExp names1 expList1 <- [| DSH.ListE [ $(return exp1) ] |] expEmptyList <- [| DSH.ListE [] |] - let lists = replicate i expEmptyList ++ [expList1] ++ replicate (n - i - 1) expEmptyList + let lists = concat [ replicate i expEmptyList + , [expList1] + , replicate (n - i - 1) expEmptyList] let exp2 = foldr1 (AppE . AppE (ConE 'DSH.PairE)) lists let body1 = NormalB exp2 return (Clause [pat1] body1 []) @@ -107,7 +126,9 @@ deriveFrExpClause 1 _ con = do (_,names1) <- conToPattern con let pat1 = deriveFrExpMainPat names1 - let exp1 = foldl AppE (ConE (conToName con)) (map (AppE (VarE 'DSH.frExp) . VarE) names1) + let exp1 = foldl AppE + (ConE (conToName con)) + (map (AppE (VarE 'DSH.frExp) . VarE) names1) let body1 = NormalB exp1 return (Clause [pat1] body1 []) deriveFrExpClause n i con = do @@ -116,7 +137,9 @@ let patList1 = ConP 'DSH.ListE [ConP '(:) [pat1,WildP]] let lists = replicate i WildP ++ [patList1] ++ replicate (n - i - 1) WildP let pat2 = foldr1 (\p1 p2 -> ConP 'DSH.PairE [p1,p2]) lists - let exp1 = foldl AppE (ConE (conToName con)) (map (AppE (VarE 'DSH.frExp) . VarE) names1) + let exp1 = foldl AppE + (ConE (conToName con)) + (map (AppE (VarE 'DSH.frExp) . VarE) names1) let body1 = NormalB exp1 return (Clause [pat2] body1 []) @@ -126,6 +149,53 @@ deriveFrExpMainPat names = foldr1 (\p1 p2 -> ConP 'DSH.PairE [p1,p2]) (map VarP names) ------------------- +-- Deriving View -- +------------------- + +deriveView :: Name -> Q [Dec] +deriveView name = do + info <- reify name + case info of + TyConI (DataD _cxt name1 tyVarBndrs [con] _names) -> + deriveTyConView name1 tyVarBndrs con + TyConI (NewtypeD _cxt name1 tyVarBndrs con _names) -> + deriveTyConView name1 tyVarBndrs con + _ -> fail errMsgExoticType + +deriveTupleRangeView :: Int -> Int -> Q [Dec] +deriveTupleRangeView x y = fmap concat (mapM (deriveView . tupleTypeName) [x .. y]) + +deriveTyConView :: Name -> [TyVarBndr] -> Con -> Q [Dec] +deriveTyConView name tyVarBndrs con = do + let context = map (\tv -> ClassP ''DSH.QA [VarT (tyVarBndrToName tv)]) tyVarBndrs + let typ1 = AppT (ConT ''DSH.Q) + (foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs)) + let instanceHead = AppT (ConT ''DSH.View) typ1 + let typs = conToTypes con + let typ2 = if null typs + then AppT (ConT ''DSH.Q) (ConT ''()) + else foldl AppT (TupleT (length typs)) (map (AppT (ConT ''DSH.Q)) typs) + let toViewDecTF = TySynInstD ''DSH.ToView [typ1] typ2 + viewDec <- deriveToView (length typs) + return [InstanceD context instanceHead [toViewDecTF, viewDec]] + +deriveToView :: Int -> Q Dec +deriveToView n = do + en <- newName "e" + let ep = VarP en + let pat1 = ConP 'DSH.Q [ep] + + let fAux 0 e1 = [AppE (ConE 'DSH.Q) e1] + fAux 1 e1 = [AppE (ConE 'DSH.Q) e1] + fAux n1 e1 = let fste = AppE (AppE (ConE 'DSH.AppE) (ConE 'DSH.Fst)) e1 + snde = AppE (AppE (ConE 'DSH.AppE) (ConE 'DSH.Snd)) e1 + in AppE (ConE 'DSH.Q) fste : fAux (n1 - 1) snde + + let body1 = TupE (fAux n (VarE en)) + let clause1 = Clause [pat1] (NormalB body1) [] + return (FunD 'DSH.view [clause1]) + +------------------- -- Deriving Elim -- ------------------- @@ -133,8 +203,10 @@ deriveElim name = do info <- reify name case info of - TyConI (DataD _cxt name1 tyVarBndrs cons _names) -> deriveTyConElim name1 tyVarBndrs cons - TyConI (NewtypeD _cxt name1 tyVarBndrs con _names) -> deriveTyConElim name1 tyVarBndrs [con] + TyConI (DataD _cxt name1 tyVarBndrs cons _names) -> + deriveTyConElim name1 tyVarBndrs cons + TyConI (NewtypeD _cxt name1 tyVarBndrs con _names) -> + deriveTyConElim name1 tyVarBndrs [con] _ -> fail errMsgExoticType deriveTyConElim :: Name -> [TyVarBndr] -> [Con] -> Q [Dec] @@ -152,7 +224,8 @@ -- Deriving the Eliminator type function deriveEliminator :: Type -> Type -> [Con] -> Dec -deriveEliminator typ resTy cons = TySynInstD ''DSH.Eliminator [typ,resTy] (deriveEliminatorCons resTy cons) +deriveEliminator typ resTy cons = + TySynInstD ''DSH.Eliminator [typ,resTy] (deriveEliminatorCons resTy cons) deriveEliminatorCons :: Type -> [Con] -> Type deriveEliminatorCons _ [] = error errMsgExoticType @@ -229,6 +302,81 @@ mape = AppE (AppE (ConE 'DSH.AppE) (ConE 'DSH.Map)) paire in mape : go snde fs1 +--------------------------------- +-- Deriving Smart Constructors -- +--------------------------------- + +deriveSmartConstructors :: Name -> Q [Dec] +deriveSmartConstructors name = do + info <- reify name + case info of + TyConI (DataD _cxt typConName tyVarBndrs cons _names) -> do + decss <- zipWithM (deriveSmartConstructor typConName tyVarBndrs (length cons)) + [0 .. ] + cons + return (concat decss) + TyConI (NewtypeD _cxt typConName tyVarBndrs con _names) -> + deriveSmartConstructor typConName tyVarBndrs 1 0 con + _ -> fail errMsgExoticType + +deriveTupleRangeSmartConstructors :: Int -> Int -> Q [Dec] +deriveTupleRangeSmartConstructors x y = + fmap concat (mapM (deriveSmartConstructors . tupleTypeName) [x .. y]) + +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 + -> Int -- Index of the constructor + -> Exp + -> Q Exp +deriveSmartConBody 0 _ _ = fail errMsgExoticType +deriveSmartConBody 1 _ e = return (AppE (ConE 'DSH.Q) e) +deriveSmartConBody n i e = do + listExp <- [| DSH.ListE [ $(return e) ] |] + emptyListExp <- [| DSH.ListE [] |] + let lists = concat [ replicate i emptyListExp + , [listExp] + , replicate (n - i - 1) emptyListExp + ] + let pairExp = foldr1 (AppE . AppE (ConE 'DSH.PairE)) lists + return (AppE (ConE 'DSH.Q) pairExp) + +toSmartConName :: Name -> Name +toSmartConName name1 = case nameBase name1 of + "()" -> mkName "unit" + '(' : cs -> mkName ("tuple" ++ show (length (filter (== ',') cs) + 1)) + c : cs | isAlpha c -> mkName (toLower c : cs) + cs -> mkName (':' : cs) + -- Helper Functions conToTypes :: Con -> [Type] @@ -259,7 +407,18 @@ conToName (InfixC _ name _) = name conToName (ForallC _ _ con) = conToName con +countConstructors :: Name -> Q Int +countConstructors name = do + info <- reify name + case info of + TyConI (DataD _ _ _ cons _) -> return (length cons) + TyConI (NewtypeD {}) -> return 1 + _ -> fail errMsgExoticType + -- Error messages errMsgExoticType :: String -errMsgExoticType = "Automatic derivation of DSH related type class instances only works for Haskell 98 types." +errMsgExoticType = + "Automatic derivation of DSH related type class instances only works for Haskell 98\ + \ types. Derivation of View patters is only supported for single-constructor data\ + \ types." diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -30,26 +30,34 @@ instance Arbitrary Text where arbitrary = fmap Text.pack arbitrary -data D1 = C11 deriving (Eq,Ord,Show) +data D0 = C01 deriving (Eq,Ord,Show) +derive makeArbitrary ''D0 +Q.deriveDSH ''D0 + +data D1 a = C11 a deriving (Eq,Ord,Show) derive makeArbitrary ''D1 Q.deriveDSH ''D1 -data D2 = C21 | C22 deriving (Eq,Ord,Show) +data D2 a b = C21 a b b a deriving (Eq,Ord,Show) derive makeArbitrary ''D2 Q.deriveDSH ''D2 -data D3 a = C31 a | C32 deriving (Eq,Ord,Show) +data D3 = C31 | C32 deriving (Eq,Ord,Show) derive makeArbitrary ''D3 Q.deriveDSH ''D3 -data D4 a = C41 a | C42 | C43 a a | C44 a a a deriving (Eq,Ord,Show) +data D4 a = C41 a | C42 deriving (Eq,Ord,Show) derive makeArbitrary ''D4 Q.deriveDSH ''D4 -data D5 a b c d e = C51 { c511 :: a, c512 :: (a,b,c,d) } | C52 | C53 a b | C54 (a,b,c) | C55 a b c d e deriving (Eq,Ord,Show) +data D5 a = C51 a | C52 | C53 a a | C54 a a a deriving (Eq,Ord,Show) derive makeArbitrary ''D5 Q.deriveDSH ''D5 +data D6 a b c d e = C61 { c611 :: a, c612 :: (a,b,c,d) } | C62 | C63 a b | C64 (a,b,c) | C65 a b c d e deriving (Eq,Ord,Show) +derive makeArbitrary ''D6 +Q.deriveDSH ''D6 + getConn :: IO Connection getConn = connectPostgreSQL "user = 'giorgidz' password = '' host = 'localhost' dbname = 'giorgidz'" @@ -85,6 +93,8 @@ qc prop_maybe_integer putStrPad "Either Integer Integer: " qc prop_either_integer + putStrPad "D0: " + qc prop_d0 putStrPad "D1: " qc prop_d1 putStrPad "D2: " @@ -95,6 +105,8 @@ qc prop_d4 putStrPad "D5: " qc prop_d5 + putStrPad "D6: " + qc prop_d6 putStrLn "" putStrLn "Equality, Boolean Logic and Ordering" @@ -366,20 +378,26 @@ prop_either_integer :: Either Integer Integer -> Property prop_either_integer = makeProp id id -prop_d1 :: D1 -> Property +prop_d0 :: D0 -> Property +prop_d0 = makeProp id id + +prop_d1 :: D1 Integer -> Property prop_d1 = makeProp id id -prop_d2 :: D2 -> Property +prop_d2 :: D2 Integer Integer -> Property prop_d2 = makeProp id id -prop_d3 :: D3 Integer -> Property +prop_d3 :: D3 -> Property prop_d3 = makeProp id id prop_d4 :: D4 Integer -> Property prop_d4 = makeProp id id -prop_d5 :: D5 Integer Integer Integer Integer Integer -> Property +prop_d5 :: D5 Integer -> Property prop_d5 = makeProp id id + +prop_d6 :: D6 Integer Integer Integer Integer Integer -> Property +prop_d6 = makeProp id id -- * Equality, Boolean Logic and Ordering