module Hasql.Decoders
(
Result,
unit,
rowsAffected,
singleRow,
rowMaybe,
rowVector,
rowList,
foldlRows,
foldrRows,
Row,
column,
nullableColumn,
Value,
bool,
int2,
int4,
int8,
float4,
float8,
numeric,
char,
text,
bytea,
date,
timestamp,
timestamptz,
time,
timetz,
interval,
uuid,
inet,
json,
jsonBytes,
jsonb,
jsonbBytes,
array,
composite,
hstore,
enum,
custom,
Array,
dimension,
element,
nullableElement,
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
newtype Result a =
Result (Results.Results a)
deriving (Functor)
{-# INLINABLE unit #-}
unit :: Result ()
unit =
Result (Results.single Result.unit)
{-# INLINABLE rowsAffected #-}
rowsAffected :: Result Int64
rowsAffected =
Result (Results.single Result.rowsAffected)
{-# INLINABLE singleRow #-}
singleRow :: Row a -> Result a
singleRow (Row row) =
Result (Results.single (Result.single row))
{-# INLINABLE foldlRows #-}
foldlRows :: (a -> b -> a) -> a -> Row b -> Result a
foldlRows step init (Row row) =
Result (Results.single (Result.foldl step init row))
{-# INLINABLE foldrRows #-}
foldrRows :: (b -> a -> a) -> a -> Row b -> Result a
foldrRows step init (Row row) =
Result (Results.single (Result.foldr step init row))
{-# INLINABLE rowMaybe #-}
rowMaybe :: Row a -> Result (Maybe a)
rowMaybe (Row row) =
Result (Results.single (Result.maybe row))
{-# INLINABLE rowVector #-}
rowVector :: Row a -> Result (Vector a)
rowVector (Row row) =
Result (Results.single (Result.vector row))
{-# INLINABLE rowList #-}
rowList :: Row a -> Result [a]
rowList =
foldrRows strictCons []
instance Default (Result ()) where
{-# INLINE def #-}
def =
unit
instance Default (Result Int64) where
{-# INLINE def #-}
def =
rowsAffected
instance Default (Row a) => Default (Result (Maybe a)) where
{-# INLINE def #-}
def =
rowMaybe def
instance Default (Row a) => Default (Result (Vector a)) where
{-# INLINE def #-}
def =
rowVector def
instance Default (Row a) => Default (Result ([] a)) where
{-# INLINE def #-}
def =
rowList def
instance Default (Row a) => Default (Result (Identity a)) where
{-# INLINE def #-}
def =
fmap Identity (singleRow def)
newtype Row a =
Row (Row.Row a)
deriving (Functor, Applicative, Monad)
{-# INLINABLE column #-}
column :: Value a -> Row a
column (Value imp) =
Row (Row.nonNullValue imp)
{-# INLINABLE nullableColumn #-}
nullableColumn :: Value a -> Row (Maybe a)
nullableColumn (Value imp) =
Row (Row.value imp)
instance Default (Value a) => Default (Row (Identity a)) where
{-# INLINE def #-}
def =
fmap Identity (column def)
instance Default (Value a) => Default (Row (Maybe a)) where
{-# INLINE def #-}
def =
nullableColumn def
instance (Default (Value a1), Default (Value a2)) => Default (Row (a1, a2)) where
{-# INLINE def #-}
def =
ap (fmap (,) (column def)) (column def)
newtype Value a =
Value (Value.Value a)
deriving (Functor)
{-# INLINABLE bool #-}
bool :: Value Bool
bool =
Value (Value.decoder (const A.bool))
{-# INLINABLE int2 #-}
int2 :: Value Int16
int2 =
Value (Value.decoder (const A.int))
{-# INLINABLE int4 #-}
int4 :: Value Int32
int4 =
Value (Value.decoder (const A.int))
{-# INLINABLE int8 #-}
int8 :: Value Int64
int8 =
{-# SCC "int8" #-}
Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))
{-# INLINABLE float4 #-}
float4 :: Value Float
float4 =
Value (Value.decoder (const A.float4))
{-# INLINABLE float8 #-}
float8 :: Value Double
float8 =
Value (Value.decoder (const A.float8))
{-# INLINABLE numeric #-}
numeric :: Value B.Scientific
numeric =
Value (Value.decoder (const A.numeric))
{-# INLINABLE char #-}
char :: Value Char
char =
Value (Value.decoder (const A.char))
{-# INLINABLE text #-}
text :: Value Text
text =
Value (Value.decoder (const A.text_strict))
{-# INLINABLE bytea #-}
bytea :: Value ByteString
bytea =
Value (Value.decoder (const A.bytea_strict))
{-# INLINABLE date #-}
date :: Value B.Day
date =
Value (Value.decoder (const A.date))
{-# INLINABLE timestamp #-}
timestamp :: Value B.LocalTime
timestamp =
Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))
{-# INLINABLE timestamptz #-}
timestamptz :: Value B.UTCTime
timestamptz =
Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))
{-# INLINABLE time #-}
time :: Value B.TimeOfDay
time =
Value (Value.decoder (Prelude.bool A.time_float A.time_int))
{-# INLINABLE timetz #-}
timetz :: Value (B.TimeOfDay, B.TimeZone)
timetz =
Value (Value.decoder (Prelude.bool A.timetz_float A.timetz_int))
{-# INLINABLE interval #-}
interval :: Value B.DiffTime
interval =
Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))
{-# INLINABLE uuid #-}
uuid :: Value B.UUID
uuid =
Value (Value.decoder (const A.uuid))
{-# INLINABLE inet #-}
inet :: Value (B.NetAddr B.IP)
inet =
Value (Value.decoder (const A.inet))
{-# INLINABLE json #-}
json :: Value B.Value
json =
Value (Value.decoder (const A.json_ast))
{-# INLINABLE jsonBytes #-}
jsonBytes :: (ByteString -> Either Text a) -> Value a
jsonBytes fn =
Value (Value.decoder (const (A.json_bytes fn)))
{-# INLINABLE jsonb #-}
jsonb :: Value B.Value
jsonb =
Value (Value.decoder (const A.jsonb_ast))
{-# INLINABLE jsonbBytes #-}
jsonbBytes :: (ByteString -> Either Text a) -> Value a
jsonbBytes fn =
Value (Value.decoder (const (A.jsonb_bytes fn)))
{-# INLINABLE custom #-}
custom :: (Bool -> ByteString -> Either Text a) -> Value a
custom fn =
Value (Value.decoderFn fn)
{-# INLINABLE array #-}
array :: Array a -> Value a
array (Array imp) =
Value (Value.decoder (Array.run imp))
{-# INLINABLE composite #-}
composite :: Composite a -> Value a
composite (Composite imp) =
Value (Value.decoder (Composite.run imp))
{-# 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)))
enum :: (Text -> Maybe a) -> Value a
enum mapping =
Value (Value.decoder (const (A.enum mapping)))
instance Default (Value Bool) where
{-# INLINE def #-}
def =
bool
instance Default (Value Int16) where
{-# INLINE def #-}
def =
int2
instance Default (Value Int32) where
{-# INLINE def #-}
def =
int4
instance Default (Value Int64) where
{-# INLINE def #-}
def =
int8
instance Default (Value Float) where
{-# INLINE def #-}
def =
float4
instance Default (Value Double) where
{-# INLINE def #-}
def =
float8
instance Default (Value B.Scientific) where
{-# INLINE def #-}
def =
numeric
instance Default (Value Char) where
{-# INLINE def #-}
def =
char
instance Default (Value Text) where
{-# INLINE def #-}
def =
text
instance Default (Value ByteString) where
{-# INLINE def #-}
def =
bytea
instance Default (Value B.Day) where
{-# INLINE def #-}
def =
date
instance Default (Value B.LocalTime) where
{-# INLINE def #-}
def =
timestamp
instance Default (Value B.UTCTime) where
{-# INLINE def #-}
def =
timestamptz
instance Default (Value B.TimeOfDay) where
{-# INLINE def #-}
def =
time
instance Default (Value (B.TimeOfDay, B.TimeZone)) where
{-# INLINE def #-}
def =
timetz
instance Default (Value B.DiffTime) where
{-# INLINE def #-}
def =
interval
instance Default (Value B.UUID) where
{-# INLINE def #-}
def =
uuid
instance Default (Value B.Value) where
{-# INLINE def #-}
def =
json
newtype Array a =
Array (Array.Array a)
deriving (Functor)
{-# 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)
{-# INLINABLE element #-}
element :: Value a -> Array a
element (Value imp) =
Array (Array.nonNullValue (Value.run imp))
{-# INLINABLE nullableElement #-}
nullableElement :: Value a -> Array (Maybe a)
nullableElement (Value imp) =
Array (Array.value (Value.run imp))
newtype Composite a =
Composite (Composite.Composite a)
deriving (Functor, Applicative, Monad)
{-# INLINABLE field #-}
field :: Value a -> Composite a
field (Value imp) =
Composite (Composite.nonNullValue (Value.run imp))
{-# INLINABLE nullableField #-}
nullableField :: Value a -> Composite (Maybe a)
nullableField (Value imp) =
Composite (Composite.value (Value.run imp))