Redesign decoders

benchmarks/Main.hs

@@ -79,7 +79,7 @@ statementWithSingleRow =
       D.singleRow row
       where
         row =
-          tuple <$> D.column D.int8 <*> D.column D.int8
+          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8
           where
             tuple !a !b =
               (a, b)
@@ -93,7 +93,7 @@ statementWithManyRows decoder =
     encoder =
       conquer
     rowDecoder =
-      tuple <$> D.column D.int8 <*> D.column D.int8
+      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8
       where
         tuple !a !b =
           (a, b)

hasql.cabal

@@ -40,6 +40,7 @@ library
     Hasql.Private.PreparedStatementRegistry
     Hasql.Private.Settings
     Hasql.Private.Commands
+    Hasql.Private.Decoders
     Hasql.Private.Decoders.Array
     Hasql.Private.Decoders.Composite
     Hasql.Private.Decoders.Value

library/Hasql/Decoders.hs

@@ -1,5 +1,6 @@
--- |
--- A DSL for declaration of result decoders.
+{-|
+A DSL for declaration of result decoders.
+-}
 module Hasql.Decoders
 (
   -- * Result
@@ -17,7 +18,10 @@ module Hasql.Decoders
   -- * Row
   Row,
   column,
-  nullableColumn,
+  -- * Nullability
+  NullableOrNot,
+  nonNullable,
+  nullable,
   -- * Value
   Value,
   bool,
@@ -51,474 +55,10 @@ module Hasql.Decoders
   Array,
   dimension,
   element,
-  nullableElement,
   -- * Composite
   Composite,
   field,
-  nullableField,
 )
 where
 
