on dev help sign in
sketches

of generic encoding

commite801eccac0924655bf46ae1a53015d023b874f04 authorEitan Chatav <eitan.chatav@gmail.com> dateThu 29 Jun 2017, 21:25 (9 years ago) parentf7aaa25
1 file changed+29−2
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+29−2
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+29−2
@@ -1,7 +1,9 @@
11{-# LANGUAGE
22 DataKinds
3+ , FlexibleContexts
34 , FlexibleInstances
45 , GADTs
6+ , LambdaCase
57 , MagicHash
68 , MultiParamTypeClasses
79 , PolyKinds
@@ -16,8 +18,8 @@ import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
1618import Data.ByteString (ByteString)
1719import Data.Int (Int16,Int32,Int64)
1820import Generics.SOP
21+import GHC.Generics
1922import PostgreSQL.Binary.Decoding (Value)
20−import PostgreSQL.Binary.Encoding (Encoding)
2123import Data.Scientific (Scientific)
2224import Data.Text (Text)
2325import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
@@ -92,7 +94,7 @@ instance (FromValue pg x, FromValues pgs xs)
9294 :* decodeValues (proxy# :: Proxy# pgs) results
9395
9496class ToValue x pg where
95− toValue :: Proxy# pg -> x -> Encoding
97+ toValue :: Proxy# pg -> x -> Encoder.Encoding
9698instance ToValue Int16 'PGInt2 where
9799 toValue _ = Encoder.int2_int16
98100instance ToValue Int32 'PGInt4 where
@@ -144,3 +146,28 @@ instance (ToValue x pg, ToValues xs pgs)
144146 toValues _ (I x :* xs)
145147 = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)
146148 : 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