git.iko.soy/squeal
on dev help sign in
sketches
e801eccEitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+29−2
compare with dev
unifiedsplit
@@ -1,7 +1,9 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 DataKinds
2 DataKinds
3+ , FlexibleContexts
3 , FlexibleInstances
4 , FlexibleInstances
4 , GADTs
5 , GADTs
6+ , LambdaCase
5 , MagicHash
7 , MagicHash
6 , MultiParamTypeClasses
8 , MultiParamTypeClasses
7 , PolyKinds
9 , PolyKinds
@@ -16,8 +18,8 @@ import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
16import Data.ByteString (ByteString)
18import Data.ByteString (ByteString)
17import Data.Int (Int16,Int32,Int64)
19import Data.Int (Int16,Int32,Int64)
18import Generics.SOP
20import Generics.SOP
21+import GHC.Generics
19import PostgreSQL.Binary.Decoding (Value)
22import PostgreSQL.Binary.Decoding (Value)
20−import PostgreSQL.Binary.Encoding (Encoding)
21import Data.Scientific (Scientific)
23import Data.Scientific (Scientific)
22import Data.Text (Text)
24import Data.Text (Text)
23import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
25import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
@@ -92,7 +94,7 @@ instance (FromValue pg x, FromValues pgs xs)
92 :* decodeValues (proxy# :: Proxy# pgs) results
94 :* decodeValues (proxy# :: Proxy# pgs) results
93
95
94class ToValue x pg where
96class ToValue x pg where
95− toValue :: Proxy# pg -> x -> Encoding
97+ toValue :: Proxy# pg -> x -> Encoder.Encoding
96instance ToValue Int16 'PGInt2 where
98instance ToValue Int16 'PGInt2 where
97 toValue _ = Encoder.int2_int16
99 toValue _ = Encoder.int2_int16
98instance ToValue Int32 'PGInt4 where
100instance ToValue Int32 'PGInt4 where
@@ -144,3 +146,28 @@ instance (ToValue x pg, ToValues xs pgs)
144 toValues _ (I x :* xs)
146 toValues _ (I x :* xs)
145 = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)
147 = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)
146 : toValues (proxy# :: Proxy# pgs) xs
148 : toValues (proxy# :: Proxy# pgs) xs
149+
150+newtype Encoding x = Encoding { unEncoding :: x -> Encoder.Encoding }
151+class ToEncoding pg x where toEncoding :: Proxy pg -> Encoding x
152+
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
160+
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
166+
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