@@ -18,13 +18,13 @@ import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
1818import Data.ByteString (ByteString)
1919import Data.Int (Int16,Int32,Int64)
2020import Generics.SOP
21−import GHC.Generics
22−import PostgreSQL.Binary.Decoding (Value)
21+-- import GHC.Generics
22+-- import PostgreSQL.Binary.Decoding
2323import Data.Scientific (Scientific)
2424import Data.Text (Text)
2525import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
2626import Data.UUID (UUID)
27−import GHC.Exts
27+-- import GHC.Exts
2828
2929import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
3030import qualified Data.Text as Text (pack)
@@ -34,140 +34,174 @@ import qualified PostgreSQL.Binary.Encoding as Encoder
3434
3535import Squeel.PostgreSQL.Schema
3636
37−decodeValue :: FromValue pg x => Proxy# pg -> ByteString -> Either Text x
38−decodeValue p = Decoder.valueParser $ fromValue p
37+decodeValue :: HasDecoding pg x => proxy pg -> ByteString -> Either Text x
38+decodeValue p = Decoder.valueParser $ decoding p
3939
40−class FromValue pg x where
41− fromValue :: Proxy# pg -> Value x
42−instance FromValue 'PGInt2 Int16 where
43− fromValue _ = Decoder.int
44−instance FromValue 'PGInt4 Int32 where
45− fromValue _ = Decoder.int
46−instance FromValue 'PGInt8 Int64 where
47− fromValue _ = Decoder.int
48−instance FromValue 'PGFloat4 Float where
49− fromValue _ = Decoder.float4
50−instance FromValue 'PGFloat8 Double where
51− fromValue _ = Decoder.float8
52−instance FromValue 'PGBool Bool where
53− fromValue _ = Decoder.bool
54−instance FromValue 'PGBytea ByteString where
55− fromValue _ = Decoder.bytea_strict
56−instance FromValue 'PGBytea Lazy.ByteString where
57− fromValue _ = Decoder.bytea_lazy
58−instance FromValue 'PGText Text where
59− fromValue _ = Decoder.text_strict
60−instance FromValue 'PGText Lazy.Text where
61− fromValue _ = Decoder.text_lazy
62−instance FromValue ('PGChar 1) Char where
63− fromValue _ = Decoder.char
64−instance FromValue 'PGNumeric Scientific where
65− fromValue _ = Decoder.numeric
66−instance FromValue 'PGUuid UUID where
67− fromValue _ = Decoder.uuid
68−instance FromJSON x => FromValue 'PGJson x where
69− fromValue _ = Decoder.json_bytes (left Text.pack . eitherDecodeStrict)
70−instance FromJSON x => FromValue 'PGJsonb x where
71− fromValue _ = Decoder.jsonb_bytes (left Text.pack . eitherDecodeStrict)
72−instance FromValue 'PGDate Day where
73− fromValue _ = Decoder.date
74−instance FromValue 'PGTime TimeOfDay where
75− fromValue _ = Decoder.time_int
76−instance FromValue 'PGTimeTZ (TimeOfDay, TimeZone) where
77− fromValue _ = Decoder.timetz_int
78−instance FromValue 'PGTimestamp LocalTime where
79− fromValue _ = Decoder.timestamp_int
80−instance FromValue 'PGTimestampTZ UTCTime where
81− fromValue _ = Decoder.timestamptz_int
82−instance FromValue 'PGInterval DiffTime where
83− fromValue _ = Decoder.interval_int
84−instance FromValue pg ty => FromValue (column ::: 'Required ('NotNull pg)) ty where
85− fromValue _ = fromValue (proxy# :: Proxy# pg)
40+class HasDecoding pg x where
41+ decoding :: proxy pg -> Decoder.Value x
42+instance HasDecoding 'PGInt2 Int16 where
43+ decoding _ = Decoder.int
44+instance HasDecoding 'PGInt4 Int32 where
45+ decoding _ = Decoder.int
46+instance HasDecoding 'PGInt8 Int64 where
47+ decoding _ = Decoder.int
48+instance HasDecoding 'PGFloat4 Float where
49+ decoding _ = Decoder.float4
50+instance HasDecoding 'PGFloat8 Double where
51+ decoding _ = Decoder.float8
52+instance HasDecoding 'PGBool Bool where
53+ decoding _ = Decoder.bool
54+instance HasDecoding 'PGBytea ByteString where
55+ decoding _ = Decoder.bytea_strict
56+instance HasDecoding 'PGBytea Lazy.ByteString where
57+ decoding _ = Decoder.bytea_lazy
58+instance HasDecoding 'PGText Text where
59+ decoding _ = Decoder.text_strict
60+instance HasDecoding 'PGText Lazy.Text where
61+ decoding _ = Decoder.text_lazy
62+instance HasDecoding ('PGChar 1) Char where
63+ decoding _ = Decoder.char
64+instance HasDecoding 'PGNumeric Scientific where
65+ decoding _ = Decoder.numeric
66+instance HasDecoding 'PGUuid UUID where
67+ 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
73+ decoding _ = Decoder.date
74+instance HasDecoding 'PGTime TimeOfDay where
75+ decoding _ = Decoder.time_int
76+instance HasDecoding 'PGTimeTZ (TimeOfDay, TimeZone) where
77+ decoding _ = Decoder.timetz_int
78+instance HasDecoding 'PGTimestamp LocalTime where
79+ decoding _ = Decoder.timestamp_int
80+instance HasDecoding 'PGTimestampTZ UTCTime where
81+ decoding _ = Decoder.timestamptz_int
82+instance HasDecoding 'PGInterval DiffTime where
83+ decoding _ = Decoder.interval_int
8684
87−class FromValues pgs xs where
88− decodeValues :: Proxy# pgs -> NP (K ByteString) xs -> NP (Either Text) xs
89−instance FromValues '[] '[] where decodeValues _ _ = Nil
90−instance (FromValue pg x, FromValues pgs xs)
91− => FromValues (pg ': pgs) (x ': xs) where
92− decodeValues _ (K result :* results) =
93− decodeValue (proxy# :: Proxy# pg) result
94− :* decodeValues (proxy# :: Proxy# pgs) results
85+{-
86+encodings
87+ :: AllZip HasEncoding xs pgs
88+ => proxy pgs
89+ -> NP I xs
90+ -> [ByteString]
91+encodings _ Nil = []
92+encodings (_ :: proxy pgs) (I x :* xs) =
93+ case (hpure Proxy :: NP Proxy pgs) of
94+ proxy :* proxies -> undefined (encoding proxy x) : encodings proxies xs
95+-}
96+
97+decodings
98+ :: AllZip HasDecoding pgs xs
99+ => proxy pgs
100+ -> NP (K ByteString) xs -> Either Text (NP I xs)
101+decodings _ Nil = return Nil
102+decodings (_ :: proxy pgs) (K bytestring :* bytestrings) =
103+ case (hpure Proxy :: NP Proxy pgs) of
104+ proxy :* proxies -> (:*)
105+ <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)
106+ <*> decodings proxies bytestrings
107+-- instance HasDecoding pg ty => HasDecoding (column ::: 'Required ('NotNull pg)) ty where
108+-- decoding _ = decoding (proxy# :: Proxy# pg)
95109
96−class ToValue x pg where
97− toValue :: Proxy# pg -> x -> Encoder.Encoding
98−instance ToValue Int16 'PGInt2 where
99− toValue _ = Encoder.int2_int16
100−instance ToValue Int32 'PGInt4 where
101− toValue _ = Encoder.int4_int32
102−instance ToValue Int64 'PGInt8 where
103− toValue _ = Encoder.int8_int64
104−instance ToValue Float 'PGFloat4 where
105− toValue _ = Encoder.float4
106−instance ToValue Double 'PGFloat8 where
107− toValue _ = Encoder.float8
108−instance ToValue Bool 'PGBool where
109− toValue _ = Encoder.bool
110−instance ToValue ByteString 'PGBytea where
111− toValue _ = Encoder.bytea_strict
112−instance ToValue Lazy.ByteString 'PGBytea where
113− toValue _ = Encoder.bytea_lazy
114−instance ToValue Text 'PGText where
115− toValue _ = Encoder.text_strict
116−instance ToValue Lazy.Text 'PGText where
117− toValue _ = Encoder.text_lazy
118−instance ToValue Char ('PGChar 1) where
119− toValue _ = Encoder.char_utf8
120−instance ToValue Scientific 'PGNumeric where
121− toValue _ = Encoder.numeric
122−instance ToValue UUID 'PGUuid where
123− toValue _ = Encoder.uuid
124−instance ToJSON x => ToValue x 'PGJson where
125− toValue _ = Encoder.json_bytes . Lazy.toStrict . encode
126−instance ToJSON x => ToValue x 'PGJsonb where
127− toValue _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
128−instance ToValue Day 'PGDate where
129− toValue _ = Encoder.date
130−instance ToValue TimeOfDay 'PGTime where
131− toValue _ = Encoder.time_int
132−instance ToValue (TimeOfDay, TimeZone) 'PGTimeTZ where
133− toValue _ = Encoder.timetz_int
134−instance ToValue LocalTime 'PGTimestamp where
135− toValue _ = Encoder.timestamp_int
136−instance ToValue UTCTime 'PGTimestampTZ where
137− toValue _ = Encoder.timestamptz_int
138−instance ToValue DiffTime 'PGInterval where
139− toValue _ = Encoder.interval_int
110+-- class HasDecodings pgs xs where
111+-- decodeValues :: Proxy# pgs -> NP (K ByteString) xs -> NP (Either Text) xs
112+-- instance HasDecodings '[] '[] where decodeValues _ _ = Nil
113+-- instance (HasDecoding pg x, HasDecodings pgs xs)
114+-- => HasDecodings (pg ': pgs) (x ': xs) where
115+-- decodeValues _ (K result :* results) =
116+-- decodeValue (proxy# :: Proxy# pg) result
117+-- :* decodeValues (proxy# :: Proxy# pgs) results
140118
141−class ToValues xs pgs where
142− toValues :: Proxy# pgs -> NP I xs -> [ByteString]
143−instance ToValues '[] '[] where toValues _ _ = []
144−instance (ToValue x pg, ToValues xs pgs)
145− => ToValues (x ': xs) (pg ': pgs) where
146− toValues _ (I x :* xs)
147− = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)
148− : toValues (proxy# :: Proxy# pgs) xs
119+class HasEncoding x pg where
120+ encoding :: proxy pg -> x -> Encoder.Encoding
121+instance HasEncoding Int16 'PGInt2 where
122+ encoding _ = Encoder.int2_int16
123+instance HasEncoding Int32 'PGInt4 where
124+ encoding _ = Encoder.int4_int32
125+instance HasEncoding Int64 'PGInt8 where
126+ encoding _ = Encoder.int8_int64
127+instance HasEncoding Float 'PGFloat4 where
128+ encoding _ = Encoder.float4
129+instance HasEncoding Double 'PGFloat8 where
130+ encoding _ = Encoder.float8
131+instance HasEncoding Bool 'PGBool where
132+ encoding _ = Encoder.bool
133+instance HasEncoding ByteString 'PGBytea where
134+ encoding _ = Encoder.bytea_strict
135+instance HasEncoding Lazy.ByteString 'PGBytea where
136+ encoding _ = Encoder.bytea_lazy
137+instance HasEncoding Text 'PGText where
138+ encoding _ = Encoder.text_strict
139+instance HasEncoding Lazy.Text 'PGText where
140+ encoding _ = Encoder.text_lazy
141+instance HasEncoding Char ('PGChar 1) where
142+ encoding _ = Encoder.char_utf8
143+instance HasEncoding Scientific 'PGNumeric where
144+ encoding _ = Encoder.numeric
145+instance HasEncoding UUID 'PGUuid where
146+ encoding _ = Encoder.uuid
147+instance ToJSON x => HasEncoding x 'PGJson where
148+ encoding _ = Encoder.json_bytes . Lazy.toStrict . encode
149+instance ToJSON x => HasEncoding x 'PGJsonb where
150+ encoding _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
151+instance HasEncoding Day 'PGDate where
152+ encoding _ = Encoder.date
153+instance HasEncoding TimeOfDay 'PGTime where
154+ encoding _ = Encoder.time_int
155+instance HasEncoding (TimeOfDay, TimeZone) 'PGTimeTZ where
156+ encoding _ = Encoder.timetz_int
157+instance HasEncoding LocalTime 'PGTimestamp where
158+ encoding _ = Encoder.timestamp_int
159+instance HasEncoding UTCTime 'PGTimestampTZ where
160+ encoding _ = Encoder.timestamptz_int
161+instance HasEncoding DiffTime 'PGInterval where
162+ encoding _ = Encoder.interval_int
149163
150−newtype Encoding x = Encoding { unEncoding :: x -> Encoder.Encoding }
151−class ToEncoding pg x where toEncoding :: Proxy pg -> Encoding x
164+encodings
165+ :: AllZip HasEncoding xs pgs
166+ => proxy pgs
167+ -> NP I xs
168+ -> [ByteString]
169+encodings _ Nil = []
170+encodings (_ :: proxy pgs) (I x :* xs) =
171+ case (hpure Proxy :: NP Proxy pgs) of
172+ proxy :* proxies -> Encoder.encodingBytes (encoding proxy x)
173+ : encodings proxies xs
152174
153−toEncodings
154− :: AllZip ToEncoding pgs xs
155− => NP Proxy pgs
156− -> NP Encoding xs
157−toEncodings = \case
158− Nil -> Nil
159− proxy :* proxies -> toEncoding proxy :* toEncodings proxies
175+-- class HasEncodings xs pgs where
176+-- encodings :: Proxy# pgs -> NP I xs -> [ByteString]
177+-- instance HasEncodings '[] '[] where encodings _ _ = []
178+-- instance (HasEncoding x pg, HasEncodings xs pgs)
179+-- => HasEncodings (x ': xs) (pg ': pgs) where
180+-- encodings _ (I x :* xs)
181+-- = Encoder.encodingBytes ((encoding (proxy# :: Proxy# pg)) x)
182+-- : encodings (proxy# :: Proxy# pgs) xs
160183
161−encodeParameters' :: NP (Encoding :*: I) xs -> NP (K ByteString) xs
162−encodeParameters' = \case
163− Nil -> Nil
164− (Encoding enc :*: I x) :* parameters ->
165− K (Encoder.encodingBytes (enc x)) :* encodeParameters' parameters
184+-- newtype Encoding x = Encoding { unEncoding :: x -> Encoder.Encoding }
185+-- class ToEncoding pg x where toEncoding :: Proxy pg -> Encoding x
166186
167−encodeParameters
168− :: AllZip ToEncoding pgs xs
169− => NP Proxy pgs
170− -> NP I xs
171− -> NP (K ByteString) xs
172−encodeParameters proxies parameters = encodeParameters' $
173− hzipWith (:*:) (toEncodings proxies) parameters
187+-- toEncodings
188+-- :: AllZip ToEncoding pgs xs
189+-- => NP Proxy pgs
190+-- -> NP Encoding xs
191+-- toEncodings = \case
192+-- Nil -> Nil
193+-- proxy :* proxies -> toEncoding proxy :* toEncodings proxies
194+--
195+-- encodeParameters' :: NP (Encoding :*: I) xs -> NP (K ByteString) xs
196+-- encodeParameters' = \case
197+-- Nil -> Nil
198+-- (Encoding enc :*: I x) :* parameters ->
199+-- K (Encoder.encodingBytes (enc x)) :* encodeParameters' parameters
200+--
201+-- encodeParameters
202+-- :: AllZip ToEncoding pgs xs
203+-- => NP Proxy pgs
204+-- -> NP I xs
205+-- -> NP (K ByteString) xs
206+-- encodeParameters proxies parameters = encodeParameters' $
207+-- hzipWith (:*:) (toEncodings proxies) parameters