git.iko.soy/squeal
on dev help sign in
prepared statements
f452847Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+105−29
compare with dev
unifiedsplit
@@ -9,6 +9,7 @@
9 , FlexibleInstances
9 , FlexibleInstances
10 , MagicHash
10 , MagicHash
11 , MultiParamTypeClasses
11 , MultiParamTypeClasses
12+ , OverloadedStrings
12 , RankNTypes
13 , RankNTypes
13 , ScopedTypeVariables
14 , ScopedTypeVariables
14 , TypeApplications
15 , TypeApplications
@@ -24,7 +25,10 @@ import Control.Monad.Base
24import Control.Monad.Except
25import Control.Monad.Except
25import Control.Monad.Trans.Control
26import Control.Monad.Trans.Control
26import Data.ByteString (ByteString)
27import Data.ByteString (ByteString)
28+import Data.Foldable
27import Data.Function ((&))
29import Data.Function ((&))
30+import Data.Monoid
31+import Data.Traversable
28import Generics.SOP
32import Generics.SOP
29import GHC.Exts hiding (fromList)
33import GHC.Exts hiding (fromList)
30import GHC.TypeLits
34import GHC.TypeLits
@@ -43,18 +47,18 @@ newtype PQ
43 (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
47 (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
44 (m :: * -> *)
48 (m :: * -> *)
45 (x :: *) =
49 (x :: *) =
46− PQ { unPQ :: Connection schema0 -> m (x, Connection schema1) }
50+ PQ { runPQ :: Connection schema0 -> m (x, Connection schema1) }
47 deriving Functor
51 deriving Functor
48
52
49−evalPQ :: Functor m => Connection schema0 -> PQ schema0 schema1 m x -> m x
53+evalPQ :: Functor m => PQ schema0 schema1 m x -> Connection schema0 -> m x
50−evalPQ conn (PQ pq) = fmap fst $ pq conn
54+evalPQ (PQ pq) = fmap fst . pq
51
55
52−runPQ
56+execPQ
53 :: Functor m
57 :: Functor m
54− => Connection schema0
55− -> PQ schema0 schema1 m x
58+ => PQ schema0 schema1 m x
59+ -> Connection schema0
56 -> m (Connection schema1)
60 -> m (Connection schema1)
57−runPQ conn (PQ pq) = fmap snd $ pq conn
61+execPQ (PQ pq) = fmap snd . pq
58
62
59pqAp
63pqAp
60 :: Monad m
64 :: Monad m
@@ -73,7 +77,7 @@ pqBind
73 -> PQ schema0 schema2 m y
77 -> PQ schema0 schema2 m y
74pqBind f (PQ x) = PQ $ \ conn -> do
78pqBind f (PQ x) = PQ $ \ conn -> do
75 (x', conn') <- x conn
79 (x', conn') <- x conn
76− unPQ (f x') conn'
80+ runPQ (f x') conn'
77
81
78pqThen
82pqThen
79 :: Monad m
83 :: Monad m
@@ -82,44 +86,116 @@ pqThen
82 -> PQ schema0 schema2 m y
86 -> PQ schema0 schema2 m y
83pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
87pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
84
88
85−pqExec
89+define
86 :: MonadBase IO io
90 :: MonadBase IO io
87 => Definition schema0 schema1
91 => Definition schema0 schema1
88 -> PQ schema0 schema1 io (Maybe (Result '[]))
92 -> PQ schema0 schema1 io (Maybe (Result '[]))
89−pqExec (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
93+define (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
90 result <- liftBase $ LibPQ.exec conn q
94 result <- liftBase $ LibPQ.exec conn q
91 return (Result <$> result, Connection conn)
95 return (Result <$> result, Connection conn)
92
96
93−pqThenExec
97+pqThenDefine
94 :: MonadBase IO io
98 :: MonadBase IO io
95 => Definition schema1 schema2
99 => Definition schema1 schema2
96 -> PQ schema0 schema1 io x
100 -> PQ schema0 schema1 io x
97 -> PQ schema0 schema2 io (Maybe (Result '[]))
101 -> PQ schema0 schema2 io (Maybe (Result '[]))
98−pqThenExec = pqThen . pqExec
102+pqThenDefine = pqThen . define
99
103
100−class Monad m => MonadPQ schema m | m -> schema where
104+class Monad pq => MonadPQ schema pq | pq -> schema where
101
105
102− pqExecParams
106+ manipulateParams
103 :: ToParams x params
107 :: ToParams x params
104− => Manipulation schema params ys -> x -> m (Maybe (Result ys))
108+ => Manipulation schema params ys -> x -> pq (Maybe (Result ys))
105− default pqExecParams
109+ default manipulateParams
106− :: (MonadTrans t, MonadPQ schema m1, m ~ t m1)
110+ :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
107 => ToParams x params
111 => ToParams x params
108− => Manipulation schema params ys -> x -> m (Maybe (Result ys))
112+ => Manipulation schema params ys -> x -> pq (Maybe (Result ys))
109− pqExecParams manipulation params = lift $ pqExecParams manipulation params
113+ manipulateParams manipulation params = lift $
114+ manipulateParams manipulation params
115+
116+ manipulate :: Manipulation schema '[] ys -> pq (Maybe (Result ys))
117+ manipulate statement = manipulateParams statement ()
110
118
119+ queryParams
120+ :: ToParams x params
121+ => Query schema params ys -> x -> pq (Maybe (Result ys))
122+ queryParams = manipulateParams . queryStatement
123+
111− pqExecNil :: Manipulation schema '[] ys -> m (Maybe (Result ys))
124+ query :: Query schema '[] ys -> pq (Maybe (Result ys))
112− pqExecNil statement = pqExecParams statement ()
125+ query q = queryParams q ()
126+
127+ traversePrepared
128+ :: (ToParams x params, Traversable list)
129+ => Manipulation schema params ys -> list x -> pq (list (Maybe (Result ys)))
130+ default traversePrepared
131+ :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
132+ => (ToParams x params, Traversable list)
133+ => Manipulation schema params ys -> list x -> pq (list (Maybe (Result ys)))
134+ traversePrepared manipulation params = lift $
135+ traversePrepared manipulation params
136+
137+ forPrepared
138+ :: (ToParams x params, Traversable list)
139+ => list x -> Manipulation schema params ys -> pq (list (Maybe (Result ys)))
140+ forPrepared = flip traversePrepared
141+
142+ traversePrepared_
143+ :: (ToParams x params, Foldable list)
144+ => Manipulation schema params ys -> list x -> pq ()
145+ default traversePrepared_
146+ :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
147+ => (ToParams x params, Foldable list)
148+ => Manipulation schema params ys -> list x -> pq ()
149+ traversePrepared_ manipulation params = lift $
150+ traversePrepared_ manipulation params
151+
152+ forPrepared_
153+ :: (ToParams x params, Traversable list)
154+ => list x -> Manipulation schema params ys -> pq ()
155+ forPrepared_ = flip traversePrepared_
113
156
114instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
157instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
115
158
159+ manipulateParams
116− pqExecParams (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =
160+ (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =
117− PQ $ \ (Connection conn) -> do
161+ PQ $ \ (Connection conn) -> do
118− let
162+ let
119− toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)
163+ toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)
120− params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))
164+ params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))
121− result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
165+ result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
166+ return (Result <$> result, Connection conn)
167+
168+ traversePrepared
169+ (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
170+ PQ $ \ (Connection conn) -> do
171+ let temp = "temporary_statement"
172+ _prepResult <- liftBase $ LibPQ.prepare conn temp q Nothing
173+ results <- for list $ \ params -> do
174+ let
175+ toParam' bytes = (bytes,LibPQ.Binary)
176+ params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))
177+ result <- liftBase $
178+ LibPQ.execPrepared conn temp params' LibPQ.Binary
179+ return $ Result <$> result
180+ _deallocResult <- liftBase $
181+ LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
182+ return (results, Connection conn)
183+
184+ traversePrepared_
185+ (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
186+ PQ $ \ (Connection conn) -> do
187+ let temp = "temporary_statement"
188+ _prepResult <- liftBase $ LibPQ.prepare conn temp q Nothing
189+ for_ list $ \ params -> do
190+ let
191+ toParam' bytes = (bytes,LibPQ.Binary)
192+ params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))
193+ _result <- liftBase $
194+ LibPQ.execPrepared conn temp params' LibPQ.Binary
195+ return ()
196+ _deallocResult <- liftBase $
197+ LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
122− return (Result <$> result, Connection conn)
198+ return ((), Connection conn)
123
199
124instance Monad m => Applicative (PQ schema schema m) where
200instance Monad m => Applicative (PQ schema schema m) where
125 pure x = PQ $ \ conn -> pure (x, conn)
201 pure x = PQ $ \ conn -> pure (x, conn)
@@ -142,7 +218,7 @@ type PQRun schema =
142
218
143pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
219pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
144pqliftWith f = PQ $ \ conn ->
220pqliftWith f = PQ $ \ conn ->
145− fmap (\ x -> (x, conn)) (f $ \ pq -> unPQ pq conn)
221+ fmap (\ x -> (x, conn)) (f $ \ pq -> runPQ pq conn)
146
222
147instance MonadBaseControl b m => MonadBaseControl b (PQ schema schema m) where
223instance MonadBaseControl b m => MonadBaseControl b (PQ schema schema m) where
148 type StM (PQ schema schema m) x = StM m (x, Connection schema)
224 type StM (PQ schema schema m) x = StM m (x, Connection schema)
squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+2−2
@@ -883,10 +883,10 @@ newtype Query
883 (columns :: [(Symbol,ColumnType)])
883 (columns :: [(Symbol,ColumnType)])
884 = UnsafeQuery { renderQuery :: ByteString }
884 = UnsafeQuery { renderQuery :: ByteString }
885
885
886−query
886+queryStatement
887 :: Query schema params columns
887 :: Query schema params columns
888 -> Manipulation schema params columns
888 -> Manipulation schema params columns
889−query q = UnsafeManipulation $ renderQuery q <> ";"
889+queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
890
890
891union, unionAll, intersect, intersectAll, except, exceptAll
891union, unionAll, intersect, intersectAll, except, exceptAll
892 :: Query schema params columns
892 :: Query schema params columns