pg-store 0.4.3 → 0.5.0

raw patch · 6 files changed

+98/−83 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pg-store.cabal +1/−1
• src/Database/PostgreSQL/Store/Entity.hs +2/−2
• src/Database/PostgreSQL/Store/Errand.hs +2/−2
• src/Database/PostgreSQL/Store/Query/Builder.hs +14/−14
• src/Database/PostgreSQL/Store/Query/TH.hs +49/−0
• src/Database/PostgreSQL/Store/Tuple.hs +30/−64

@@ -1,5 +1,5 @@ name:                pg-store-version:             0.4.3+version:             0.5.0 category:            Database synopsis:            Simple storage interface to PostgreSQL description:         Simple storage interface to PostgreSQL

@@ -275,8 +275,8 @@ parseContent :: Parser a -> RowParser 1 a parseContent p = 	processContent $ \ _ mbCnt -> do-		r <- mbCnt-		case endResult (parse p r) of+		cnt <- mbCnt+		case endResult (parse p cnt) of 			Done _ r -> Just r 			_        -> Nothing 	where

@@ -178,8 +178,8 @@ 		res <- acceptResult (P.execParams con stmt params P.Text) 		end res -instance (WithTuple ts (Errand r)) => ErrandQuery (PrepQuery ts) r where-	type ErrandResult (PrepQuery ts) r = FunctionType ts (Errand r)+instance (WithTuple ts) => ErrandQuery (PrepQuery ts) r where+	type ErrandResult (PrepQuery ts) r = Function ts (Errand r)  	executeWith end (PrepQuery name _ _ gens) = 		withTuple $ \ params -> do

