git.iko.soy/squeal
on dev help sign in
small things
b3f944cEitan Chatav
squeel-postgresql/exe/Example.hs+37−22
compare with dev
unifiedsplit
@@ -3,15 +3,18 @@
3 , MagicHash
3 , MagicHash
4 , OverloadedLabels
4 , OverloadedLabels
5 , OverloadedStrings
5 , OverloadedStrings
6+ , ScopedTypeVariables
6 , TypeOperators
7 , TypeOperators
7#-}
8#-}
8
9
9module Main (main) where
10module Main (main) where
10
11
11import Control.Category ((>>>))
12import Control.Category ((>>>))
12−-- import Control.Monad.Base
13+import Control.Monad.Base
14+import Control.Monad.Except
15+import Control.Monad.Trans.Maybe
13import Data.Function ((&))
16import Data.Function ((&))
14−-- import Data.Int
17+import Data.Int
15import Data.Monoid
18import Data.Monoid
16import Generics.SOP
19import Generics.SOP
17import Squeel.PostgreSQL
20import Squeel.PostgreSQL
@@ -40,27 +43,39 @@ main = do
40 insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )
43 insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )
41 >>>
44 >>>
42 insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )
45 insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )
43− -- Just selectTable1Result <- flip pqExecParams Nil $
46+ Just selectTable1Result <- flip pqExecParams Nil $
44− -- (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
47+ (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
45− -- Just (Right value00) <- getvalue selectTable1Result (RowNumber 0) colNum0
48+ Just (Right value00) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
49+ getValue (RowNumber 0) colNum0
46− -- Just (Right value01) <- getvalue selectTable1Result (RowNumber 0) colNum1
50+ Just (Right value01) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
51+ getValue (RowNumber 0) colNum1
47− -- Just (Right value10) <- getvalue selectTable1Result (RowNumber 1) colNum0
52+ Just (Right value10) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
53+ getValue (RowNumber 1) colNum0
48− -- Just (Right value11) <- getvalue selectTable1Result (RowNumber 1) colNum1
54+ Just (Right value11) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
55+ getValue (RowNumber 1) colNum1
56+ Just (Right row0) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
57+ getRow (RowNumber 0)
58+ Just (Right row1) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
59+ getRow (RowNumber 1)
49− -- liftBase $ do
60+ liftBase $ do
50− -- print (value00 :: Int32)
61+ print (value00 :: Int32)
51− -- print (value01 :: Int32)
62+ print (value01 :: Int32)
52− -- print (value10 :: Int32)
63+ print (value10 :: Int32)
53− -- print (value11 :: Int32)
64+ print (value11 :: Int32)
54− return ()
65+ print (row0 :: NP I '[Int32,Int32])
55− finish connection2
66+ print (row1 :: NP I '[Int32,Int32])
56−--
67+ connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec $
68+ (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])
69+ >>> dropTable #students
70+ finish connection3
71+
57−-- type Columns =
72+type Columns =
58−-- '[ "col1" ::: 'Required ('NotNull 'PGInt4)
73+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
59−-- , "col2" ::: 'Required ('NotNull 'PGInt4)
74+ , "col2" ::: 'Required ('NotNull 'PGInt4)
60−-- ]
75+ ]
61-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
76-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
62−-- type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
77+type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
63−-- type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]
78+type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]
64-- type OrderColumns =
79-- type OrderColumns =
65-- [ "orderID" ::: 'NotNull 'PGInt4
80-- [ "orderID" ::: 'NotNull 'PGInt4
66-- , "orderVal" ::: 'NotNull 'PGText
81-- , "orderVal" ::: 'NotNull 'PGText
squeel-postgresql/squeel-postgresql.cabal+2
@@ -63,7 +63,9 @@ executable squeel-postgresql-example
63 base
63 base
64 , bytestring
64 , bytestring
65 , generics-sop
65 , generics-sop
66+ , mtl
66 , squeel-postgresql
67 , squeel-postgresql
68+ , transformers
67 , transformers-base
69 , transformers-base
68
70
69source-repository head
71source-repository head
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+50−55
@@ -13,21 +13,16 @@
13
13
14module Squeel.PostgreSQL.Binary where
14module Squeel.PostgreSQL.Binary where
15
15
16−import Control.Arrow (left)
17−import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
18import Data.ByteString (ByteString)
16import Data.ByteString (ByteString)
19import Data.Int (Int16,Int32,Int64)
17import Data.Int (Int16,Int32,Int64)
20import Generics.SOP
18import Generics.SOP
21−-- import GHC.Generics
22−-- import PostgreSQL.Binary.Decoding
23import Data.Scientific (Scientific)
19import Data.Scientific (Scientific)
24import Data.Text (Text)
20import Data.Text (Text)
25import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
21import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
26import Data.UUID (UUID)
22import Data.UUID (UUID)
27−-- import GHC.Exts
28
23
29−import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
24+import qualified Data.Aeson as Aeson
30−import qualified Data.Text as Text (pack)
25+import qualified Data.ByteString.Lazy as Lazy (ByteString)
31import qualified Data.Text.Lazy as Lazy (Text)
26import qualified Data.Text.Lazy as Lazy (Text)
32import qualified PostgreSQL.Binary.Decoding as Decoder
27import qualified PostgreSQL.Binary.Decoding as Decoder
33import qualified PostgreSQL.Binary.Encoding as Encoder
28import qualified PostgreSQL.Binary.Encoding as Encoder
@@ -39,47 +34,47 @@ decodeValue p = Decoder.valueParser $ decoding p
39
34
40class HasDecoding pg x where
35class HasDecoding pg x where
41 decoding :: proxy pg -> Decoder.Value x
36 decoding :: proxy pg -> Decoder.Value x
42−instance HasDecoding 'PGInt2 Int16 where
37+instance HasDecoding (column ::: 'Required ('NotNull 'PGInt2)) Int16 where
43 decoding _ = Decoder.int
38 decoding _ = Decoder.int
44−instance HasDecoding 'PGInt4 Int32 where
39+instance HasDecoding (column ::: 'Required ('NotNull 'PGInt4)) Int32 where
45 decoding _ = Decoder.int
40 decoding _ = Decoder.int
46−instance HasDecoding 'PGInt8 Int64 where
41+instance HasDecoding (column ::: 'Required ('NotNull 'PGInt8)) Int64 where
47 decoding _ = Decoder.int
42 decoding _ = Decoder.int
48−instance HasDecoding 'PGFloat4 Float where
43+instance HasDecoding (column ::: 'Required ('NotNull 'PGFloat4)) Float where
49 decoding _ = Decoder.float4
44 decoding _ = Decoder.float4
50−instance HasDecoding 'PGFloat8 Double where
45+instance HasDecoding (column ::: 'Required ('NotNull 'PGFloat8)) Double where
51 decoding _ = Decoder.float8
46 decoding _ = Decoder.float8
52−instance HasDecoding 'PGBool Bool where
47+instance HasDecoding (column ::: 'Required ('NotNull 'PGBool)) Bool where
53 decoding _ = Decoder.bool
48 decoding _ = Decoder.bool
54−instance HasDecoding 'PGBytea ByteString where
49+instance HasDecoding (column ::: 'Required ('NotNull 'PGBytea)) ByteString where
55 decoding _ = Decoder.bytea_strict
50 decoding _ = Decoder.bytea_strict
56−instance HasDecoding 'PGBytea Lazy.ByteString where
51+instance HasDecoding (column ::: 'Required ('NotNull 'PGBytea)) Lazy.ByteString where
57 decoding _ = Decoder.bytea_lazy
52 decoding _ = Decoder.bytea_lazy
58−instance HasDecoding 'PGText Text where
53+instance HasDecoding (column ::: 'Required ('NotNull 'PGText)) Text where
59 decoding _ = Decoder.text_strict
54 decoding _ = Decoder.text_strict
60−instance HasDecoding 'PGText Lazy.Text where
55+instance HasDecoding (column ::: 'Required ('NotNull 'PGText)) Lazy.Text where
61 decoding _ = Decoder.text_lazy
56 decoding _ = Decoder.text_lazy
62−instance HasDecoding ('PGChar 1) Char where
57+instance HasDecoding (column ::: 'Required ('NotNull ('PGChar 1))) Char where
63 decoding _ = Decoder.char
58 decoding _ = Decoder.char
64−instance HasDecoding 'PGNumeric Scientific where
59+instance HasDecoding (column ::: 'Required ('NotNull 'PGNumeric)) Scientific where
65 decoding _ = Decoder.numeric
60 decoding _ = Decoder.numeric
66−instance HasDecoding 'PGUuid UUID where
61+instance HasDecoding (column ::: 'Required ('NotNull 'PGUuid)) UUID where
67 decoding _ = Decoder.uuid
62 decoding _ = Decoder.uuid
68−instance FromJSON x => HasDecoding 'PGJson x where
63+instance HasDecoding (column ::: 'Required ('NotNull 'PGJson)) Aeson.Value where
69− decoding _ = Decoder.json_bytes (left Text.pack . eitherDecodeStrict)
64+ decoding _ = Decoder.json_ast
70−instance FromJSON x => HasDecoding 'PGJsonb x where
65+instance HasDecoding (column ::: 'Required ('NotNull 'PGJsonb)) Aeson.Value where
71− decoding _ = Decoder.jsonb_bytes (left Text.pack . eitherDecodeStrict)
66+ decoding _ = Decoder.jsonb_ast
72−instance HasDecoding 'PGDate Day where
67+instance HasDecoding (column ::: 'Required ('NotNull 'PGDate)) Day where
73 decoding _ = Decoder.date
68 decoding _ = Decoder.date
74−instance HasDecoding 'PGTime TimeOfDay where
69+instance HasDecoding (column ::: 'Required ('NotNull 'PGTime)) TimeOfDay where
75 decoding _ = Decoder.time_int
70 decoding _ = Decoder.time_int
76−instance HasDecoding 'PGTimeTZ (TimeOfDay, TimeZone) where
71+instance HasDecoding (column ::: 'Required ('NotNull 'PGTimeTZ)) (TimeOfDay, TimeZone) where
77 decoding _ = Decoder.timetz_int
72 decoding _ = Decoder.timetz_int
78−instance HasDecoding 'PGTimestamp LocalTime where
73+instance HasDecoding (column ::: 'Required ('NotNull 'PGTimestamp)) LocalTime where
79 decoding _ = Decoder.timestamp_int
74 decoding _ = Decoder.timestamp_int
80−instance HasDecoding 'PGTimestampTZ UTCTime where
75+instance HasDecoding (column ::: 'Required ('NotNull 'PGTimestampTZ)) UTCTime where
81 decoding _ = Decoder.timestamptz_int
76 decoding _ = Decoder.timestamptz_int
82−instance HasDecoding 'PGInterval DiffTime where
77+instance HasDecoding (column ::: 'Required ('NotNull 'PGInterval)) DiffTime where
83 decoding _ = Decoder.interval_int
78 decoding _ = Decoder.interval_int
84
79
85decodings
80decodings
@@ -93,53 +88,53 @@ decodings (_ :: proxy pgs) (K bytestring :* bytestrings) =
93 <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)
88 <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)
94 <*> decodings proxies bytestrings
89 <*> decodings proxies bytestrings
95
90
96−class HasEncoding x pg where
91+class HasEncoding pg x where
97 encoding :: proxy pg -> x -> Encoder.Encoding
92 encoding :: proxy pg -> x -> Encoder.Encoding
98−instance HasEncoding Int16 'PGInt2 where
93+instance HasEncoding ('Required ('NotNull 'PGInt2)) Int16 where
99 encoding _ = Encoder.int2_int16
94 encoding _ = Encoder.int2_int16
100−instance HasEncoding Int32 'PGInt4 where
95+instance HasEncoding ('Required ('NotNull 'PGInt4)) Int32 where
101 encoding _ = Encoder.int4_int32
96 encoding _ = Encoder.int4_int32
102−instance HasEncoding Int64 'PGInt8 where
97+instance HasEncoding ('Required ('NotNull 'PGInt8)) Int64 where
103 encoding _ = Encoder.int8_int64
98 encoding _ = Encoder.int8_int64
104−instance HasEncoding Float 'PGFloat4 where
99+instance HasEncoding ('Required ('NotNull 'PGFloat4)) Float where
105 encoding _ = Encoder.float4
100 encoding _ = Encoder.float4
106−instance HasEncoding Double 'PGFloat8 where
101+instance HasEncoding ('Required ('NotNull 'PGFloat8)) Double where
107 encoding _ = Encoder.float8
102 encoding _ = Encoder.float8
108−instance HasEncoding Bool 'PGBool where
103+instance HasEncoding ('Required ('NotNull 'PGBool)) Bool where
109 encoding _ = Encoder.bool
104 encoding _ = Encoder.bool
110−instance HasEncoding ByteString 'PGBytea where
105+instance HasEncoding ('Required ('NotNull 'PGBytea)) ByteString where
111 encoding _ = Encoder.bytea_strict
106 encoding _ = Encoder.bytea_strict
112−instance HasEncoding Lazy.ByteString 'PGBytea where
107+instance HasEncoding ('Required ('NotNull 'PGBytea)) Lazy.ByteString where
113 encoding _ = Encoder.bytea_lazy
108 encoding _ = Encoder.bytea_lazy
114−instance HasEncoding Text 'PGText where
109+instance HasEncoding ('Required ('NotNull 'PGText)) Text where
115 encoding _ = Encoder.text_strict
110 encoding _ = Encoder.text_strict
116−instance HasEncoding Lazy.Text 'PGText where
111+instance HasEncoding ('Required ('NotNull 'PGText)) Lazy.Text where
117 encoding _ = Encoder.text_lazy
112 encoding _ = Encoder.text_lazy
118−instance HasEncoding Char ('PGChar 1) where
113+instance HasEncoding ('Required ('NotNull ('PGChar 1))) Char where
119 encoding _ = Encoder.char_utf8
114 encoding _ = Encoder.char_utf8
120−instance HasEncoding Scientific 'PGNumeric where
115+instance HasEncoding ('Required ('NotNull 'PGNumeric)) Scientific where
121 encoding _ = Encoder.numeric
116 encoding _ = Encoder.numeric
122−instance HasEncoding UUID 'PGUuid where
117+instance HasEncoding ('Required ('NotNull 'PGUuid)) UUID where
123 encoding _ = Encoder.uuid
118 encoding _ = Encoder.uuid
124−instance ToJSON x => HasEncoding x 'PGJson where
119+instance HasEncoding ('Required ('NotNull 'PGJson)) Aeson.Value where
125− encoding _ = Encoder.json_bytes . Lazy.toStrict . encode
120+ encoding _ = Encoder.json_ast
126−instance ToJSON x => HasEncoding x 'PGJsonb where
121+instance HasEncoding ('Required ('NotNull 'PGJsonb)) Aeson.Value where
127− encoding _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
122+ encoding _ = Encoder.jsonb_ast
128−instance HasEncoding Day 'PGDate where
123+instance HasEncoding ('Required ('NotNull 'PGDate)) Day where
129 encoding _ = Encoder.date
124 encoding _ = Encoder.date
130−instance HasEncoding TimeOfDay 'PGTime where
125+instance HasEncoding ('Required ('NotNull 'PGTime)) TimeOfDay where
131 encoding _ = Encoder.time_int
126 encoding _ = Encoder.time_int
132−instance HasEncoding (TimeOfDay, TimeZone) 'PGTimeTZ where
127+instance HasEncoding ('Required ('NotNull 'PGTimeTZ)) (TimeOfDay, TimeZone) where
133 encoding _ = Encoder.timetz_int
128 encoding _ = Encoder.timetz_int
134−instance HasEncoding LocalTime 'PGTimestamp where
129+instance HasEncoding ('Required ('NotNull 'PGTimestamp)) LocalTime where
135 encoding _ = Encoder.timestamp_int
130 encoding _ = Encoder.timestamp_int
136−instance HasEncoding UTCTime 'PGTimestampTZ where
131+instance HasEncoding ('Required ('NotNull 'PGTimestampTZ)) UTCTime where
137 encoding _ = Encoder.timestamptz_int
132 encoding _ = Encoder.timestamptz_int
138−instance HasEncoding DiffTime 'PGInterval where
133+instance HasEncoding ('Required ('NotNull 'PGInterval)) DiffTime where
139 encoding _ = Encoder.interval_int
134 encoding _ = Encoder.interval_int
140
135
141encodings
136encodings
142− :: AllZip HasEncoding xs pgs
137+ :: AllZip HasEncoding pgs xs
143 => proxy pgs
138 => proxy pgs
144 -> NP I xs
139 -> NP I xs
145 -> [ByteString]
140 -> [ByteString]
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+3−3
@@ -73,7 +73,7 @@ class MonadPQ pq where
73 -> pq db0 db1 io (Maybe (Result '[]))
73 -> pq db0 db1 io (Maybe (Result '[]))
74
74
75 pqExecParams
75 pqExecParams
76− :: (MonadBase IO io, ToOids ps, AllZip HasEncoding xs ps, All Top ps)
76+ :: (MonadBase IO io, ToOids ps, AllZip HasEncoding ps xs, All Top ps)
77 => Statement ps ys db0 db1
77 => Statement ps ys db0 db1
78 -> NP I xs
78 -> NP I xs
79 -> pq db0 db1 io (Maybe (Result ys))
79 -> pq db0 db1 io (Maybe (Result ys))
@@ -85,7 +85,7 @@ class MonadPQ pq where
85 -> pq db0 db1 io (Maybe (Result []), PreparedStatement ps xs db0 db1)
85 -> pq db0 db1 io (Maybe (Result []), PreparedStatement ps xs db0 db1)
86
86
87 pqExecPrepared
87 pqExecPrepared
88− :: (MonadBase IO io, AllZip HasEncoding xs ps, All Top ps)
88+ :: (MonadBase IO io, AllZip HasEncoding ps xs, All Top ps)
89 => PreparedStatement ps ys db0 db1
89 => PreparedStatement ps ys db0 db1
90 -> NP I xs
90 -> NP I xs
91 -> pq db0 db1 io (Maybe (Result ys))
91 -> pq db0 db1 io (Maybe (Result ys))
@@ -240,7 +240,7 @@ getRow
240 => RowNumber -> Value pgs (ExceptT Text (MaybeT io)) (NP I xs)
240 => RowNumber -> Value pgs (ExceptT Text (MaybeT io)) (NP I xs)
241getRow (RowNumber r) = Value $ \ (Result result :: Result pgs) -> do
241getRow (RowNumber r) = Value $ \ (Result result :: Result pgs) -> do
242 maybeBytestrings <- traverse (liftBase . LibPQ.getvalue result r)
242 maybeBytestrings <- traverse (liftBase . LibPQ.getvalue result r)
243− [1 .. fromIntegral (lengthSList (Proxy :: Proxy pgs))]
243+ [0 .. fromIntegral (lengthSList (Proxy :: Proxy pgs)) - 1]
244 case fromList (catMaybes maybeBytestrings) of
244 case fromList (catMaybes maybeBytestrings) of
245 Nothing -> mzero
245 Nothing -> mzero
246 Just bytestrings -> case decodings (Proxy :: Proxy pgs) bytestrings of
246 Just bytestrings -> case decodings (Proxy :: Proxy pgs) bytestrings of