-import Hasql.Private.Prelude hiding (maybe, bool)
-import qualified Data.Vector as Vector
-import qualified PostgreSQL.Binary.Decoding as A
-import qualified PostgreSQL.Binary.Data as B
-import qualified Hasql.Private.Decoders.Results as Results
-import qualified Hasql.Private.Decoders.Result as Result
-import qualified Hasql.Private.Decoders.Row as Row
-import qualified Hasql.Private.Decoders.Value as Value
-import qualified Hasql.Private.Decoders.Array as Array
-import qualified Hasql.Private.Decoders.Composite as Composite
-import qualified Hasql.Private.Prelude as Prelude
-
--- * Result
--------------------------
-
--- |
--- Decoder of a query result.
--- 
-newtype Result a =
-  Result (Results.Results a)
-  deriving (Functor)
-
--- |
--- Decode no value from the result.
--- 
--- Useful for statements like @INSERT@ or @CREATE@.
--- 
-{-# INLINABLE unit #-}
-unit :: Result ()
-unit =
-  Result (Results.single Result.unit)
-
--- |
--- Get the amount of rows affected by such statements as
--- @UPDATE@ or @DELETE@.
--- 
-{-# INLINABLE rowsAffected #-}
-rowsAffected :: Result Int64
-rowsAffected =
-  Result (Results.single Result.rowsAffected)
-
--- |
--- Exactly one row.
--- Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other.
--- 
-{-# INLINABLE singleRow #-}
-singleRow :: Row a -> Result a
-singleRow (Row row) =
-  Result (Results.single (Result.single row))
-
--- ** Multi-row traversers
--------------------------
-
--- |
--- Foldl multiple rows.
--- 
-{-# INLINABLE foldlRows #-}
-foldlRows :: (a -> b -> a) -> a -> Row b -> Result a
-foldlRows step init (Row row) =
-  Result (Results.single (Result.foldl step init row))
-
--- |
--- Foldr multiple rows.
--- 
-{-# INLINABLE foldrRows #-}
-foldrRows :: (b -> a -> a) -> a -> Row b -> Result a
-foldrRows step init (Row row) =
-  Result (Results.single (Result.foldr step init row))
-
--- ** Specialized multi-row results
--------------------------
-
--- |
--- Maybe one row or none.
--- 
-{-# INLINABLE rowMaybe #-}
-rowMaybe :: Row a -> Result (Maybe a)
-rowMaybe (Row row) =
-  Result (Results.single (Result.maybe row))
-
--- |
--- Zero or more rows packed into the vector.
--- 
--- It's recommended to prefer this function to 'rowList',
--- since it performs notably better.
--- 
-{-# INLINABLE rowVector #-}
-rowVector :: Row a -> Result (Vector a)
-rowVector (Row row) =
-  Result (Results.single (Result.vector row))
-
--- |
--- Zero or more rows packed into the list.
--- 
-{-# INLINABLE rowList #-}
-rowList :: Row a -> Result [a]
-rowList =
-  foldrRows strictCons []
-
-
--- * Row
--------------------------
-
--- |
--- Decoder of an individual row,
--- which gets composed of column value decoders.
--- 
--- E.g.:
--- 
--- >x :: Row (Maybe Int64, Text, TimeOfDay)
--- >x =
--- >  (,,) <$> nullableColumn int8 <*> column text <*> column time
--- 
-newtype Row a =
-  Row (Row.Row a)
-  deriving (Functor, Applicative, Monad)
-
--- |
--- Lift an individual non-nullable value decoder to a composable row decoder.
--- 
-{-# INLINABLE column #-}
-column :: Value a -> Row a
-column (Value imp) =
-  Row (Row.nonNullValue imp)
-
--- |
--- Lift an individual nullable value decoder to a composable row decoder.
--- 
-{-# INLINABLE nullableColumn #-}
-nullableColumn :: Value a -> Row (Maybe a)
-nullableColumn (Value imp) =
-  Row (Row.value imp)
-
-
--- * Value
--------------------------
-
--- |
--- Decoder of an individual value.
--- 
-newtype Value a =
-  Value (Value.Value a)
-  deriving (Functor)
-
-
--- ** Plain value decoders
--------------------------
-
--- |
--- Decoder of the @BOOL@ values.
--- 
-{-# INLINABLE bool #-}
-bool :: Value Bool
-bool =
-  Value (Value.decoder (const A.bool))
-
--- |
--- Decoder of the @INT2@ values.
--- 
-{-# INLINABLE int2 #-}
-int2 :: Value Int16
-int2 =
-  Value (Value.decoder (const A.int))
-
--- |
--- Decoder of the @INT4@ values.
--- 
-{-# INLINABLE int4 #-}
-int4 :: Value Int32
-int4 =
-  Value (Value.decoder (const A.int))
-
--- |
--- Decoder of the @INT8@ values.
--- 
-{-# INLINABLE int8 #-}
-int8 :: Value Int64
-int8 =
-  {-# SCC "int8" #-} 
-  Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))
-
--- |
--- Decoder of the @FLOAT4@ values.
--- 
-{-# INLINABLE float4 #-}
-float4 :: Value Float
-float4 =
-  Value (Value.decoder (const A.float4))
-
--- |
--- Decoder of the @FLOAT8@ values.
--- 
-{-# INLINABLE float8 #-}
-float8 :: Value Double
-float8 =
-  Value (Value.decoder (const A.float8))
-
--- |
--- Decoder of the @NUMERIC@ values.
--- 
-{-# INLINABLE numeric #-}
-numeric :: Value B.Scientific
-numeric =
-  Value (Value.decoder (const A.numeric))
-
--- |
--- Decoder of the @CHAR@ values.
--- Note that it supports UTF-8 values.
-{-# INLINABLE char #-}
-char :: Value Char
-char =
-  Value (Value.decoder (const A.char))
-
--- |
--- Decoder of the @TEXT@ values.
--- 
-{-# INLINABLE text #-}
-text :: Value Text
-text =
-  Value (Value.decoder (const A.text_strict))
-
--- |
--- Decoder of the @BYTEA@ values.
--- 
-{-# INLINABLE bytea #-}
-bytea :: Value ByteString
-bytea =
-  Value (Value.decoder (const A.bytea_strict))
-
--- |
--- Decoder of the @DATE@ values.
--- 
-{-# INLINABLE date #-}
-date :: Value B.Day
-date =
-  Value (Value.decoder (const A.date))
-
--- |
--- Decoder of the @TIMESTAMP@ values.
--- 
-{-# INLINABLE timestamp #-}
-timestamp :: Value B.LocalTime
-timestamp =
-  Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))
-
--- |
--- Decoder of the @TIMESTAMPTZ@ values.
--- 
--- /NOTICE/
--- 
--- Postgres does not store the timezone information of @TIMESTAMPTZ@.
--- Instead it stores a UTC value and performs silent conversions
--- to the currently set timezone, when dealt with in the text format.
--- However this library bypasses the silent conversions
--- and communicates with Postgres using the UTC values directly.
-{-# INLINABLE timestamptz #-}
-timestamptz :: Value B.UTCTime
-timestamptz =
-  Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))
-
--- |
--- Decoder of the @TIME@ values.
--- 
-{-# INLINABLE time #-}
-time :: Value B.TimeOfDay
-time =
-  Value (Value.decoder (Prelude.bool A.time_float A.time_int))
-
--- |
--- Decoder of the @TIMETZ@ values.
--- 
--- Unlike in case of @TIMESTAMPTZ@, 
--- Postgres does store the timezone information for @TIMETZ@.
--- However the Haskell's \"time\" library does not contain any composite type,
--- that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'
--- to represent a value on the Haskell's side.
-{-# INLINABLE timetz #-}
-timetz :: Value (B.TimeOfDay, B.TimeZone)
-timetz =
-  Value (Value.decoder (Prelude.bool A.timetz_float A.timetz_int))
-
--- |
--- Decoder of the @INTERVAL@ values.
--- 
-{-# INLINABLE interval #-}
-interval :: Value B.DiffTime
-interval =
-  Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))
-
--- |
--- Decoder of the @UUID@ values.
--- 
-{-# INLINABLE uuid #-}
-uuid :: Value B.UUID
-uuid =
-  Value (Value.decoder (const A.uuid))
-
--- |
--- Decoder of the @INET@ values.
---
-{-# INLINABLE inet #-}
-inet :: Value (B.NetAddr B.IP)
-inet =
-  Value (Value.decoder (const A.inet))
-
--- |
--- Decoder of the @JSON@ values into a JSON AST.
--- 
-{-# INLINABLE json #-}
-json :: Value B.Value
-json =
-  Value (Value.decoder (const A.json_ast))
-
--- |
--- Decoder of the @JSON@ values into a raw JSON 'ByteString'.
--- 
-{-# INLINABLE jsonBytes #-}
-jsonBytes :: (ByteString -> Either Text a) -> Value a
-jsonBytes fn =
-  Value (Value.decoder (const (A.json_bytes fn)))
-
--- |
--- Decoder of the @JSONB@ values into a JSON AST.
--- 
-{-# INLINABLE jsonb #-}
-jsonb :: Value B.Value
-jsonb =
-  Value (Value.decoder (const A.jsonb_ast))
-
--- |
--- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.
--- 
-{-# INLINABLE jsonbBytes #-}
-jsonbBytes :: (ByteString -> Either Text a) -> Value a
-jsonbBytes fn =
-  Value (Value.decoder (const (A.jsonb_bytes fn)))
-
--- |
--- Lifts a custom value decoder function to a 'Value' decoder.
--- 
-{-# INLINABLE custom #-}
-custom :: (Bool -> ByteString -> Either Text a) -> Value a
-custom fn =
-  Value (Value.decoderFn fn)
-
-
--- ** Composite value decoders
--------------------------
-
--- |
--- Lifts the 'Array' decoder to the 'Value' decoder.
--- 
-{-# INLINABLE array #-}
-array :: Array a -> Value a
-array (Array imp) =
-  Value (Value.decoder (Array.run imp))
-
--- |
--- Lifts the 'Composite' decoder to the 'Value' decoder.
--- 
-{-# INLINABLE composite #-}
-composite :: Composite a -> Value a
-composite (Composite imp) =
-  Value (Value.decoder (Composite.run imp))
-
--- |
--- A generic decoder of @HSTORE@ values.
--- 
--- Here's how you can use it to construct a specific value:
--- 
--- @
--- x :: Value [(Text, Maybe Text)]
--- x =
---   hstore 'replicateM'
--- @
--- 
-{-# INLINABLE hstore #-}
-hstore :: (forall m. Monad m => Int -> m (Text, Maybe Text) -> m a) -> Value a
-hstore replicateM =
-  Value (Value.decoder (const (A.hstore replicateM A.text_strict A.text_strict)))
-
--- |
--- Given a partial mapping from text to value,
--- produces a decoder of that value.
-enum :: (Text -> Maybe a) -> Value a
-enum mapping =
-  Value (Value.decoder (const (A.enum mapping)))
-
-
--- * Array decoders
--------------------------
-
--- |
--- A generic array decoder.
--- 
--- Here's how you can use it to produce a specific array value decoder:
--- 
--- @
--- x :: Value [[Text]]
--- x =
---   array (dimension 'replicateM' (dimension 'replicateM' (element text)))
--- @
--- 
-newtype Array a =
-  Array (Array.Array a)
-  deriving (Functor)
-
--- |
--- A function for parsing a dimension of an array.
--- Provides support for multi-dimensional arrays.
--- 
--- Accepts:
--- 
--- * An implementation of the @replicateM@ function
--- (@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),
--- which determines the output value.
--- 
--- * A decoder of its components, which can be either another 'dimension',
--- 'element' or 'nullableElement'.
--- 
-{-# INLINABLE dimension #-}
-dimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b
-dimension replicateM (Array imp) =
-  Array (Array.dimension replicateM imp)
-
--- |
--- Lift a 'Value' decoder into an 'Array' decoder for parsing of non-nullable leaf values.
-{-# INLINABLE element #-}
-element :: Value a -> Array a
-element (Value imp) =
-  Array (Array.nonNullValue (Value.run imp))
-
--- |
--- Lift a 'Value' decoder into an 'Array' decoder for parsing of nullable leaf values.
-{-# INLINABLE nullableElement #-}
-nullableElement :: Value a -> Array (Maybe a)
-nullableElement (Value imp) =
-  Array (Array.value (Value.run imp))
-
-
--- * Composite decoders
--------------------------
-
--- |
--- Composable decoder of composite values (rows, records).
-newtype Composite a =
-  Composite (Composite.Composite a)
-  deriving (Functor, Applicative, Monad)
-
--- |
--- Lift a 'Value' decoder into a 'Composite' decoder for parsing of non-nullable leaf values.
-{-# INLINABLE field #-}
-field :: Value a -> Composite a
-field (Value imp) =
-  Composite (Composite.nonNullValue (Value.run imp))
-
--- |
--- Lift a 'Value' decoder into a 'Composite' decoder for parsing of nullable leaf values.
-{-# INLINABLE nullableField #-}
-nullableField :: Value a -> Composite (Maybe a)
-nullableField (Value imp) =
-  Composite (Composite.value (Value.run imp))
-
+import Hasql.Private.Decoders

library/Hasql/Private/Decoders.hs

@@ -0,0 +1,428 @@
+{-|
+A DSL for declaration of result decoders.
+-}
+module Hasql.Private.Decoders
+where
+
+import Hasql.Private.Prelude hiding (maybe, bool)
+import qualified Data.Vector as Vector
+import qualified PostgreSQL.Binary.Decoding as A
+import qualified PostgreSQL.Binary.Data as B
+import qualified Hasql.Private.Decoders.Results as Results
+import qualified Hasql.Private.Decoders.Result as Result
+import qualified Hasql.Private.Decoders.Row as Row
+import qualified Hasql.Private.Decoders.Value as Value
+import qualified Hasql.Private.Decoders.Array as Array
+import qualified Hasql.Private.Decoders.Composite as Composite
+import qualified Hasql.Private.Prelude as Prelude
+
+-- * Result
+-------------------------
+
+{-|
+Decoder of a query result.
+-}
+newtype Result a = Result (Results.Results a) deriving (Functor)
+
+{-|
+Decode no value from the result.
+
+Useful for statements like @INSERT@ or @CREATE@.
+-}
+{-# INLINABLE unit #-}
+unit :: Result ()
+unit = Result (Results.single Result.unit)
+
+{-|
+Get the amount of rows affected by such statements as
+@UPDATE@ or @DELETE@.
+-}
+{-# INLINABLE rowsAffected #-}
+rowsAffected :: Result Int64
+rowsAffected = Result (Results.single Result.rowsAffected)
+
+{-|
+Exactly one row.
+Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other.
+-}
+{-# INLINABLE singleRow #-}
+singleRow :: Row a -> Result a
+singleRow (Row row) = Result (Results.single (Result.single row))
+
+-- ** Multi-row traversers
+-------------------------
+
+{-|
+Foldl multiple rows.
+-}
+{-# INLINABLE foldlRows #-}
+foldlRows :: (a -> b -> a) -> a -> Row b -> Result a
+foldlRows step init (Row row) = Result (Results.single (Result.foldl step init row))
+
+{-|
+Foldr multiple rows.
+-}
+{-# INLINABLE foldrRows #-}
+foldrRows :: (b -> a -> a) -> a -> Row b -> Result a
+foldrRows step init (Row row) = Result (Results.single (Result.foldr step init row))
+
+-- ** Specialized multi-row results
+-------------------------
+
+{-|
+Maybe one row or none.
+-}
+{-# INLINABLE rowMaybe #-}
+rowMaybe :: Row a -> Result (Maybe a)
+rowMaybe (Row row) = Result (Results.single (Result.maybe row))
+
+{-|
+Zero or more rows packed into the vector.
+
+It's recommended to prefer this function to 'rowList',
+since it performs notably better.
+-}
+{-# INLINABLE rowVector #-}
+rowVector :: Row a -> Result (Vector a)
+rowVector (Row row) = Result (Results.single (Result.vector row))
+
+{-|
+Zero or more rows packed into the list.
+-}
+{-# INLINABLE rowList #-}
+rowList :: Row a -> Result [a]
+rowList = foldrRows strictCons []
+
+
+-- * Row
+-------------------------
+
+{-|
+Decoder of an individual row,
+which gets composed of column value decoders.
+
+E.g.:
+
+>x :: Row (Maybe Int64, Text, TimeOfDay)
+>x =
+>  (,,) <$> nullableColumn int8 <*> column text <*> column time
+-}
+newtype Row a =
+  Row (Row.Row a)
+  deriving (Functor, Applicative, Monad)
+
+{-|
+Lift an individual non-nullable value decoder to a composable row decoder.
+-}
+{-# INLINABLE column #-}
+column :: NullableOrNot Value a -> Row a
+column = \ case
+  NonNullable (Value imp) -> Row (Row.nonNullValue imp)
+  Nullable (Value imp) -> Row (Row.value imp)
+
+
+-- * Nullability
+-------------------------
+
+{-|
+Extensional specification of nullability over a generic decoder.
+-}
+data NullableOrNot decoder a where
+  NonNullable :: decoder a -> NullableOrNot decoder a
+  Nullable :: decoder a -> NullableOrNot decoder (Maybe a)
+
+{-|
+Specify that a decoder produces a non-nullable value.
+-}
+nonNullable :: decoder a -> NullableOrNot decoder a
+nonNullable = NonNullable
+
+{-|
+Specify that a decoder produces a nullable value.
+-}
+nullable :: decoder a -> NullableOrNot decoder (Maybe a)
+nullable = Nullable
+
+
+-- * Value
+-------------------------
+
+{-|
+Decoder of a value.
+-}
+newtype Value a = Value (Value.Value a)
+  deriving (Functor)
+
+{-|
+Decoder of the @BOOL@ values.
+-}
+{-# INLINABLE bool #-}
+bool :: Value Bool
+bool = Value (Value.decoder (const A.bool))
+
+{-|
+Decoder of the @INT2@ values.
+-}
+{-# INLINABLE int2 #-}
+int2 :: Value Int16
+int2 = Value (Value.decoder (const A.int))
+
+{-|
+Decoder of the @INT4@ values.
+-}
+{-# INLINABLE int4 #-}
+int4 :: Value Int32
+int4 = Value (Value.decoder (const A.int))
+
+{-|
+Decoder of the @INT8@ values.
+-}
+{-# INLINABLE int8 #-}
+int8 :: Value Int64
+int8 = {-# SCC "int8" #-}
+  Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))
+
+{-|
+Decoder of the @FLOAT4@ values.
+-}
+{-# INLINABLE float4 #-}
+float4 :: Value Float
+float4 = Value (Value.decoder (const A.float4))
+
+{-|
+Decoder of the @FLOAT8@ values.
+-}
+{-# INLINABLE float8 #-}
+float8 :: Value Double
+float8 = Value (Value.decoder (const A.float8))
+
+{-|
+Decoder of the @NUMERIC@ values.
+-}
+{-# INLINABLE numeric #-}
+numeric :: Value B.Scientific
+numeric = Value (Value.decoder (const A.numeric))
+
+{-|
+Decoder of the @CHAR@ values.
+Note that it supports UTF-8 values.
+-}
+{-# INLINABLE char #-}
+char :: Value Char
+char = Value (Value.decoder (const A.char))
+
+{-|
+Decoder of the @TEXT@ values.
+-}
+{-# INLINABLE text #-}
+text :: Value Text
+text = Value (Value.decoder (const A.text_strict))
+
+{-|
+Decoder of the @BYTEA@ values.
+-}
+{-# INLINABLE bytea #-}
+bytea :: Value ByteString
+bytea = Value (Value.decoder (const A.bytea_strict))
+
+{-|
+Decoder of the @DATE@ values.
+-}
+{-# INLINABLE date #-}
+date :: Value B.Day
+date = Value (Value.decoder (const A.date))
+
+{-|
+Decoder of the @TIMESTAMP@ values.
+-}
+{-# INLINABLE timestamp #-}
+timestamp :: Value B.LocalTime
+timestamp = Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))
+
+{-|
+Decoder of the @TIMESTAMPTZ@ values.
+
+/NOTICE/
+
+Postgres does not store the timezone information of @TIMESTAMPTZ@.
+Instead it stores a UTC value and performs silent conversions
+to the currently set timezone, when dealt with in the text format.
+However this library bypasses the silent conversions
+and communicates with Postgres using the UTC values directly.
+-}
+{-# INLINABLE timestamptz #-}
+timestamptz :: Value B.UTCTime
+timestamptz = Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))
+
+{-|
+Decoder of the @TIME@ values.
+-}
+{-# INLINABLE time #-}
+time :: Value B.TimeOfDay
+time = Value (Value.decoder (Prelude.bool A.time_float A.time_int))
+
+{-|
+Decoder of the @TIMETZ@ values.
+
+Unlike in case of @TIMESTAMPTZ@, 
+Postgres does store the timezone information for @TIMETZ@.
+However the Haskell's \"time\" library does not contain any composite type,
+that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'
+to represent a value on the Haskell's side.
+-}
+{-# INLINABLE timetz #-}
+timetz :: Value (B.TimeOfDay, B.TimeZone)
+timetz = Value (Value.decoder (Prelude.bool A.timetz_float A.timetz_int))
+
+{-|
+Decoder of the @INTERVAL@ values.
+-}
+{-# INLINABLE interval #-}
+interval :: Value B.DiffTime
+interval = Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))
+
+{-|
+Decoder of the @UUID@ values.
+-}
+{-# INLINABLE uuid #-}
+uuid :: Value B.UUID
+uuid = Value (Value.decoder (const A.uuid))
+
+{-|
+Decoder of the @INET@ values.
+-}
+{-# INLINABLE inet #-}
+inet :: Value (B.NetAddr B.IP)
+inet = Value (Value.decoder (const A.inet))
+
+{-|
+Decoder of the @JSON@ values into a JSON AST.
+-}
+{-# INLINABLE json #-}
+json :: Value B.Value
+json = Value (Value.decoder (const A.json_ast))
+
+{-|
+Decoder of the @JSON@ values into a raw JSON 'ByteString'.
+-}
+{-# INLINABLE jsonBytes #-}
+jsonBytes :: (ByteString -> Either Text a) -> Value a
+jsonBytes fn = Value (Value.decoder (const (A.json_bytes fn)))
+
+{-|
+Decoder of the @JSONB@ values into a JSON AST.
+-}
+{-# INLINABLE jsonb #-}
+jsonb :: Value B.Value
+jsonb = Value (Value.decoder (const A.jsonb_ast))
+
+{-|
+Decoder of the @JSONB@ values into a raw JSON 'ByteString'.
+-}
+{-# INLINABLE jsonbBytes #-}
+jsonbBytes :: (ByteString -> Either Text a) -> Value a
+jsonbBytes fn = Value (Value.decoder (const (A.jsonb_bytes fn)))
+
+{-|
+Lifts a custom value decoder function to a 'Value' decoder.
+-}
+{-# INLINABLE custom #-}
+custom :: (Bool -> ByteString -> Either Text a) -> Value a
+custom fn = Value (Value.decoderFn fn)
+
+{-|
+A generic decoder of @HSTORE@ values.
+
+Here's how you can use it to construct a specific value:
+
+@
+x :: Value [(Text, Maybe Text)]
+x = hstore 'replicateM'
+@
+-}
+{-# INLINABLE hstore #-}
+hstore :: (forall m. Monad m => Int -> m (Text, Maybe Text) -> m a) -> Value a
+hstore replicateM = Value (Value.decoder (const (A.hstore replicateM A.text_strict A.text_strict)))
+
+{-|
+Given a partial mapping from text to value,
+produces a decoder of that value.
+-}
+enum :: (Text -> Maybe a) -> Value a
+enum mapping = Value (Value.decoder (const (A.enum mapping)))
+
+{-|
+Lifts the 'Array' decoder to a 'Value' decoder.
+-}
+{-# INLINABLE array #-}
+array :: Array a -> Value a
+array (Array imp) = Value (Value.decoder (Array.run imp))
+
+{-|
+Lifts the 'Composite' decoder to a 'Value' decoder.
+-}
+{-# INLINABLE composite #-}
+composite :: Composite a -> Value a
+composite (Composite imp) = Value (Value.decoder (Composite.run imp))
+
+
+-- * Array decoders
+-------------------------
+
+{-|
+A generic array decoder.
+
+Here's how you can use it to produce a specific array value decoder:
+
+@
+x :: Value [[Text]]
+x =
+  array (dimension 'replicateM' (dimension 'replicateM' (element text)))
+@
+-}
+newtype Array a = Array (Array.Array a)
+  deriving (Functor)
+
+{-|
+A function for parsing a dimension of an array.
+Provides support for multi-dimensional arrays.
+
+Accepts:
+
+* An implementation of the @replicateM@ function
+(@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),
+which determines the output value.
+
+* A decoder of its components, which can be either another 'dimension',
+'element' or 'nullableElement'.
+-}
+{-# INLINABLE dimension #-}
+dimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b
+dimension replicateM (Array imp) = Array (Array.dimension replicateM imp)
+
+{-|
+Lift a 'Value' decoder into an 'Array' decoder for parsing of leaf values.
+-}
+{-# INLINABLE element #-}
+element :: NullableOrNot Value a -> Array a
+element = \ case
+  NonNullable (Value imp) -> Array (Array.nonNullValue (Value.run imp))
+  Nullable (Value imp) -> Array (Array.value (Value.run imp))
+
+
+-- * Composite decoders
+-------------------------
+
+{-|
+Composable decoder of composite values (rows, records).
+-}
+newtype Composite a = Composite (Composite.Composite a)
+  deriving (Functor, Applicative, Monad)
+
+{-|
+Lift a 'Value' decoder into a 'Composite' decoder for parsing of non-nullable leaf values.
+-}
+field :: NullableOrNot Value a -> Composite a
+field = \ case
+  NonNullable (Value imp) -> Composite (Composite.nonNullValue (Value.run imp))
+  Nullable (Value imp) -> Composite (Composite.value (Value.run imp))

profiling/Main.hs

@@ -70,7 +70,7 @@ statementWithSingleRow =
       D.singleRow row
       where
         row =
-          tuple <$> D.column D.int8 <*> D.column D.int8
+          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8
           where
             tuple !a !b =
               (a, b)
@@ -84,7 +84,7 @@ statementWithManyRows decoder =
     encoder =
       conquer
     rowDecoder =
-      tuple <$> D.column D.int8 <*> D.column D.int8
+      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8
       where
         tuple !a !b =
           (a, b)

tasty/Main.hs

@@ -32,7 +32,7 @@ tree =
               (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))
               (Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.text)))
           decoder =
-            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))
+            fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))
       session =
         Session.statement ([3, 7], "a") statement
       in do
@@ -49,7 +49,7 @@ tree =
           encoder =
             Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))
           decoder =
-            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))
+            fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))
       session =
         do
           result1 <- Session.statement [1, 2] statement
@@ -67,7 +67,7 @@ tree =
           encoder =
             Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))
           decoder =
-            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))
+            fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))
       session =
         do
           result1 <- Session.statement [1, 2] statement
@@ -87,7 +87,7 @@ tree =
           encoder = 
             mempty
           decoder =
-            Decoders.singleRow (Decoders.column (Decoders.composite ((,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool)))
+            Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.composite ((,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool)))
       session =
         Session.statement () statement
       in do
@@ -105,14 +105,14 @@ tree =
             mempty
           decoder =
             Decoders.singleRow $
-            (,) <$> Decoders.column entity1 <*> Decoders.column entity2
+            (,) <$> (Decoders.column . Decoders.nonNullable) entity1 <*> (Decoders.column . Decoders.nonNullable) entity2
             where
               entity1 =
                 Decoders.composite $
-                (,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool
+                (,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool
               entity2 =
                 Decoders.composite $
-                (,) <$> Decoders.field Decoders.text <*> Decoders.field Decoders.int8
+                (,) <$> (Decoders.field . Decoders.nonNullable) Decoders.text <*> (Decoders.field . Decoders.nonNullable) Decoders.int8
       session =
         Session.statement () statement
       in do
@@ -137,7 +137,7 @@ tree =
                   encoder =
                     mempty
                   decoder =
-                    Decoders.singleRow (Decoders.column (Decoders.array (Decoders.dimension replicateM (Decoders.element Decoders.int8))))
+                    Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))
       in io
     ,
     testCase "Failing prepared statements" $
@@ -187,7 +187,7 @@ tree =
                       encoder =
                         Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.int8))
                       decoder =
-                        Decoders.singleRow $ Decoders.column Decoders.int8
+                        Decoders.singleRow $ (Decoders.column . Decoders.nonNullable) Decoders.int8
               fail =
                 catchError (Session.sql "absurd") (const (pure ()))
       in io
@@ -204,7 +204,7 @@ tree =
             contramap fst (Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.int8))) <>
             contramap snd (Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.int8)))
           decoder =
-            Decoders.singleRow (Decoders.column Decoders.int8)
+            Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)
       sumSession :: Session.Session Int64
       sumSession =
         Session.sql "begin" *> Session.statement (1, 1) sumStatement <* Session.sql "end"
@@ -229,7 +229,7 @@ tree =
             contramap fst (Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.int8))) <>
             contramap snd (Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.int8)))
           decoder =
-            Decoders.singleRow (Decoders.column Decoders.int8)
+            Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)
       session :: Session.Session Int64
       session =
         do
@@ -253,7 +253,7 @@ tree =
                 sql =
                   "select $1 = interval '10 seconds'"
                 decoder =
-                  (Decoders.singleRow (Decoders.column (Decoders.bool)))
+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))
                 encoder =
                   Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.interval))
             in DSL.statement (10 :: DiffTime) statement
@@ -270,7 +270,7 @@ tree =
                 sql =
                   "select interval '10 seconds'"
                 decoder =
-                  (Decoders.singleRow (Decoders.column (Decoders.interval)))
+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))
                 encoder =
                   Encoders.noParams
             in DSL.statement () statement
@@ -287,7 +287,7 @@ tree =
                 sql =
                   "select $1"
                 decoder =
-                  (Decoders.singleRow (Decoders.column (Decoders.interval)))
+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))
                 encoder =
                   Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.interval))
             in DSL.statement (10 :: DiffTime) statement
@@ -318,7 +318,7 @@ tree =
                 sql =
                   "select $1 = ('ok' :: mood)"
                 decoder =
-                  (Decoders.singleRow (Decoders.column (Decoders.bool)))
+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))
                 encoder =
                   Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.unknown))
             in DSL.statement "ok" statement
@@ -349,7 +349,7 @@ tree =
                 sql =
                   "select overloaded($1, $2) || overloaded($3, $4, $5)"
                 decoder =
-                  (Decoders.singleRow (Decoders.column (Decoders.text)))
+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))
                 encoder =
                   contramany (Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.unknown)))
             in DSL.statement ["1", "2", "4", "5", "6"] statement
@@ -380,7 +380,7 @@ tree =
                 sql =
                   "select ($1 :: mood)"
                 decoder =
-                  (Decoders.singleRow (Decoders.column (Decoders.enum (Just . id))))
+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.enum (Just . id))))
                 encoder =
                   Encoders.param (Encoders.nonNullable (Encoders.primitive (Encoders.enum id)))
             in DSL.statement "ok" statement
@@ -402,7 +402,7 @@ tree =
                     encoder =
                       Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.text))
                     decoder =
-                      (Decoders.singleRow (Decoders.column (Decoders.text)))
+                      (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))
             effect2 =
               DSL.statement 1 statement
               where
@@ -414,7 +414,7 @@ tree =
                     encoder =
                       Encoders.param (Encoders.nonNullable (Encoders.primitive Encoders.int8))
                     decoder =
-                      (Decoders.singleRow (Decoders.column Decoders.int8))
+                      (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8))
             in (,) <$> effect1 <*> effect2
       in actualIO >>= assertEqual "" (Right ("ok", 1))
     ,
@@ -452,8 +452,8 @@ tree =
         DSL.session $ do
           DSL.statement () $ Statements.plain $ "drop table if exists a"
           DSL.statement () $ Statements.plain $ "create table a (id serial not null, v char not null, primary key (id))"
-          id1 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" mempty (Decoders.singleRow (Decoders.column Decoders.int4)) False
-          id2 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" mempty (Decoders.singleRow (Decoders.column Decoders.int4)) False
+          id1 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False
+          id2 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False
           DSL.statement () $ Statements.plain $ "drop table if exists a"
           pure (id1, id2)
       in assertEqual "" (Right (1, 2)) =<< actualIO

tasty/Main/Statements.hs

@@ -29,4 +29,4 @@ selectList =
     sql =
       "values (1,2), (3,4), (5,6)"
     decoder =
-      HD.rowList ((,) <$> HD.column HD.int8 <*> HD.column HD.int8)
+      HD.rowList ((,) <$> (HD.column . HD.nonNullable) HD.int8 <*> (HD.column . HD.nonNullable) HD.int8)