module Hasql.Comms.ResultDecoder
  ( ResultDecoder,

    -- * Relations
    Handler,
    toHandler,
    fromHandler,

    -- * Extractors
    columnOids,

    -- * Constructors

    -- ** Basic
    ok,
    pipelineSync,
    rowsAffected,
    checkExecStatus,

    -- ** Higher-level decoders
    maybe,
    single,
    vector,
    foldl,
    foldr,

    -- ** Refinement
    refine,

    -- * Errors
    Error (..),
  )
where

import Data.Attoparsec.ByteString.Char8 qualified as Attoparsec
import Data.ByteString qualified as ByteString
import Data.Vector qualified as Vector
import Data.Vector.Mutable qualified as MutableVector
import Hasql.Comms.RowDecoder qualified as RowDecoder
import Hasql.Platform.Prelude hiding (foldl, foldr, maybe)
import Hasql.Platform.Prelude qualified as Prelude
import Hasql.Pq qualified as Pq

-- | Result consumption context, for consuming a single result from a sequence of results returned by the server.
newtype ResultDecoder a
  = ResultDecoder (Pq.Result -> IO (Either Error a))
  deriving
    ((forall a b. (a -> b) -> ResultDecoder a -> ResultDecoder b)
-> (forall a b. a -> ResultDecoder b -> ResultDecoder a)
-> Functor ResultDecoder
forall a b. a -> ResultDecoder b -> ResultDecoder a
forall a b. (a -> b) -> ResultDecoder a -> ResultDecoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ResultDecoder a -> ResultDecoder b
fmap :: forall a b. (a -> b) -> ResultDecoder a -> ResultDecoder b
$c<$ :: forall a b. a -> ResultDecoder b -> ResultDecoder a
<$ :: forall a b. a -> ResultDecoder b -> ResultDecoder a
Functor, Functor ResultDecoder
Functor ResultDecoder =>
(forall a. a -> ResultDecoder a)
-> (forall a b.
    ResultDecoder (a -> b) -> ResultDecoder a -> ResultDecoder b)
-> (forall a b c.
    (a -> b -> c)
    -> ResultDecoder a -> ResultDecoder b -> ResultDecoder c)
-> (forall a b.
    ResultDecoder a -> ResultDecoder b -> ResultDecoder b)
-> (forall a b.
    ResultDecoder a -> ResultDecoder b -> ResultDecoder a)
-> Applicative ResultDecoder
forall a. a -> ResultDecoder a
forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder a
forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder b
forall a b.
ResultDecoder (a -> b) -> ResultDecoder a -> ResultDecoder b
forall a b c.
(a -> b -> c)
-> ResultDecoder a -> ResultDecoder b -> ResultDecoder c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ResultDecoder a
pure :: forall a. a -> ResultDecoder a
$c<*> :: forall a b.
ResultDecoder (a -> b) -> ResultDecoder a -> ResultDecoder b
<*> :: forall a b.
ResultDecoder (a -> b) -> ResultDecoder a -> ResultDecoder b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ResultDecoder a -> ResultDecoder b -> ResultDecoder c
liftA2 :: forall a b c.
(a -> b -> c)
-> ResultDecoder a -> ResultDecoder b -> ResultDecoder c
$c*> :: forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder b
*> :: forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder b
$c<* :: forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder a
<* :: forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder a
Applicative, Applicative ResultDecoder
Applicative ResultDecoder =>
(forall a b.
 ResultDecoder a -> (a -> ResultDecoder b) -> ResultDecoder b)
-> (forall a b.
    ResultDecoder a -> ResultDecoder b -> ResultDecoder b)
-> (forall a. a -> ResultDecoder a)
-> Monad ResultDecoder
forall a. a -> ResultDecoder a
forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder b
forall a b.
ResultDecoder a -> (a -> ResultDecoder b) -> ResultDecoder b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
ResultDecoder a -> (a -> ResultDecoder b) -> ResultDecoder b
>>= :: forall a b.
ResultDecoder a -> (a -> ResultDecoder b) -> ResultDecoder b
$c>> :: forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder b
>> :: forall a b. ResultDecoder a -> ResultDecoder b -> ResultDecoder b
$creturn :: forall a. a -> ResultDecoder a
return :: forall a. a -> ResultDecoder a
Monad, MonadError Error, MonadReader Pq.Result)
    via (ReaderT Pq.Result (ExceptT Error IO))

