git.iko.soy/squeal
on dev help sign in
small things
commitb3f944cb6451eacf34c36bcc18397e58226fd649 authorEitan Chatav <eitan.chatav@gmail.com> dateSat 1 Jul 2017, 10:21 (9 years ago) parent18b98fa
4 files changed+92−80
compare with dev
unifiedsplit
squeel-postgresql/exe/Example.hs+37−22 squeel-postgresql/squeel-postgresql.cabal+2 squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+50−55 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+3−3
squeel-postgresql/exe/Example.hs+37−22
@@ -3,15 +3,18 @@
33 , MagicHash
44 , OverloadedLabels
55 , OverloadedStrings
6+ , ScopedTypeVariables
67 , TypeOperators
78#-}
89
910module Main (main) where
1011
1112import Control.Category ((>>>))
12−-- import Control.Monad.Base
13+import Control.Monad.Base
14+import Control.Monad.Except
15+import Control.Monad.Trans.Maybe
1316import Data.Function ((&))
14−-- import Data.Int
17+import Data.Int
1518import Data.Monoid
1619import Generics.SOP
1720import Squeel.PostgreSQL
@@ -40,27 +43,39 @@ main = do
4043 insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )
4144 >>>
4245 insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )
43− -- Just selectTable1Result <- flip pqExecParams Nil $
44− -- (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
45− -- Just (Right value00) <- getvalue selectTable1Result (RowNumber 0) colNum0
46− -- Just (Right value01) <- getvalue selectTable1Result (RowNumber 0) colNum1
47− -- Just (Right value10) <- getvalue selectTable1Result (RowNumber 1) colNum0
48− -- Just (Right value11) <- getvalue selectTable1Result (RowNumber 1) colNum1
49− -- liftBase $ do
50− -- print (value00 :: Int32)
51− -- print (value01 :: Int32)
52− -- print (value10 :: Int32)
53− -- print (value11 :: Int32)
54− return ()
55− finish connection2
56−--
57−-- type Columns =
58−-- '[ "col1" ::: 'Required ('NotNull 'PGInt4)
59−-- , "col2" ::: 'Required ('NotNull 'PGInt4)
60−-- ]
46+ Just selectTable1Result <- flip pqExecParams Nil $
47+ (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
48+ Just (Right value00) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
49+ getValue (RowNumber 0) colNum0
50+ Just (Right value01) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
51+ getValue (RowNumber 0) colNum1
52+ Just (Right value10) <- runMaybeT . runExceptT . flip runValue selectTable1Result $
53+ getValue (RowNumber 1) colNum0
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)
60+ liftBase $ do
61+ print (value00 :: Int32)
62+ print (value01 :: Int32)
63+ print (value10 :: Int32)
64+ print (value11 :: Int32)
65+ print (row0 :: NP I '[Int32,Int32])
66+ print (row1 :: NP I '[Int32,Int32])
67+ connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec $
68+ (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])
69+ >>> dropTable #students
70+ finish connection3
71+
72+type Columns =
73+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
74+ , "col2" ::: 'Required ('NotNull 'PGInt4)
75+ ]
6176-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
62−-- type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
63−-- type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]
77+type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
78+type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]
6479-- type OrderColumns =
6580-- [ "orderID" ::: 'NotNull 'PGInt4
6681-- , "orderVal" ::: 'NotNull 'PGText
squeel-postgresql/squeel-postgresql.cabal+2
@@ -63,7 +63,9 @@ executable squeel-postgresql-example
6363 base
6464 , bytestring
6565 , generics-sop
66+ , mtl
6667 , squeel-postgresql
68+ , transformers
6769 , transformers-base
6870
6971source-repository head
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+50−55
@@ -13,21 +13,16 @@
1313
1414module Squeel.PostgreSQL.Binary where
1515
16−import Control.Arrow (left)
17−import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
1816import Data.ByteString (ByteString)
1917import Data.Int (Int16,Int32,Int64)
2018import Generics.SOP
21−-- import GHC.Generics
22−-- import PostgreSQL.Binary.Decoding
2319import Data.Scientific (Scientific)
2420import Data.Text (Text)
2521import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
2622import Data.UUID (UUID)
27−-- import GHC.Exts
2823
29−import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
30−import qualified Data.Text as Text (pack)
24+import qualified Data.Aeson as Aeson
25+import qualified Data.ByteString.Lazy as Lazy (ByteString)
3126import qualified Data.Text.Lazy as Lazy (Text)
3227import qualified PostgreSQL.Binary.Decoding as Decoder
3328import qualified PostgreSQL.Binary.Encoding as Encoder
@@ -39,47 +34,47 @@ decodeValue p = Decoder.valueParser $ decoding p
3934
4035class HasDecoding pg x where
4136 decoding :: proxy pg -> Decoder.Value x
42−instance HasDecoding 'PGInt2 Int16 where
37+instance HasDecoding (column ::: 'Required ('NotNull 'PGInt2)) Int16 where
4338 decoding _ = Decoder.int
44−instance HasDecoding 'PGInt4 Int32 where
39+instance HasDecoding (column ::: 'Required ('NotNull 'PGInt4)) Int32 where
4540 decoding _ = Decoder.int
46−instance HasDecoding 'PGInt8 Int64 where
41+instance HasDecoding (column ::: 'Required ('NotNull 'PGInt8)) Int64 where
4742 decoding _ = Decoder.int
48−instance HasDecoding 'PGFloat4 Float where
43+instance HasDecoding (column ::: 'Required ('NotNull 'PGFloat4)) Float where
4944 decoding _ = Decoder.float4
50−instance HasDecoding 'PGFloat8 Double where
45+instance HasDecoding (column ::: 'Required ('NotNull 'PGFloat8)) Double where
5146 decoding _ = Decoder.float8
52−instance HasDecoding 'PGBool Bool where
47+instance HasDecoding (column ::: 'Required ('NotNull 'PGBool)) Bool where
5348 decoding _ = Decoder.bool
54−instance HasDecoding 'PGBytea ByteString where
49+instance HasDecoding (column ::: 'Required ('NotNull 'PGBytea)) ByteString where
5550 decoding _ = Decoder.bytea_strict
56−instance HasDecoding 'PGBytea Lazy.ByteString where
51+instance HasDecoding (column ::: 'Required ('NotNull 'PGBytea)) Lazy.ByteString where
5752 decoding _ = Decoder.bytea_lazy
58−instance HasDecoding 'PGText Text where
53+instance HasDecoding (column ::: 'Required ('NotNull 'PGText)) Text where
5954 decoding _ = Decoder.text_strict
60−instance HasDecoding 'PGText Lazy.Text where
55+instance HasDecoding (column ::: 'Required ('NotNull 'PGText)) Lazy.Text where
6156 decoding _ = Decoder.text_lazy
62−instance HasDecoding ('PGChar 1) Char where
57+instance HasDecoding (column ::: 'Required ('NotNull ('PGChar 1))) Char where
6358 decoding _ = Decoder.char
64−instance HasDecoding 'PGNumeric Scientific where
59+instance HasDecoding (column ::: 'Required ('NotNull 'PGNumeric)) Scientific where
6560 decoding _ = Decoder.numeric
66−instance HasDecoding 'PGUuid UUID where
61+instance HasDecoding (column ::: 'Required ('NotNull 'PGUuid)) UUID where
6762 decoding _ = Decoder.uuid
68−instance FromJSON x => HasDecoding 'PGJson x where
69− decoding _ = Decoder.json_bytes (left Text.pack . eitherDecodeStrict)
70−instance FromJSON x => HasDecoding 'PGJsonb x where
71− decoding _ = Decoder.jsonb_bytes (left Text.pack . eitherDecodeStrict)
72−instance HasDecoding 'PGDate Day where
63+instance HasDecoding (column ::: 'Required ('NotNull 'PGJson)) Aeson.Value where
64+ decoding _ = Decoder.json_ast
65+instance HasDecoding (column ::: 'Required ('NotNull 'PGJsonb)) Aeson.Value where
66+ decoding _ = Decoder.jsonb_ast
67+instance HasDecoding (column ::: 'Required ('NotNull 'PGDate)) Day where
7368 decoding _ = Decoder.date
74−instance HasDecoding 'PGTime TimeOfDay where
69+instance HasDecoding (column ::: 'Required ('NotNull 'PGTime)) TimeOfDay where
7570 decoding _ = Decoder.time_int
76−instance HasDecoding 'PGTimeTZ (TimeOfDay, TimeZone) where
71+instance HasDecoding (column ::: 'Required ('NotNull 'PGTimeTZ)) (TimeOfDay, TimeZone) where
7772 decoding _ = Decoder.timetz_int
78−instance HasDecoding 'PGTimestamp LocalTime where
73+instance HasDecoding (column ::: 'Required ('NotNull 'PGTimestamp)) LocalTime where
7974 decoding _ = Decoder.timestamp_int
80−instance HasDecoding 'PGTimestampTZ UTCTime where
75+instance HasDecoding (column ::: 'Required ('NotNull 'PGTimestampTZ)) UTCTime where
8176 decoding _ = Decoder.timestamptz_int
82−instance HasDecoding 'PGInterval DiffTime where
77+instance HasDecoding (column ::: 'Required ('NotNull 'PGInterval)) DiffTime where
8378 decoding _ = Decoder.interval_int
8479
8580decodings
@@ -93,53 +88,53 @@ decodings (_ :: proxy pgs) (K bytestring :* bytestrings) =
9388 <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)
9489 <*> decodings proxies bytestrings
9590
96−class HasEncoding x pg where
91+class HasEncoding pg x where
9792 encoding :: proxy pg -> x -> Encoder.Encoding
98−instance HasEncoding Int16 'PGInt2 where
93+instance HasEncoding ('Required ('NotNull 'PGInt2)) Int16 where
9994 encoding _ = Encoder.int2_int16
100−instance HasEncoding Int32 'PGInt4 where
95+instance HasEncoding ('Required ('NotNull 'PGInt4)) Int32 where
10196 encoding _ = Encoder.int4_int32
102−instance HasEncoding Int64 'PGInt8 where
97+instance HasEncoding ('Required ('NotNull 'PGInt8)) Int64 where
10398 encoding _ = Encoder.int8_int64
104−instance HasEncoding Float 'PGFloat4 where
99+instance HasEncoding ('Required ('NotNull 'PGFloat4)) Float where
105100 encoding _ = Encoder.float4
106−instance HasEncoding Double 'PGFloat8 where
101+instance HasEncoding ('Required ('NotNull 'PGFloat8)) Double where
107102 encoding _ = Encoder.float8
108−instance HasEncoding Bool 'PGBool where
103+instance HasEncoding ('Required ('NotNull 'PGBool)) Bool where
109104 encoding _ = Encoder.bool
110−instance HasEncoding ByteString 'PGBytea where
105+instance HasEncoding ('Required ('NotNull 'PGBytea)) ByteString where
111106 encoding _ = Encoder.bytea_strict
112−instance HasEncoding Lazy.ByteString 'PGBytea where
107+instance HasEncoding ('Required ('NotNull 'PGBytea)) Lazy.ByteString where
113108 encoding _ = Encoder.bytea_lazy
114−instance HasEncoding Text 'PGText where
109+instance HasEncoding ('Required ('NotNull 'PGText)) Text where
115110 encoding _ = Encoder.text_strict
116−instance HasEncoding Lazy.Text 'PGText where
111+instance HasEncoding ('Required ('NotNull 'PGText)) Lazy.Text where
117112 encoding _ = Encoder.text_lazy
118−instance HasEncoding Char ('PGChar 1) where
113+instance HasEncoding ('Required ('NotNull ('PGChar 1))) Char where
119114 encoding _ = Encoder.char_utf8
120−instance HasEncoding Scientific 'PGNumeric where
115+instance HasEncoding ('Required ('NotNull 'PGNumeric)) Scientific where
121116 encoding _ = Encoder.numeric
122−instance HasEncoding UUID 'PGUuid where
117+instance HasEncoding ('Required ('NotNull 'PGUuid)) UUID where
123118 encoding _ = Encoder.uuid
124−instance ToJSON x => HasEncoding x 'PGJson where
125− encoding _ = Encoder.json_bytes . Lazy.toStrict . encode
126−instance ToJSON x => HasEncoding x 'PGJsonb where
127− encoding _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
128−instance HasEncoding Day 'PGDate where
119+instance HasEncoding ('Required ('NotNull 'PGJson)) Aeson.Value where
120+ encoding _ = Encoder.json_ast
121+instance HasEncoding ('Required ('NotNull 'PGJsonb)) Aeson.Value where
122+ encoding _ = Encoder.jsonb_ast
123+instance HasEncoding ('Required ('NotNull 'PGDate)) Day where
129124 encoding _ = Encoder.date
130−instance HasEncoding TimeOfDay 'PGTime where
125+instance HasEncoding ('Required ('NotNull 'PGTime)) TimeOfDay where
131126 encoding _ = Encoder.time_int
132−instance HasEncoding (TimeOfDay, TimeZone) 'PGTimeTZ where
127+instance HasEncoding ('Required ('NotNull 'PGTimeTZ)) (TimeOfDay, TimeZone) where
133128 encoding _ = Encoder.timetz_int
134−instance HasEncoding LocalTime 'PGTimestamp where
129+instance HasEncoding ('Required ('NotNull 'PGTimestamp)) LocalTime where
135130 encoding _ = Encoder.timestamp_int
136−instance HasEncoding UTCTime 'PGTimestampTZ where
131+instance HasEncoding ('Required ('NotNull 'PGTimestampTZ)) UTCTime where
137132 encoding _ = Encoder.timestamptz_int
138−instance HasEncoding DiffTime 'PGInterval where
133+instance HasEncoding ('Required ('NotNull 'PGInterval)) DiffTime where
139134 encoding _ = Encoder.interval_int
140135
141136encodings
142− :: AllZip HasEncoding xs pgs
137+ :: AllZip HasEncoding pgs xs
143138 => proxy pgs
144139 -> NP I xs
145140 -> [ByteString]
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+3−3
@@ -73,7 +73,7 @@ class MonadPQ pq where
7373 -> pq db0 db1 io (Maybe (Result '[]))
7474
7575 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)
7777 => Statement ps ys db0 db1
7878 -> NP I xs
7979 -> pq db0 db1 io (Maybe (Result ys))
@@ -85,7 +85,7 @@ class MonadPQ pq where
8585 -> pq db0 db1 io (Maybe (Result []), PreparedStatement ps xs db0 db1)
8686
8787 pqExecPrepared
88− :: (MonadBase IO io, AllZip HasEncoding xs ps, All Top ps)
88+ :: (MonadBase IO io, AllZip HasEncoding ps xs, All Top ps)
8989 => PreparedStatement ps ys db0 db1
9090 -> NP I xs
9191 -> pq db0 db1 io (Maybe (Result ys))
@@ -240,7 +240,7 @@ getRow
240240 => RowNumber -> Value pgs (ExceptT Text (MaybeT io)) (NP I xs)
241241getRow (RowNumber r) = Value $ \ (Result result :: Result pgs) -> do
242242 maybeBytestrings <- traverse (liftBase . LibPQ.getvalue result r)
243− [1 .. fromIntegral (lengthSList (Proxy :: Proxy pgs))]
243+ [0 .. fromIntegral (lengthSList (Proxy :: Proxy pgs)) - 1]
244244 case fromList (catMaybes maybeBytestrings) of
245245 Nothing -> mzero
246246 Just bytestrings -> case decodings (Proxy :: Proxy pgs) bytestrings of