git.iko.soy/squeal
on dev help sign in
Merge pull request #26 from echatav/prepare
d6e6130Eitan Chatav
squeel-postgresql/exe/Example.hs+15−11
compare with dev
unifiedsplit
@@ -27,18 +27,22 @@ main = do
27 connectionString <- pure
27 connectionString <- pure
28 "host=localhost port=5432 dbname=exampledb"
28 "host=localhost port=5432 dbname=exampledb"
29 Char8.putStrLn $ "connecting to " <> connectionString
29 Char8.putStrLn $ "connecting to " <> connectionString
30− connection0 <- connectdb connectionString
30+ connection0 :: Connection '[] <- connectdb connectionString
31 Char8.putStrLn "setting up database"
31 Char8.putStrLn "setting up database"
32 connection1 <- flip execPQ connection0 $
32 connection1 <- flip execPQ connection0 $
33+ pqExec
33− pqExec ( createTable #students
34+ ( createTable #students
34− ( (text & notNull) `As` #name
35+ ( (text & notNull) `As` #name
35− :* Nil ) )
36+ :* Nil ) )
37+ & pqThenExec
36− &>> createTable #table1
38+ ( createTable #table1
37− ( (int4 & notNull) `As` #col1
39+ ( (int4 & notNull) `As` #col1
38− :* (int4 & notNull) `As` #col2
40+ :* (int4 & notNull) `As` #col2
39− :* Nil )
41+ :* Nil ) )
42+ & pqThenExec
40− &>> insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )
43+ ( insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil ) )
44+ & pqThenExec
41− &>> insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )
45+ ( insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil ) )
42 Char8.putStrLn "querying"
46 Char8.putStrLn "querying"
43 connection2 <- flip execPQ connection1 $ do
47 connection2 <- flip execPQ connection1 $ do
44 Just result <- pqExecNil $ select $ starFrom #table1
48 Just result <- pqExecNil $ select $ starFrom #table1
@@ -59,7 +63,7 @@ main = do
59 Char8.putStrLn "tearing down database"
63 Char8.putStrLn "tearing down database"
60 connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec
64 connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec
61 (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])
65 (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])
62− &>> dropTable #students
66+ & pqThenExec (dropTable #students)
63 finish connection3
67 finish connection3
64
68
65type Columns =
69type Columns =
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+54−35
@@ -24,6 +24,7 @@ import Control.Monad.Except
24import Control.Monad.Trans.Maybe
24import Control.Monad.Trans.Maybe
25import Control.Monad.Trans.Control
25import Control.Monad.Trans.Control
26import Data.ByteString (ByteString)
26import Data.ByteString (ByteString)
27+import Data.Function ((&))
27import Data.Maybe
28import Data.Maybe
28import Data.Proxy (Proxy)
29import Data.Proxy (Proxy)
29import Data.Text (Text)
30import Data.Text (Text)
@@ -53,7 +54,7 @@ evalPQ (PQ pq) = fmap fst . pq
53execPQ :: Functor m => PQ db0 db1 m x -> Connection db0 -> m (Connection db1)
54execPQ :: Functor m => PQ db0 db1 m x -> Connection db0 -> m (Connection db1)
54execPQ (PQ pq) = fmap snd . pq
55execPQ (PQ pq) = fmap snd . pq
55
56
56−class MonadPQ pq where
57+class AtkeyPQ pq where
57
58
58 pqAp
59 pqAp
59 :: Monad m
60 :: Monad m
@@ -67,43 +68,59 @@ class MonadPQ pq where
67 -> pq db0 db1 m x
68 -> pq db0 db1 m x
68 -> pq db0 db2 m y
69 -> pq db0 db2 m y
69
70
71+ pqThen
72+ :: Monad m
73+ => pq db1 db2 m y
74+ -> pq db0 db1 m x
75+ -> pq db0 db2 m y
76+ pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
77+
70 pqExec
78 pqExec
71 :: MonadBase IO io
79 :: MonadBase IO io
72 => Statement '[] '[] db0 db1
80 => Statement '[] '[] db0 db1
73 -> pq db0 db1 io (Maybe (Result '[]))
81 -> pq db0 db1 io (Maybe (Result '[]))
74
82
83+ pqThenExec
84+ :: MonadBase IO io
85+ => Statement '[] '[] db1 db2
86+ -> pq db0 db1 io x
87+ -> pq db0 db2 io (Maybe (Result '[]))
88+ pqThenExec = pqThen . pqExec
89+
90+ -- pqPrepare
91+ -- :: (MonadBase IO io, ToOids ps)
92+ -- => ByteString
93+ -- -> Statement ps xs db0 db1
94+ -- -> pq db0 db1 io (Maybe (Result '[]), PreparedStatement ps xs db0 db1)
95+
96+ -- pqThenPrepare
97+ -- :: MonadBase IO io
98+ -- => ByteString
99+ -- -> Statement ps xs schema0 schema1
100+ -- -> pq db0 db1 io x
101+ -- -> pq db1 db1 io (Maybe (Result '[]), PreparedStatement ps xs schema0 schema1)
102+ -- pqThenPrepare name st pq = pqThen (pqPrepare name st) pq
103+
104+class MonadPQ db m | m -> db where
105+
75 pqExecParams
106 pqExecParams
76− :: (MonadBase IO io, ToOids ps, AllZip HasEncoding ps xs)
107+ :: (ToOids ps, AllZip HasEncoding ps xs)
77− => Statement ps ys db0 db1
108+ => Statement ps ys db db
78 -> NP I xs
109 -> NP I xs
79− -> pq db0 db1 io (Maybe (Result ys))
110+ -> m (Maybe (Result ys))
80
111
81− pqPrepare
112+ pqExecNil
82− :: (MonadBase IO io, ToOids ps)
83− => ByteString
84− -> Statement ps xs db0 db1
113+ :: Statement '[] ys db db
85− -> pq db0 db1 io (Maybe (Result '[]), PreparedStatement ps xs db0 db1)
114+ -> m (Maybe (Result ys))
115+ pqExecNil statement = pqExecParams statement Nil
86
116
87 pqExecPrepared
117 pqExecPrepared
88− :: (MonadBase IO io, AllZip HasEncoding ps xs)
118+ :: AllZip HasEncoding ps xs
89− => PreparedStatement ps ys db0 db1
119+ => PreparedStatement ps ys db db
90 -> NP I xs
120 -> NP I xs
91− -> pq db0 db1 io (Maybe (Result ys))
121+ -> m (Maybe (Result ys))
92−
93−(&>>)
94− :: (MonadPQ pq, MonadBase IO io)
95− => pq db0 db1 io (Maybe (Result '[]))
96− -> Statement '[] '[] db1 db2
97− -> pq db0 db2 io (Maybe (Result '[]))
98−pq1 &>> statement2 = pqBind (\ _ -> pqExec statement2) pq1
99
122
100−pqExecNil
101− :: (MonadPQ pq, MonadBase IO io)
102− => Statement '[] ys db0 db1
103− -> pq db0 db1 io (Maybe (Result ys))
104−pqExecNil statement = pqExecParams statement Nil
105−
106−instance MonadPQ PQ where
123+instance AtkeyPQ PQ where
107
124
108 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
125 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
109 (f', conn') <- f conn
126 (f', conn') <- f conn
@@ -118,6 +135,17 @@ instance MonadPQ PQ where
118 result <- liftBase $ LibPQ.exec conn q
135 result <- liftBase $ LibPQ.exec conn q
119 return (Result <$> result, Connection conn)
136 return (Result <$> result, Connection conn)
120
137
138+ -- pqPrepare statementName (UnsafeStatement q :: Statement ps ys db0 db1) =
139+ -- PQ $ \ (Connection conn) -> do
140+ -- result <- liftBase $
141+ -- LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))
142+ -- return
143+ -- ( ( Result <$> result
144+ -- , UnsafePreparedStatement statementName
145+ -- ) , Connection conn )
146+
147+instance MonadBase IO io => MonadPQ db (PQ db db io) where
148+
121 pqExecParams (UnsafeStatement q :: Statement ps ys db0 db1) params =
149 pqExecParams (UnsafeStatement q :: Statement ps ys db0 db1) params =
122 PQ $ \ (Connection conn) -> do
150 PQ $ \ (Connection conn) -> do
123 let
151 let
@@ -130,15 +158,6 @@ instance MonadPQ PQ where
130 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
158 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
131 return (Result <$> result, Connection conn)
159 return (Result <$> result, Connection conn)
132
160
133− pqPrepare statementName (UnsafeStatement q :: Statement ps ys db0 db1) =
134− PQ $ \ (Connection conn) -> do
135− result <- liftBase $
136− LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))
137− return
138− ( ( Result <$> result
139− , UnsafePreparedStatement statementName
140− ) , Connection conn )
141−
142 pqExecPrepared (q :: PreparedStatement ps ys db0 db1) params =
161 pqExecPrepared (q :: PreparedStatement ps ys db0 db1) params =
143 PQ $ \ (Connection conn) -> do
162 PQ $ \ (Connection conn) -> do
144 let
163 let