git.iko.soy/squeal
on dev help sign in
query execution functions
ec4c436Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+49−16
compare with dev
unifiedsplit
@@ -1,8 +1,11 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 DataKinds
2 DataKinds
3+ , FlexibleContexts
3 , PolyKinds
4 , PolyKinds
5+ , RecordWildCards
4 , ScopedTypeVariables
6 , ScopedTypeVariables
5 , TypeApplications
7 , TypeApplications
8+ , TypeFamilies
6 , TypeOperators
9 , TypeOperators
7#-}
10#-}
8
11
@@ -12,11 +15,14 @@ import Control.Monad.IO.Class
12import Data.ByteString (ByteString)
15import Data.ByteString (ByteString)
13import Data.Proxy
16import Data.Proxy
14import Data.Text (Text)
17import Data.Text (Text)
18+import Data.Vinyl
19+import Data.Vinyl.Functor
15
20
16import qualified Database.PostgreSQL.LibPQ as LibPQ
21import qualified Database.PostgreSQL.LibPQ as LibPQ
17
22
18import Squeel.PostgreSQL.Query
23import Squeel.PostgreSQL.Query
19import Squeel.PostgreSQL.Value
24import Squeel.PostgreSQL.Value
25+import Squeel.PostgreSQL.Type
20
26
21newtype Connection db = Connection { unConnection :: LibPQ.Connection }
27newtype Connection db = Connection { unConnection :: LibPQ.Connection }
22
28
@@ -37,27 +43,54 @@ finish = liftIO . LibPQ.finish . unConnection
37
43
38newtype Result xs = Result { unResult :: LibPQ.Result }
44newtype Result xs = Result { unResult :: LibPQ.Result }
39
45
46+exec
47+ :: MonadIO io
48+ => Query db0 db1 '[] xs
40−exec :: MonadIO io => Query db0 db1 '[] xs -> PQ io db0 db1 (Result xs)
49+ -> PQ io db0 db1 (Maybe (Result xs))
41−exec = undefined
50+exec (Query q) = PQ $ \ (Connection conn) -> do
42−
51+ result <- liftIO $ LibPQ.exec conn q
43−type family To xs y where
52+ return (Result <$> result, Connection conn)
44− To '[] y = y
45− To (x ': xs) y = To x (To xs y)
46
53
47execParams
54execParams
48− :: (MonadIO io, ToParameters xs ps)
55+ :: (MonadIO io, ToValues xs ps, ToOids ps)
49− => Connection db0
50− -> Query db0 db1 ps ys
56+ => Query db0 db1 ps ys
57+ -> Rec Identity xs
51− -> xs `To` PQ io db0 db1 (Result ys)
58+ -> PQ io db0 db1 (Maybe (Result ys))
52−execParams = undefined
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)
53
69
54prepare
70prepare
55− :: MonadIO io
71+ :: (MonadIO io, ToOids ps)
56− => Connection db0
57− -> ByteString
72+ => ByteString
58 -> Query db0 db1 ps xs
73 -> Query db0 db1 ps xs
59− -> io (PreparedQuery db0 db1 ps xs)
74+ -> PQ io db0 db0 (Maybe (Result []), PreparedQuery db0 db1 ps xs)
60−prepare = undefined
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)
61
94
62newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
95newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
63
96
squeel-postgresql/src/Squeel/PostgreSQL/Type.hs+14
@@ -1,11 +1,16 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 DataKinds
2 DataKinds
3+ , PolyKinds
4+ , ScopedTypeVariables
5+ , TypeApplications
3 , TypeFamilies
6 , TypeFamilies
4 , TypeOperators
7 , TypeOperators
5#-}
8#-}
6
9
7module Squeel.PostgreSQL.Type where
10module Squeel.PostgreSQL.Type where
8
11
12+import Data.Proxy
13+import qualified Database.PostgreSQL.LibPQ as LibPQ
9import GHC.TypeLits
14import GHC.TypeLits
10
15
11newtype PGType = PGType Symbol
16newtype PGType = PGType Symbol
@@ -40,3 +45,12 @@ type family DatabaseTables database where
40
45
41type family SchemaDatabases schema where
46type family SchemaDatabases schema where
42 SchemaDatabases ('Schema schema databases) = databases
47 SchemaDatabases ('Schema schema databases) = databases
48+
49+class ToOid pg where
50+ toOid :: Proxy pg -> LibPQ.Oid
51+
52+class ToOids pgs where
53+ toOids :: Proxy pgs -> [LibPQ.Oid]
54+instance ToOids '[] where toOids _ = []
55+instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
56+ toOids (_ :: Proxy (pg ': pgs)) = toOid (Proxy @pg) : toOids (Proxy @pgs)
squeel-postgresql/src/Squeel/PostgreSQL/Value.hs+18−5
@@ -1,8 +1,14 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 DataKinds
2 DataKinds
3 , FlexibleInstances
3 , FlexibleInstances
4+ , FunctionalDependencies
4 , KindSignatures
5 , KindSignatures
5 , MultiParamTypeClasses
6 , MultiParamTypeClasses
7+ , PolyKinds
8+ , ScopedTypeVariables
9+ , TypeApplications
10+ , TypeFamilies
11+ , TypeOperators
6#-}
12#-}
7
13
8module Squeel.PostgreSQL.Value where
14module Squeel.PostgreSQL.Value where
@@ -11,10 +17,13 @@ import Control.Arrow (left)
11import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
17import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
12import Data.Bits (Bits)
18import Data.Bits (Bits)
13import Data.ByteString (ByteString)
19import Data.ByteString (ByteString)
20+import Data.ByteString.Builder
14import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
21import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
15import Data.Int (Int16,Int32,Int64)
22import Data.Int (Int16,Int32,Int64)
23+import Data.Proxy
24+import Data.Vinyl
25+import Data.Vinyl.Functor
16import PostgreSQL.Binary.Decoder (Decoder)
26import PostgreSQL.Binary.Decoder (Decoder)
17−import PostgreSQL.Binary.Encoder (Encoder)
18import qualified PostgreSQL.Binary.Decoder as Decoder
27import qualified PostgreSQL.Binary.Decoder as Decoder
19import qualified PostgreSQL.Binary.Encoder as Encoder
28import qualified PostgreSQL.Binary.Encoder as Encoder
20import Data.Proxy (Proxy)
29import Data.Proxy (Proxy)
@@ -73,7 +82,7 @@ instance FromValue ('PGType "interval") DiffTime where
73 fromValue _ = Decoder.interval_int
82 fromValue _ = Decoder.interval_int
74
83
75class ToValue x (pg :: PGType) where
84class ToValue x (pg :: PGType) where
76− toValue :: Proxy pg -> Encoder x
85+ toValue :: Proxy pg -> x -> Builder
77instance ToValue Int16 ('PGType "int2") where
86instance ToValue Int16 ('PGType "int2") where
78 toValue _ = Encoder.int2_int16
87 toValue _ = Encoder.int2_int16
79instance ToValue Int32 ('PGType "int4") where
88instance ToValue Int32 ('PGType "int4") where
@@ -123,6 +132,10 @@ instance ToValue UTCTime ('PGType "timestamptz") where
123instance ToValue DiffTime ('PGType "interval") where
132instance ToValue DiffTime ('PGType "interval") where
124 toValue _ = Encoder.interval_int
133 toValue _ = Encoder.interval_int
125
134
126−type family ToParameters ps xs where
135+class ToValues xs pgs where
127− ToParameters '[] '[] = ()
136+ toValues :: Proxy pgs -> Rec Identity xs -> [ByteString]
128− ToParameters (x ': xs) (p ': ps) = (ToValue x p, ToParameters xs ps)
137+instance ToValues '[] '[] where toValues _ _ = []
138+instance (ToValue x pg, ToValues xs pgs)
139+ => ToValues (x ': xs) (pg ': pgs) where
140+ toValues (_ :: Proxy (pg ': pgs)) (Identity x :& xs) =
141+ Encoder.run (toValue (Proxy @pg)) x : toValues (Proxy @pgs) xs