git.iko.soy/squeal
on dev help sign in
decode composite values
d34c70cEitan Chatav
squeal-postgresql/squeal-postgresql.cabal+1
compare with dev
unifiedsplit
@@ -38,6 +38,7 @@ library
38 build-depends:
38 build-depends:
39 aeson >= 1.2.4.0
39 aeson >= 1.2.4.0
40 , base >= 4.10.1.0 && < 5.0
40 , base >= 4.10.1.0 && < 5.0
41+ , binary-parser
41 , bytestring >= 0.10.8.2
42 , bytestring >= 0.10.8.2
42 , deepseq >= 1.4.3.0
43 , deepseq >= 1.4.3.0
43 , generics-sop >= 0.3.2.0
44 , generics-sop >= 0.3.2.0
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+59
@@ -25,6 +25,7 @@ Binary encoding and decoding between Haskell and PostgreSQL types.
25 , ScopedTypeVariables
25 , ScopedTypeVariables
26 , TypeApplications
26 , TypeApplications
27 , TypeFamilies
27 , TypeFamilies
28+ , TypeFamilyDependencies
28 , TypeInType
29 , TypeInType
29 , TypeOperators
30 , TypeOperators
30 , UndecidableInstances
31 , UndecidableInstances
@@ -43,6 +44,7 @@ module Squeal.PostgreSQL.Binary
43 , Only (..)
44 , Only (..)
44 ) where
45 ) where
45
46
47+import BinaryParser
46import Data.Aeson hiding (Null)
48import Data.Aeson hiding (Null)
47import Data.Int
49import Data.Int
48import Data.Kind
50import Data.Kind
@@ -202,6 +204,63 @@ instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where
202 (Decoding.dimensionArray Vector.replicateM
204 (Decoding.dimensionArray Vector.replicateM
203 (Decoding.nullableValueArray (fromValue (Proxy @pg))))
205 (Decoding.nullableValueArray (fromValue (Proxy @pg))))
204
206
207+class IsMaybes (xs :: [Type]) where
208+ type family Maybes xs = (mxs :: [Type]) | mxs -> xs
209+ maybes :: NP Maybe xs -> NP I (Maybes xs)
210+
211+instance IsMaybes '[] where
212+ type Maybes '[] = '[]
213+ maybes Nil = Nil
214+
215+instance IsMaybes xs => IsMaybes (x ': xs) where
216+ type Maybes (x ': xs) = Maybe x ': Maybes xs
217+ maybes (x :* xs) = I x :* maybes xs
218+
219+class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where
220+ fromAliasedValue :: proxy pg -> Decoding.Value y
221+instance FromValue pg y => FromAliasedValue (alias ::: pg) y where
222+ fromAliasedValue _ = fromValue (Proxy @pg)
223+
224+instance
225+ ( SListI fields
226+ , IsMaybes ys
227+ , IsProductType y (Maybes ys)
228+ , AllZip FromAliasedValue fields ys
229+ , SameFields (DatatypeInfoOf y) fields
230+ ) => FromValue ('PGcomposite fields) y where
231+ fromValue = fmap (to . SOP . Z . maybes) . composite . decoders
232+
233+decoders
234+ :: forall pgs ys proxy
235+ . AllZip FromAliasedValue pgs ys
236+ => proxy ('PGcomposite pgs)
237+ -> NP Decoding.Value ys
238+decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue
239+ (hpure Proxy :: NP Proxy pgs)
240+
241+composite
242+ :: SListI ys
243+ => NP Decoding.Value ys
244+ -> Decoding.Value (NP Maybe ys)
245+composite decoders = do
246+-- [for each field]
247+-- <OID of field's type: sizeof(Oid) bytes>
248+-- [if value is NULL]
249+-- <-1: 4 bytes>
250+-- [else]
251+-- <length of value: 4 bytes>
252+-- <value: <length> bytes>
253+-- [end if]
254+-- [end for]
255+-- <number of fields: 4 bytes>
256+ unitOfSize 4
257+ let
258+ each decoder = do
259+ unitOfSize 4
260+ len <- sized 4 Decoding.int
261+ if len == -1 then return Nothing else Just <$> sized len decoder
262+ htraverse' each decoders
263+
205-- | A `FromColumnValue` constraint lifts the `FromValue` parser
264-- | A `FromColumnValue` constraint lifts the `FromValue` parser
206-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,
265-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,
207-- decoding `Null`s to `Maybe`s. You should not define instances for
266-- decoding `Null`s to `Maybe`s. You should not define instances for
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1−1
@@ -591,7 +591,7 @@ instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)
591-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same
591-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same
592-- field names as the column AliasesOf of a `ColumnsType`.
592-- field names as the column AliasesOf of a `ColumnsType`.
593type family SameFields
593type family SameFields
594− (datatypeInfo :: Type.DatatypeInfo) (columns :: RelationType)
594+ (datatypeInfo :: Type.DatatypeInfo) (columns :: [(Symbol,ty)])
595 :: Constraint where
595 :: Constraint where
596 SameFields
596 SameFields
597 ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])
597 ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])