@@ -1,8 +1,11 @@
11{-# LANGUAGE
22 DataKinds
3+ , FlexibleContexts
34 , PolyKinds
5+ , RecordWildCards
46 , ScopedTypeVariables
57 , TypeApplications
8+ , TypeFamilies
69 , TypeOperators
710#-}
811
@@ -12,11 +15,14 @@ import Control.Monad.IO.Class
1215import Data.ByteString (ByteString)
1316import Data.Proxy
1417import Data.Text (Text)
18+import Data.Vinyl
19+import Data.Vinyl.Functor
1520
1621import qualified Database.PostgreSQL.LibPQ as LibPQ
1722
1823import Squeel.PostgreSQL.Query
1924import Squeel.PostgreSQL.Value
25+import Squeel.PostgreSQL.Type
2026
2127newtype Connection db = Connection { unConnection :: LibPQ.Connection }
2228
@@ -37,27 +43,54 @@ finish = liftIO . LibPQ.finish . unConnection
3743
3844newtype Result xs = Result { unResult :: LibPQ.Result }
3945
40−exec :: MonadIO io => Query db0 db1 '[] xs -> PQ io db0 db1 (Result xs)
41−exec = undefined
42−
43−type family To xs y where
44− To '[] y = y
45− To (x ': xs) y = To x (To xs y)
46+exec
47+ :: MonadIO io
48+ => Query db0 db1 '[] xs
49+ -> PQ io db0 db1 (Maybe (Result xs))
50+exec (Query q) = PQ $ \ (Connection conn) -> do
51+ result <- liftIO $ LibPQ.exec conn q
52+ return (Result <$> result, Connection conn)
4653
4754execParams
48− :: (MonadIO io, ToParameters xs ps)
49− => Connection db0
50− -> Query db0 db1 ps ys
51− -> xs `To` PQ io db0 db1 (Result ys)
52−execParams = undefined
55+ :: (MonadIO io, ToValues xs ps, ToOids ps)
56+ => Query db0 db1 ps ys
57+ -> Rec Identity xs
58+ -> PQ io db0 db1 (Maybe (Result ys))
59+execParams (Query q :: Query db0 db1 ps ys) params =
60+ PQ $ \ (Connection conn) -> do
61+ let
62+ params' =
63+ [ Just (oid, param, LibPQ.Binary)
64+ | (oid, param) <-
65+ zip (toOids (Proxy @ps)) (toValues (Proxy @ps) params)
66+ ]
67+ result <- liftIO $ LibPQ.execParams conn q params' LibPQ.Binary
68+ return (Result <$> result, Connection conn)
5369
5470prepare
55− :: MonadIO io
56− => Connection db0
57− -> ByteString
71+ :: (MonadIO io, ToOids ps)
72+ => ByteString
5873 -> Query db0 db1 ps xs
59− -> io (PreparedQuery db0 db1 ps xs)
60−prepare = undefined
74+ -> PQ io db0 db0 (Maybe (Result []), PreparedQuery db0 db1 ps xs)
75+prepare statementName (Query q :: Query db0 db1 ps ys) =
76+ PQ $ \ (Connection conn) -> do
77+ result <- liftIO $
78+ LibPQ.prepare conn statementName q (Just (toOids (Proxy @ps)))
79+ return ((Result <$> result,PreparedQuery statementName), Connection conn)
80+
81+execPrepared
82+ :: (MonadIO io, ToValues xs ps)
83+ => PreparedQuery db0 db1 ps ys
84+ -> Rec Identity xs
85+ -> PQ io db0 db1 (Maybe (Result ys))
86+execPrepared (PreparedQuery q :: PreparedQuery db0 db1 ps ys) params =
87+ PQ $ \ (Connection conn) -> do
88+ let
89+ params' =
90+ [Just (param, LibPQ.Binary) | param <- toValues (Proxy @ps) params]
91+ result <- liftIO $
92+ LibPQ.execPrepared conn q params' LibPQ.Binary
93+ return (Result <$> result, Connection conn)
6194
6295newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
6396