diff --git a/hasql.cabal b/hasql.cabal index b251d9b..a53975c 100644 --- a/hasql.cabal +++ b/hasql.cabal @@ -68,7 +68,7 @@ library hashtables >=1.3 && <2, mtl >=2 && <3, network-ip >=0.3.0.3 && <0.4, - postgresql-binary >=0.13 && <0.14, + postgresql-binary >=0.13.1 && <0.14, postgresql-libpq ==0.9.*, profunctors >=5.1 && <6, scientific >=0.3 && <0.4, diff --git a/library/Hasql/Encoders.hs b/library/Hasql/Encoders.hs index 91c3142..f16b199 100644 --- a/library/Hasql/Encoders.hs +++ b/library/Hasql/Encoders.hs @@ -44,11 +44,16 @@ module Hasql.Encoders unknown, array, foldableArray, + composite, -- * Array Array, element, dimension, + + -- * Composite + Composite, + field, ) where diff --git a/library/Hasql/Private/Encoders.hs b/library/Hasql/Private/Encoders.hs index 6addf8a..0970b53 100644 --- a/library/Hasql/Private/Encoders.hs +++ b/library/Hasql/Private/Encoders.hs @@ -272,12 +272,23 @@ unknown :: Value ByteString unknown = Value (Value.unsafePTIWithShow PTI.unknown (const A.bytea_strict)) -- | --- Lift an array encoder into a parameter encoder. +-- Lift an array encoder into a value encoder. array :: Array a -> Value a array (Array (Array.Array valueOID arrayOID arrayEncoder renderer)) = let encoder env input = A.array (PTI.oidWord32 valueOID) (arrayEncoder env input) in Value (Value.Value arrayOID arrayOID encoder renderer) +-- | +-- Lift a composite encoder into a value encoder. +composite :: Composite a -> Value a +composite (Composite encode print) = + Value (Value.unsafePTI PTI.unknown encodeValue printValue) + where + encodeValue idt val = + A.composite $ encode val idt + printValue val = + "ROW (" <> C.intercalate ", " (print val) <> ")" + -- | -- Lift a value encoder of element into a unidimensional array encoder of a foldable value. -- @@ -340,3 +351,51 @@ element = \case {-# INLINEABLE dimension #-} dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c dimension foldl (Array imp) = Array (Array.dimension foldl imp) + +-- * Composite + +-- | +-- Composite or row-types encoder. +data Composite a + = Composite + (a -> Bool -> A.Composite) + (a -> [C.Builder]) + +instance Contravariant Composite where + contramap f (Composite encode print) = + Composite (encode . f) (print . f) + +instance Divisible Composite where + divide f (Composite encodeL printL) (Composite encodeR printR) = + Composite + (\val idt -> case f val of (lVal, rVal) -> encodeL lVal idt <> encodeR rVal idt) + (\val -> case f val of (lVal, rVal) -> printL lVal <> printR rVal) + conquer = mempty + +instance Semigroup (Composite a) where + Composite encodeL printL <> Composite encodeR printR = + Composite + (\val idt -> encodeL val idt <> encodeR val idt) + (\val -> printL val <> printR val) + +instance Monoid (Composite a) where + mempty = Composite mempty mempty + +-- | Single field of a row-type. +field :: NullableOrNot Value a -> Composite a +field = \case + NonNullable (Value (Value.Value elementOID arrayOID encode print)) -> + Composite + (\val idt -> A.field (PTI.oidWord32 elementOID) (encode idt val)) + (\val -> [print val]) + Nullable (Value (Value.Value elementOID arrayOID encode print)) -> + Composite + ( \val idt -> case val of + Nothing -> A.nullField (PTI.oidWord32 elementOID) + Just val -> A.field (PTI.oidWord32 elementOID) (encode idt val) + ) + ( \val -> + case val of + Nothing -> ["NULL"] + Just val -> [print val] + )