instance Filterable ResultDecoder where
  {-# INLINE mapMaybe #-}
  mapMaybe :: forall a b. (a -> Maybe b) -> ResultDecoder a -> ResultDecoder b
mapMaybe a -> Maybe b
fn =
    (a -> Either Text b) -> ResultDecoder a -> ResultDecoder b
forall a b.
(a -> Either Text b) -> ResultDecoder a -> ResultDecoder b
refine (Either Text b -> (b -> Either Text b) -> Maybe b -> Either Text b
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (Text -> Either Text b
forall a b. a -> Either a b
Left Text
"Invalid result") b -> Either Text b
forall a b. b -> Either a b
Right (Maybe b -> Either Text b) -> (a -> Maybe b) -> a -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Maybe b
fn)

-- * Relations

-- ** Handler

type Handler a = Pq.Result -> IO (Either Error a)

toHandler :: ResultDecoder a -> Handler a
toHandler :: forall a. ResultDecoder a -> Handler a
toHandler (ResultDecoder Result -> IO (Either Error a)
handler) =
  Result -> IO (Either Error a)
handler

fromHandler :: Handler a -> ResultDecoder a
fromHandler :: forall a. Handler a -> ResultDecoder a
fromHandler Handler a
handler =
  Handler a -> ResultDecoder a
forall a. Handler a -> ResultDecoder a
ResultDecoder Handler a
handler

-- * Construction

{-# INLINE ok #-}
ok :: ResultDecoder ()
ok :: ResultDecoder ()
ok = [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.CommandOk, ExecStatus
Pq.TuplesOk]

{-# INLINE pipelineSync #-}
pipelineSync :: ResultDecoder ()
pipelineSync :: ResultDecoder ()
pipelineSync = [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.PipelineSync]

{-# INLINE rowsAffected #-}
rowsAffected :: ResultDecoder Int64
rowsAffected :: ResultDecoder Int64
rowsAffected = do
  [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.CommandOk]
  (Result -> IO (Either Error Int64)) -> ResultDecoder Int64
forall a. Handler a -> ResultDecoder a
ResultDecoder \Result
result -> do
    Maybe ByteString -> Either Error Int64
forall {c}. Integral c => Maybe ByteString -> Either Error c
cmdTuplesReader (Maybe ByteString -> Either Error Int64)
-> IO (Maybe ByteString) -> IO (Either Error Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> IO (Maybe ByteString)
Pq.cmdTuples Result
result
  where
    cmdTuplesReader :: Maybe ByteString -> Either Error c
cmdTuplesReader =
      Maybe ByteString -> Either Error ByteString
forall {b}. Maybe b -> Either Error b
notNothing (Maybe ByteString -> Either Error ByteString)
-> (ByteString -> Either Error c)
-> Maybe ByteString
-> Either Error c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either Error ByteString
notEmpty (ByteString -> Either Error ByteString)
-> (ByteString -> Either Error c) -> ByteString -> Either Error c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either Error c
forall {c}. Integral c => ByteString -> Either Error c
decimal
      where
        notNothing :: Maybe b -> Either Error b
notNothing =
          Either Error b
-> (b -> Either Error b) -> Maybe b -> Either Error b
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (Error -> Either Error b
forall a b. a -> Either a b
Left (Text -> Error
UnexpectedResult Text
"No bytes")) b -> Either Error b
forall a b. b -> Either a b
Right
        notEmpty :: ByteString -> Either Error ByteString
notEmpty ByteString
bytes =
          if ByteString -> Bool
ByteString.null ByteString
bytes
            then Error -> Either Error ByteString
forall a b. a -> Either a b
Left (Text -> Error
UnexpectedResult Text
"Empty bytes")
            else ByteString -> Either Error ByteString
forall a b. b -> Either a b
Right ByteString
bytes
        decimal :: ByteString -> Either Error c
decimal ByteString
bytes =
          (String -> Error) -> Either String c -> Either Error c
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
            ( \String
m ->
                Text -> Error
UnexpectedResult
                  (Text
"Decimal parsing failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
m)
            )
            ( Parser c -> ByteString -> Either String c
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly
                (Parser c
forall a. Integral a => Parser a
Attoparsec.decimal Parser c -> Parser ByteString () -> Parser c
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Attoparsec.endOfInput)
                ByteString
bytes
            )

{-# INLINE checkExecStatus #-}
checkExecStatus :: [Pq.ExecStatus] -> ResultDecoder ()
checkExecStatus :: [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus]
expectedList = do
  ExecStatus
status <- (Result -> IO (Either Error ExecStatus))
-> ResultDecoder ExecStatus
forall a. Handler a -> ResultDecoder a
ResultDecoder \Result
result -> ExecStatus -> Either Error ExecStatus
forall a b. b -> Either a b
Right (ExecStatus -> Either Error ExecStatus)
-> IO ExecStatus -> IO (Either Error ExecStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> IO ExecStatus
Pq.resultStatus Result
result
  Bool -> ResultDecoder () -> ResultDecoder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExecStatus -> [ExecStatus] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ExecStatus
status [ExecStatus]
expectedList) (ResultDecoder () -> ResultDecoder ())
-> ResultDecoder () -> ResultDecoder ()
forall a b. (a -> b) -> a -> b
$ do
    case ExecStatus
status of
      ExecStatus
Pq.BadResponse -> ResultDecoder ()
serverError
      ExecStatus
Pq.NonfatalError -> ResultDecoder ()
serverError
      ExecStatus
Pq.FatalError -> ResultDecoder ()
serverError
      ExecStatus
Pq.EmptyQuery -> () -> ResultDecoder ()
forall a. a -> ResultDecoder a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ExecStatus
_ ->
        Error -> ResultDecoder ()
forall a. Error -> ResultDecoder a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
          ( Text -> Error
UnexpectedResult
              (Text
"Unexpected result status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (ExecStatus -> String
forall a. Show a => a -> String
show ExecStatus
status) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Expecting one of the following: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString ([ExecStatus] -> String
forall a. Show a => a -> String
show [ExecStatus]
expectedList))
          )

{-# INLINE serverError #-}
serverError :: ResultDecoder ()
serverError :: ResultDecoder ()
serverError =
  (Result -> IO (Either Error ())) -> ResultDecoder ()
forall a. Handler a -> ResultDecoder a
ResultDecoder \Result
result -> do
    ByteString
code <-
      Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
Pq.resultErrorField Result
result FieldCode
Pq.DiagSqlstate
    ByteString
message <-
      Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
Pq.resultErrorField Result
result FieldCode
Pq.DiagMessagePrimary
    Maybe ByteString
detail <-
      Result -> FieldCode -> IO (Maybe ByteString)
Pq.resultErrorField Result
result FieldCode
Pq.DiagMessageDetail
    Maybe ByteString
hint <-
      Result -> FieldCode -> IO (Maybe ByteString)
Pq.resultErrorField Result
result FieldCode
Pq.DiagMessageHint
    Maybe Int
position <-
      Maybe ByteString -> Maybe Int
forall {a}. Integral a => Maybe ByteString -> Maybe a
parsePosition (Maybe ByteString -> Maybe Int)
-> IO (Maybe ByteString) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
Pq.resultErrorField Result
result FieldCode
Pq.DiagStatementPosition
    pure $ Error -> Either Error ()
forall a b. a -> Either a b
Left (Error -> Either Error ()) -> Error -> Either Error ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe Int
-> Error
ServerError ByteString
code ByteString
message Maybe ByteString
detail Maybe ByteString
hint Maybe Int
position
  where
    parsePosition :: Maybe ByteString -> Maybe a
parsePosition = \case
      Maybe ByteString
Nothing -> Maybe a
forall a. Maybe a
Nothing
      Just ByteString
pos ->
        case Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly (Parser a
forall a. Integral a => Parser a
Attoparsec.decimal Parser a -> Parser ByteString () -> Parser a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Attoparsec.endOfInput) ByteString
pos of
          Right a
pos -> a -> Maybe a
forall a. a -> Maybe a
Just a
pos
          Either String a
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Get the OIDs of all columns in the current result.
{-# INLINE columnOids #-}
columnOids :: ResultDecoder [Pq.Oid]
columnOids :: ResultDecoder [Oid]
columnOids = (Result -> IO (Either Error [Oid])) -> ResultDecoder [Oid]
forall a. Handler a -> ResultDecoder a
ResultDecoder \Result
result -> do
  Column
columnsAmount <- Result -> IO Column
Pq.nfields Result
result
  let Pq.Col CInt
count = Column
columnsAmount
  [Oid]
oids <- [CInt] -> (CInt -> IO Oid) -> IO [Oid]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CInt
0 .. CInt
count CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1] ((CInt -> IO Oid) -> IO [Oid]) -> (CInt -> IO Oid) -> IO [Oid]
forall a b. (a -> b) -> a -> b
$ \CInt
colIndex ->
    Result -> Column -> IO Oid
Pq.ftype Result
result (CInt -> Column
Pq.Col CInt
colIndex)
  pure ([Oid] -> Either Error [Oid]
forall a b. b -> Either a b
Right [Oid]
oids)

-- * Higher-level decoders

{-# INLINE checkCompatibility #-}
checkCompatibility :: RowDecoder.RowDecoder a -> ResultDecoder ()
checkCompatibility :: forall a. RowDecoder a -> ResultDecoder ()
checkCompatibility RowDecoder a
rowDec =
  let oids :: [Maybe Oid]
oids = RowDecoder a -> [Maybe Oid]
forall a. RowDecoder a -> [Maybe Oid]
RowDecoder.toExpectedOids RowDecoder a
rowDec
   in (Result -> IO (Either Error ())) -> ResultDecoder ()
forall a. Handler a -> ResultDecoder a
ResultDecoder \Result
result -> do
        Column
maxCols <- Result -> IO Column
Pq.nfields Result
result
        if [Maybe Oid] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Oid]
oids Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Column -> Int
Pq.colToInt Column
maxCols
          then
            let go :: [Maybe Oid] -> Int -> IO (Either Error ())
go [] Int
_ = Either Error () -> IO (Either Error ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Error ()
forall a b. b -> Either a b
Right ())
                go (Maybe Oid
Nothing : [Maybe Oid]
rest) Int
colIndex = [Maybe Oid] -> Int -> IO (Either Error ())
go [Maybe Oid]
rest (Int -> Int
forall a. Enum a => a -> a
succ Int
colIndex)
                go (Just Oid
expectedOid : [Maybe Oid]
rest) Int
colIndex = do
                  Oid
actualOid <- Result -> Column -> IO Oid
Pq.ftype Result
result (Int -> Column
forall a. Integral a => a -> Column
Pq.toColumn Int
colIndex)
                  if Oid
actualOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
expectedOid
                    then [Maybe Oid] -> Int -> IO (Either Error ())
go [Maybe Oid]
rest (Int -> Int
forall a. Enum a => a -> a
succ Int
colIndex)
                    else
                      Either Error () -> IO (Either Error ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                        ( Error -> Either Error ()
forall a b. a -> Either a b
Left
                            ( Int -> Word32 -> Word32 -> Error
DecoderTypeMismatch
                                Int
colIndex
                                (Oid -> Word32
Pq.oidToWord32 Oid
expectedOid)
                                (Oid -> Word32
Pq.oidToWord32 Oid
actualOid)
                            )
                        )
             in [Maybe Oid] -> Int -> IO (Either Error ())
go [Maybe Oid]
oids Int
0
          else Either Error () -> IO (Either Error ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Either Error ()
forall a b. a -> Either a b
Left (Int -> Int -> Error
UnexpectedColumnCount ([Maybe Oid] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Oid]
oids) (Column -> Int
Pq.colToInt Column
maxCols)))

{-# INLINE maybe #-}
maybe :: RowDecoder.RowDecoder a -> ResultDecoder (Maybe a)
maybe :: forall a. RowDecoder a -> ResultDecoder (Maybe a)
maybe RowDecoder a
rowDec =
  do
    [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.TuplesOk]
    RowDecoder a -> ResultDecoder ()
forall a. RowDecoder a -> ResultDecoder ()
checkCompatibility RowDecoder a
rowDec
    (Result -> IO (Either Error (Maybe a))) -> ResultDecoder (Maybe a)
forall a. Handler a -> ResultDecoder a
ResultDecoder
      ((Result -> IO (Either Error (Maybe a)))
 -> ResultDecoder (Maybe a))
-> (Result -> IO (Either Error (Maybe a)))
-> ResultDecoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Result
result -> do
        Row
maxRows <- Result -> IO Row
Pq.ntuples Result
result
        case Row
maxRows of
          Row
0 -> Either Error (Maybe a) -> IO (Either Error (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Either Error (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
          Row
1 -> do
            Either Error a
result <-
              RowDecoder a -> Decoder a
forall a. RowDecoder a -> Decoder a
RowDecoder.toDecoder RowDecoder a
rowDec Result
result Row
0
                IO (Either Error a)
-> (Either Error a -> Either Error a) -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Error -> Error) -> Either Error a -> Either Error a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Error -> Error
RowError Int
0)
            pure ((a -> Maybe a) -> Either Error a -> Either Error (Maybe a)
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Either Error a
result)
          Row
_ -> Either Error (Maybe a) -> IO (Either Error (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> Either Error (Maybe a)
forall a b. a -> Either a b
Left (Int -> Error
UnexpectedRowCount (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (Pq.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n

{-# INLINE single #-}
single :: RowDecoder.RowDecoder a -> ResultDecoder a
single :: forall a. RowDecoder a -> ResultDecoder a
single RowDecoder a
rowDec =
  do
    [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.TuplesOk]
    RowDecoder a -> ResultDecoder ()
forall a. RowDecoder a -> ResultDecoder ()
checkCompatibility RowDecoder a
rowDec
    (Result -> IO (Either Error a)) -> ResultDecoder a
forall a. Handler a -> ResultDecoder a
ResultDecoder
      ((Result -> IO (Either Error a)) -> ResultDecoder a)
-> (Result -> IO (Either Error a)) -> ResultDecoder a
forall a b. (a -> b) -> a -> b
$ \Result
result -> do
        Row
maxRows <- Result -> IO Row
Pq.ntuples Result
result
        case Row
maxRows of
          Row
1 -> do
            RowDecoder a -> Decoder a
forall a. RowDecoder a -> Decoder a
RowDecoder.toDecoder RowDecoder a
rowDec Result
result Row
0
              IO (Either Error a)
-> (Either Error a -> Either Error a) -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Error -> Error) -> Either Error a -> Either Error a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Error -> Error
RowError Int
0)
          Row
_ -> Either Error a -> IO (Either Error a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> Either Error a
forall a b. a -> Either a b
Left (Int -> Error
UnexpectedRowCount (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (Pq.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n

{-# INLINE vector #-}
vector :: RowDecoder.RowDecoder a -> ResultDecoder (Vector a)
vector :: forall a. RowDecoder a -> ResultDecoder (Vector a)
vector RowDecoder a
rowDec =
  do
    [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.TuplesOk]
    RowDecoder a -> ResultDecoder ()
forall a. RowDecoder a -> ResultDecoder ()
checkCompatibility RowDecoder a
rowDec
    (Result -> IO (Either Error (Vector a)))
-> ResultDecoder (Vector a)
forall a. Handler a -> ResultDecoder a
ResultDecoder
      ((Result -> IO (Either Error (Vector a)))
 -> ResultDecoder (Vector a))
-> (Result -> IO (Either Error (Vector a)))
-> ResultDecoder (Vector a)
forall a b. (a -> b) -> a -> b
$ \Result
result -> do
        Row
maxRows <- Result -> IO Row
Pq.ntuples Result
result
        MVector RealWorld a
mvector <- Int -> IO (MVector (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MutableVector.unsafeNew (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows)
        IORef (Maybe Error)
failureRef <- Maybe Error -> IO (IORef (Maybe Error))
forall a. a -> IO (IORef a)
newIORef Maybe Error
forall a. Maybe a
Nothing
        Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMFromZero_ (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
          Either Error a
rowResult <- RowDecoder a -> Decoder a
forall a. RowDecoder a -> Decoder a
RowDecoder.toDecoder RowDecoder a
rowDec Result
result (Int -> Row
forall {a}. Integral a => a -> Row
intToRow Int
rowIndex)
          case Either Error a
rowResult of
            Left !Error
err -> IORef (Maybe Error) -> Maybe Error -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Error)
failureRef (Error -> Maybe Error
forall a. a -> Maybe a
Just (Int -> Error -> Error
RowError Int
rowIndex Error
err))
            Right !a
x -> MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MutableVector.unsafeWrite MVector RealWorld a
MVector (PrimState IO) a
mvector Int
rowIndex a
x
        IORef (Maybe Error) -> IO (Maybe Error)
forall a. IORef a -> IO a
readIORef IORef (Maybe Error)
failureRef IO (Maybe Error)
-> (Maybe Error -> IO (Either Error (Vector a)))
-> IO (Either Error (Vector a))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Error
Nothing -> Vector a -> Either Error (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either Error (Vector a))
-> IO (Vector a) -> IO (Either Error (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState IO) a -> IO (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.unsafeFreeze MVector RealWorld a
MVector (PrimState IO) a
mvector
          Just Error
x -> Either Error (Vector a) -> IO (Either Error (Vector a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Either Error (Vector a)
forall a b. a -> Either a b
Left Error
x)
  where
    rowToInt :: Row -> b
rowToInt (Pq.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
Pq.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE foldl #-}
foldl :: (a -> b -> a) -> a -> RowDecoder.RowDecoder b -> ResultDecoder a
foldl :: forall a b. (a -> b -> a) -> a -> RowDecoder b -> ResultDecoder a
foldl a -> b -> a
step a
init RowDecoder b
rowDec =
  {-# SCC "foldl" #-}
  do
    [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.TuplesOk]
    RowDecoder b -> ResultDecoder ()
forall a. RowDecoder a -> ResultDecoder ()
checkCompatibility RowDecoder b
rowDec
    (Result -> IO (Either Error a)) -> ResultDecoder a
forall a. Handler a -> ResultDecoder a
ResultDecoder
      ((Result -> IO (Either Error a)) -> ResultDecoder a)
-> (Result -> IO (Either Error a)) -> ResultDecoder a
forall a b. (a -> b) -> a -> b
$ \Result
result ->
        {-# SCC "traversal" #-}
        do
          Row
maxRows <- Result -> IO Row
Pq.ntuples Result
result
          IORef a
accRef <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
init
          IORef (Maybe Error)
failureRef <- Maybe Error -> IO (IORef (Maybe Error))
forall a. a -> IO (IORef a)
newIORef Maybe Error
forall a. Maybe a
Nothing
          Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMFromZero_ (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
            Either Error b
rowResult <- RowDecoder b -> Decoder b
forall a. RowDecoder a -> Decoder a
RowDecoder.toDecoder RowDecoder b
rowDec Result
result (Int -> Row
forall {a}. Integral a => a -> Row
intToRow Int
rowIndex)
            case Either Error b
rowResult of
              Left !Error
err -> IORef (Maybe Error) -> Maybe Error -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Error)
failureRef (Error -> Maybe Error
forall a. a -> Maybe a
Just (Int -> Error -> Error
RowError Int
rowIndex Error
err))
              Right !b
x -> IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef a
accRef (\a
acc -> a -> b -> a
step a
acc b
x)
          IORef (Maybe Error) -> IO (Maybe Error)
forall a. IORef a -> IO a
readIORef IORef (Maybe Error)
failureRef IO (Maybe Error)
-> (Maybe Error -> IO (Either Error a)) -> IO (Either Error a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Error
Nothing -> a -> Either Error a
forall a b. b -> Either a b
Right (a -> Either Error a) -> IO a -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
accRef
            Just Error
x -> Either Error a -> IO (Either Error a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Either Error a
forall a b. a -> Either a b
Left Error
x)
  where
    rowToInt :: Row -> b
rowToInt (Pq.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
Pq.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE foldr #-}
foldr :: (b -> a -> a) -> a -> RowDecoder.RowDecoder b -> ResultDecoder a
foldr :: forall b a. (b -> a -> a) -> a -> RowDecoder b -> ResultDecoder a
foldr b -> a -> a
step a
init RowDecoder b
rowDec =
  {-# SCC "foldr" #-}
  do
    [ExecStatus] -> ResultDecoder ()
checkExecStatus [ExecStatus
Pq.TuplesOk]
    RowDecoder b -> ResultDecoder ()
forall a. RowDecoder a -> ResultDecoder ()
checkCompatibility RowDecoder b
rowDec
    (Result -> IO (Either Error a)) -> ResultDecoder a
forall a. Handler a -> ResultDecoder a
ResultDecoder
      ((Result -> IO (Either Error a)) -> ResultDecoder a)
-> (Result -> IO (Either Error a)) -> ResultDecoder a
forall a b. (a -> b) -> a -> b
$ \Result
result -> do
        Row
maxRows <- Result -> IO Row
Pq.ntuples Result
result
        IORef a
accRef <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
init
        IORef (Maybe Error)
failureRef <- Maybe Error -> IO (IORef (Maybe Error))
forall a. a -> IO (IORef a)
newIORef Maybe Error
forall a. Maybe a
Nothing
        Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMToZero_ (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
          Either Error b
rowResult <- RowDecoder b -> Decoder b
forall a. RowDecoder a -> Decoder a
RowDecoder.toDecoder RowDecoder b
rowDec Result
result (Int -> Row
forall {a}. Integral a => a -> Row
intToRow Int
rowIndex)
          case Either Error b
rowResult of
            Left !Error
err -> IORef (Maybe Error) -> Maybe Error -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Error)
failureRef (Error -> Maybe Error
forall a. a -> Maybe a
Just (Int -> Error -> Error
RowError Int
rowIndex Error
err))
            Right !b
x -> IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
accRef (\a
acc -> b -> a -> a
step b
x a
acc)
        IORef (Maybe Error) -> IO (Maybe Error)
forall a. IORef a -> IO a
readIORef IORef (Maybe Error)
failureRef IO (Maybe Error)
-> (Maybe Error -> IO (Either Error a)) -> IO (Either Error a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Error
Nothing -> a -> Either Error a
forall a b. b -> Either a b
Right (a -> Either Error a) -> IO a -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
accRef
          Just Error
x -> Either Error a -> IO (Either Error a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Either Error a
forall a b. a -> Either a b
Left Error
x)
  where
    rowToInt :: Row -> b
rowToInt (Pq.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
Pq.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- * Refinement

refine :: (a -> Either Text b) -> ResultDecoder a -> ResultDecoder b
refine :: forall a b.
(a -> Either Text b) -> ResultDecoder a -> ResultDecoder b
refine a -> Either Text b
refiner (ResultDecoder Result -> IO (Either Error a)
reader) = (Result -> IO (Either Error b)) -> ResultDecoder b
forall a. Handler a -> ResultDecoder a
ResultDecoder
  ((Result -> IO (Either Error b)) -> ResultDecoder b)
-> (Result -> IO (Either Error b)) -> ResultDecoder b
forall a b. (a -> b) -> a -> b
$ \Result
result -> do
    Either Error a
resultEither <- Result -> IO (Either Error a)
reader Result
result
    return $ Either Error a
resultEither Either Error a -> (a -> Either Error b) -> Either Error b
forall a b.
Either Error a -> (a -> Either Error b) -> Either Error b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Error) -> Either Text b -> Either Error b
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Error
UnexpectedResult (Either Text b -> Either Error b)
-> (a -> Either Text b) -> a -> Either Error b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Text b
refiner

-- * Errors

-- |
-- An error with a command result.
data Error
  = -- | An error reported by the DB.
    ServerError
      -- | __Code__. The SQLSTATE code for the error. It's recommended to use
      -- <http://hackage.haskell.org/package/postgresql-error-codes
      -- the "postgresql-error-codes" package> to work with those.
      ByteString
      -- | __Message__. The primary human-readable error message(typically one
      -- line). Always present.
      ByteString
      -- | __Details__. An optional secondary error message carrying more
      -- detail about the problem. Might run to multiple lines.
      (Maybe ByteString)
      -- | __Hint__. An optional suggestion on what to do about the problem.
      -- This is intended to differ from detail in that it offers advice
      -- (potentially inappropriate) rather than hard facts. Might run to
      -- multiple lines.
      (Maybe ByteString)
      -- | __Position__. Error cursor position as an index into the original
      -- statement string. Positions are measured in characters not bytes.
      (Maybe Int)
  | -- |
    -- The database returned an unexpected result.
    -- Indicates an improper statement or a schema mismatch.
    UnexpectedResult Text
  | -- |
    -- An unexpected amount of rows.
    UnexpectedRowCount Int
  | -- |
    -- An unexpected amount of columns in the result.
    UnexpectedColumnCount
      -- | Expected amount of columns.
      Int
      -- | Actual amount of columns.
      Int
  | -- |
    -- Appears when the decoder's expected type doesn't match the actual column type.
    -- Reports the expected OID and the actual OID from the result.
    DecoderTypeMismatch
      -- | Column index.
      Int
      -- | Expected OID.
      Word32
      -- | Actual OID.
      Word32
  | -- | An error in a specific row, reported by a row decoder.
    RowError
      -- | Row index.
      Int
      -- | Underlying error.
      RowDecoder.Error
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq)