on dev help sign in
array work

* `ToFixArray` * `FromFixArray` * new `PGfixarray_` to replace `PGfixarray` * a couple instances

commit0bbafcc3849e4223a532d393d22e46919ed136bb authorEitan Chatav <eitan.chatav@gmail.com> dateWed 16 Jan 2019, 10:37 (8 years ago) parent559334b
2 files changed+68
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+67 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+67
@@ -397,6 +397,20 @@ class ToField (x :: (Symbol, Type)) (field :: (Symbol, NullityType)) where
397397instance ToNullityParam x ty => ToField (alias ::: x) (alias ::: ty) where
398398 toField (P x) = K . unK $ toNullityParam @x @ty x
399399
400+class ToFixArray (x :: Type) (dims :: [Nat]) (array :: NullityType) where
401+ toFixArray :: x -> K (K Encoding.Array dims) array
402+instance ToNullityParam x ty => ToFixArray x '[] ty where
403+ toFixArray = K . K . maybe Encoding.nullArray Encoding.encodingArray . unK
404+ . toNullityParam @x @ty
405+instance
406+ ( IsProductType product xs
407+ , Length xs ~ dim
408+ , All ((~) x) xs
409+ , ToFixArray x dims ty )
410+ => ToFixArray product (dim ': dims) ty where
411+ toFixArray = K . K . Encoding.dimensionArray foldlN
412+ (unK . unK . toFixArray @x @dims @ty) . unZ . unSOP . from
413+
400414class ToArray (x :: Type) (array :: NullityType) where
401415 toArray :: x -> K Encoding.Array array
402416 baseOid :: Word32
@@ -501,6 +515,41 @@ instance Aeson.FromJSON x => FromValue 'PGjson (Json x) where
501515instance Aeson.FromJSON x => FromValue 'PGjsonb (Jsonb x) where
502516 fromValue = Jsonb <$>
503517 Decoding.jsonb_bytes (left Strict.Text.pack . Aeson.eitherDecodeStrict)
518+instance FromValue pg y
519+ => FromValue ('PGvararray ('NotNull pg)) (VarArray (Vector y)) where
520+ fromValue =
521+ let
522+ rep n x = VarArray <$> Vector.replicateM n x
523+ in
524+ Decoding.array $ Decoding.dimensionArray rep
525+ (fromFixArray @'[] @('NotNull pg))
526+instance FromValue pg y
527+ => FromValue ('PGvararray ('Null pg)) (VarArray (Vector (Maybe y))) where
528+ fromValue =
529+ let
530+ rep n x = VarArray <$> Vector.replicateM n x
531+ in
532+ Decoding.array $ Decoding.dimensionArray rep
533+ (fromFixArray @'[] @('Null pg))
534+instance FromValue pg y
535+ => FromValue ('PGvararray ('NotNull pg)) (VarArray [y]) where
536+ fromValue =
537+ let
538+ rep n x = VarArray <$> replicateM n x
539+ in
540+ Decoding.array $ Decoding.dimensionArray rep
541+ (fromFixArray @'[] @('NotNull pg))
542+instance FromValue pg y
543+ => FromValue ('PGvararray ('Null pg)) (VarArray [Maybe y]) where
544+ fromValue =
545+ let
546+ rep n x = VarArray <$> replicateM n x
547+ in
548+ Decoding.array $ Decoding.dimensionArray rep
549+ (fromFixArray @'[] @('Null pg))
550+instance FromFixArray dims ty y
551+ => FromValue ('PGfixarray_ dims ty) (FixArray y) where
552+ fromValue = FixArray <$> Decoding.array (fromFixArray @dims @ty @y)
504553instance FromArray ('NotNull ('PGvararray ty)) y
505554 => FromValue ('PGvararray ty) y where
506555 fromValue = Decoding.array (fromArray @('NotNull ('PGvararray ty)) @y)
@@ -577,6 +626,24 @@ instance FromValue pg y
577626 K (Just bytestring) -> P . Just <$>
578627 Decoding.valueParser (fromValue @pg) bytestring
579628
629+class FromFixArray (dims :: [Nat]) (ty :: NullityType) (y :: Type) where
630+ fromFixArray :: Decoding.Array y
631+instance FromValue pg y => FromFixArray '[] ('NotNull pg) y where
632+ fromFixArray = Decoding.valueArray (fromValue @pg @y)
633+instance FromValue pg y => FromFixArray '[] ('Null pg) (Maybe y) where
634+ fromFixArray = Decoding.nullableValueArray (fromValue @pg @y)
635+instance
636+ ( IsProductType product ys
637+ , Length ys ~ dim
638+ , All ((~) y) ys
639+ , FromFixArray dims ty y )
640+ => FromFixArray (dim ': dims) ty product where
641+ fromFixArray =
642+ let
643+ rep _ = fmap (to . SOP . Z) . replicateMN
644+ in
645+ Decoding.dimensionArray rep (fromFixArray @dims @ty @y)
646+
580647class FromArray (ty :: NullityType) (y :: Type) where
581648 fromArray :: Decoding.Array y
582649instance {-# OVERLAPPABLE #-} FromValue pg y
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1
@@ -176,6 +176,7 @@ data PGType
176176 | PGjsonb -- ^ binary JSON data, decomposed
177177 | PGvararray NullityType -- ^ variable length array
178178 | PGfixarray Nat NullityType -- ^ fixed length array
179+ | PGfixarray_ [Nat] NullityType -- ^ fixed length array
179180 | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.
180181 | PGcomposite RowType -- ^ a composite type represents the structure of a row or record; it is essentially just a list of field names and their data types.
181182 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types