@@ -84,29 +84,29 @@  -- | Assemble the query object. assemble :: QueryGenerator a -> a -> Query r-assemble gen x =+assemble gen param = 	Query code values 	where-		(code, values, _) = walk gen x 1+		(code, values, _) = walk gen param 1  		walk :: QueryGenerator b -> b -> Word -> (B.ByteString, [Maybe (Oid, B.ByteString, Format)], Word)-		walk gen x n =-			case gen of+		walk g p n =+			case g of 				Gen typ f -> 					-- 36 = $-					(B.cons 36 (showByteString n), [toTypedParam typ <$> f x], n + 1)+					(B.cons 36 (showByteString n), [toTypedParam typ <$> f p], n + 1)  				Code c -> 					(c, [], n)  				Merge lhs rhs -> 					let-						(lc, lv, n')  = walk lhs x n-						(rc, rv, n'') = walk rhs x n'+						(lc, lv, n')  = walk lhs p n+						(rc, rv, n'') = walk rhs p n' 					in (B.append lc rc, lv ++ rv, n'') -				With t gen' ->-					walk gen' (t x) n+				With t g' ->+					walk g' (t p) n  -- | Assemble for query preparation. assemblePrep :: B.ByteString -> QueryGenerator (Tuple p) -> PrepQuery p r@@ -116,8 +116,8 @@ 		(code, oids, values, _) = walk gen 1  		walk :: QueryGenerator b -> Word -> (B.ByteString, [Oid], b -> [Maybe (B.ByteString, Format)], Word)-		walk gen n =-			case gen of+		walk g n =+			case g of 				Gen typ f -> 					(B.cons 36 (showByteString n), [typ], \ x -> [toParam <$> f x], n + 1) @@ -130,8 +130,8 @@ 						(rc, rt, rf, n'') = walk rhs n' 					in (B.append lc rc, lt ++ rt, lf <> rf, n'') -				With f gen' ->-					let (c, t, v, n') = walk gen' n in (c, t, v . f, n')+				With f g' ->+					let (c, t, v, n') = walk g' n in (c, t, v . f, n')  -- | Embed a generator which requires an external parameter. withOther :: a -> QueryGenerator a -> QueryGenerator b@@ -189,7 +189,7 @@ withParamN :: forall n r ts. (HasElement n ts r)            => QueryGenerator r            -> Tagged n (QueryGenerator (Tuple ts))-withParamN x = Tagged (With (untag . getElementN @n) x)+withParamN x = Tagged (With (untag . getElement @n) x)  -- | Redirect the 0th paramter to the given query generator. withParam0 :: QueryGenerator r -> QueryGenerator (Tuple (r ': ts))

@@ -104,6 +104,29 @@ -- > SELECT t.first, t.second -- > FROM MyTable t --+-- = Preparable queries+-- When building preparable queries, one uses the 'PrepQuery' type to mark the query as preparable.+--+-- We utilize the shortcut @$n@ (where 0 <= n <= 9) to integrate parameters into the query.+--+-- In the following example, we turn @listPeople :: Int -> Query String@ into a preparable query.+--+-- > listPeople :: PrepQuery '[Int] String+-- > listPeople =+-- >     [pgQuery| SELECT name+-- >               FROM people+-- >               WHERE age > $0 |]+--+-- @listPeople@ is now a query which takes 1 parameter.+--+-- Before we can utilize @listPeople@, we have to 'prepare' it once.+--+-- > runErrand db (prepare listPeople)+--+-- Now that everything is set up, it is possible to execute the prepared query.+--+-- > runErrand db (query listPeople 25)+-- module Database.PostgreSQL.Store.Query.TH ( 	-- * Quasi quoters 	pgQueryGen,@@ -130,6 +153,7 @@ import           Database.PostgreSQL.Store.Entity import           Database.PostgreSQL.Store.Query.Builder import           Database.PostgreSQL.Store.Table+import           Database.PostgreSQL.Store.Tuple import           Database.PostgreSQL.Store.Utilities  -- | Name@@ -156,6 +180,7 @@ 	| QueryTable String 	| QuerySelector String 	| QuerySelectorAlias String String+	| QueryParam Word 	deriving (Show, Eq, Ord)  -- | Table@@ -179,6 +204,12 @@ 	                   <*> valueName 	                   <*  char ')' +-- | Parameter+paramSegment :: Parser QuerySegment+paramSegment = do+	char '$'+	QueryParam <$> decimal+ -- | Entity entityNameSegment :: Parser QuerySegment entityNameSegment = do@@ -237,6 +268,7 @@ 	        tableSegment, 	        selectorAliasSegment, 	        selectorSegment,+	        paramSegment, 	        entityCodeSegment, 	        entityNameSegment, 	        otherSegment]@@ -301,6 +333,23 @@  		QueryOther code -> 			[e| Code $(liftByteString (packCode code)) |]++		QueryParam idx -> do+			let accessor =+				case idx of+					0 -> [e| getElement0 |]+					1 -> [e| getElement1 |]+					2 -> [e| getElement2 |]+					3 -> [e| getElement3 |]+					4 -> [e| getElement4 |]+					5 -> [e| getElement5 |]+					6 -> [e| getElement6 |]+					7 -> [e| getElement7 |]+					8 -> [e| getElement8 |]+					9 -> [e| getElement9 |]+					_ -> fail "Cannot use more than 10 parameters with the $n short cut"++			[e| With $accessor genEntity |]  -- | Parse a query string in order to produce a 'QueryGenerator' expression. queryGenE :: String -> Q Exp

@@ -21,10 +21,8 @@ -- Maintainer: Ole Krüger <ole@vprsm.de> module Database.PostgreSQL.Store.Tuple ( 	Tuple (..),-	appendElement, -	HasElement,-	getElementN,+	HasElement (..), 	getElement0, 	getElement1, 	getElement2,@@ -36,7 +34,7 @@ 	getElement8, 	getElement9, -	FunctionType,+	Function, 	WithTuple, 	withTuple ) where@@ -47,17 +45,10 @@ import Data.List import Data.Tagged -infixl 5 |>---- | Append a single element to the end of a list.-type family (|>) (x :: [a]) (y :: a) :: [a] where-	'[]       |> y = '[y]-	(x : xs) |> y = x : (xs |> y)- -- | Generic product type data Tuple (ts :: [Type]) where-	Empty :: Tuple '[]-	Cons  :: t -> !(Tuple ts) -> Tuple (t ': ts)+	Nil  :: Tuple '[]+	Cons :: t -> !(Tuple ts) -> Tuple (t ': ts)  -- | Helper class for the @Show (Tuple ts)@ instance class ShowElement ts where@@ -77,96 +68,71 @@ -- | Helper class to extract an element from a 'Tuple'. class HasElement (n :: Nat) (ts :: [Type]) r | n ts -> r where 	-- | Extract the @n@-th element from the product.-	getElementN :: Tuple ts -> Tagged n r+	getElement :: Tuple ts -> Tagged n r  -- | Extract head element instance HasElement 0 (t ': ts) t where-	getElementN (Cons x _) = Tagged x+	getElement (Cons x _) = Tagged x -	{-# INLINE getElementN #-}+	{-# INLINE getElement #-}  -- | Extract element that is not the head instance {-# OVERLAPPABLE #-} (1 <= n, HasElement (n - 1) ts r) => HasElement n (t ': ts) r where-	getElementN (Cons _ !xs) = retag (getElementN xs :: Tagged (n - 1) r)+	getElement (Cons _ !xs) = retag (getElement xs :: Tagged (n - 1) r) -	{-# INLINE getElementN #-}+	{-# INLINE getElement #-}  -- | Extract element at index @0@. getElement0 :: Tuple (r ': ts) -> r-getElement0 p = untag (getElementN @0 p)+getElement0 p = untag (getElement @0 p)  -- | Extract element at index @1@. getElement1 :: Tuple (t0 ': r ': ts) -> r-getElement1 p = untag (getElementN @1 p)+getElement1 p = untag (getElement @1 p)  -- | Extract element at index @2@. getElement2 :: Tuple (t0 ': t1 ': r ': ts) -> r-getElement2 p = untag (getElementN @2 p)+getElement2 p = untag (getElement @2 p)  -- | Extract element at index @3@. getElement3 :: Tuple (t0 ': t1 ': t2 ': r ': ts) -> r-getElement3 p = untag (getElementN @3 p)+getElement3 p = untag (getElement @3 p)  -- | Extract element at index @4@. getElement4 :: Tuple (t0 ': t1 ': t2 ': t3 ': r ': ts) -> r-getElement4 p = untag (getElementN @4 p)+getElement4 p = untag (getElement @4 p)  -- | Extract element at index @5@. getElement5 :: Tuple (t0 ': t1 ': t2 ': t3 ': t4 ': r ': ts) -> r-getElement5 p = untag (getElementN @5 p)+getElement5 p = untag (getElement @5 p)  -- | Extract element at index @6@. getElement6 :: Tuple (t0 ': t1 ': t2 ': t3 ': t4 ': t5 ': r ': ts) -> r-getElement6 p = untag (getElementN @6 p)+getElement6 p = untag (getElement @6 p)  -- | Extract element at index @7@. getElement7 :: Tuple (t0 ': t1 ': t2 ': t3 ': t4 ': t5 ': t6 ': r ': ts) -> r-getElement7 p = untag (getElementN @7 p)+getElement7 p = untag (getElement @7 p)  -- | Extract element at index @8@. getElement8 :: Tuple (t0 ': t1 ': t2 ': t3 ': t4 ': t5 ': t6 ': t7 ': r ': ts) -> r-getElement8 p = untag (getElementN @8 p)+getElement8 p = untag (getElement @8 p)  -- | Extract element at index @9@. getElement9 :: Tuple (t0 ': t1 ': t2 ': t3 ': t4 ': t5 ': t6 ': t7 ': t8 ': r ': ts) -> r-getElement9 p = untag (getElementN @9 p)---- | Append an element to the end.-class AppendElement ts where-	appendElement :: Tuple ts -> t -> Tuple (ts |> t)---- | Append to empty product.-instance AppendElement '[] where-	appendElement = flip Cons--	{-# INLINE appendElement #-}---- | Append to non-empty product.-instance (AppendElement ts) => AppendElement (t ': ts) where-	appendElement (Cons y ys) x = Cons y (appendElement ys x)--	{-# INLINE appendElement #-}---- | Do something with a 'Tuple'.-class ConsTuple ts a r | ts r -> a where-	consTuple :: Tuple ts -> a -> r---- | Apply the given function to the current 'Tuple' state.-instance ConsTuple ts (Tuple ts -> r) r where-	consTuple state f = f state---- | Collect and append product element, then continue.-instance (AppendElement ts, ConsTuple (ts |> t) a r) => ConsTuple ts a (t -> r) where-	consTuple state val x = consTuple (appendElement state x) val+getElement9 p = untag (getElement @9 p)  -- | Build a function type using the given parameter types and return type.-type family FunctionType (ps :: [Type]) r where-	FunctionType '[]       r = r-	FunctionType (p ': ps) r = p -> FunctionType ps r+type family Function (ps :: [Type]) r where+	Function '[]       r = r+	Function (p : ps) r = p -> Function ps r --- | A value of type @r@ can be created using an instance of @Tuple ts@.-type WithTuple ts r = ConsTuple '[] (Tuple ts -> r) (FunctionType ts r)+-- | Generate a function which collects the parameters and packs then into a 'Tuple.+class WithTuple (ts :: [Type]) where+	withTuple :: (Tuple ts -> r) -> Function ts r --- | Collect values to construct a @Tuple ts@, then apply the given function to it.-withTuple :: (WithTuple ts r) => (Tuple ts -> r) -> FunctionType ts r-withTuple = consTuple Empty+instance WithTuple '[] where+	withTuple f = f Nil++instance (WithTuple ts) => WithTuple (t : ts) where+	withTuple f x = withTuple (f . Cons x)