module Hasql.Private.Decoders.Result where

import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
import qualified Data.ByteString as ByteString
import qualified Data.Vector as Vector
import qualified Data.Vector.Mutable as MutableVector
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.Decoders.Row as Row
import Hasql.Private.Errors
import Hasql.Private.Prelude hiding (many, maybe)
import qualified Hasql.Private.Prelude as Prelude

newtype Result a
  = Result (ReaderT (Bool, LibPQ.Result) (ExceptT ResultError IO) a)
  deriving (forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: forall a b. (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor, Functor Result
forall a. a -> Result a
forall a b. Result a -> Result b -> Result a
forall a b. Result a -> Result b -> Result b
forall a b. Result (a -> b) -> Result a -> Result b
forall a b c. (a -> b -> c) -> Result a -> Result b -> Result 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
<* :: forall a b. Result a -> Result b -> Result a
$c<* :: forall a b. Result a -> Result b -> Result a
*> :: forall a b. Result a -> Result b -> Result b
$c*> :: forall a b. Result a -> Result b -> Result b
liftA2 :: forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
$cliftA2 :: forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
<*> :: forall a b. Result (a -> b) -> Result a -> Result b
$c<*> :: forall a b. Result (a -> b) -> Result a -> Result b
pure :: forall a. a -> Result a
$cpure :: forall a. a -> Result a
Applicative, Applicative Result
forall a. a -> Result a
forall a b. Result a -> Result b -> Result b
forall a b. Result a -> (a -> Result b) -> Result 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
return :: forall a. a -> Result a
$creturn :: forall a. a -> Result a
>> :: forall a b. Result a -> Result b -> Result b
$c>> :: forall a b. Result a -> Result b -> Result b
>>= :: forall a b. Result a -> (a -> Result b) -> Result b
$c>>= :: forall a b. Result a -> (a -> Result b) -> Result b
Monad)

{-# INLINE run #-}
run :: Result a -> (Bool, LibPQ.Result) -> IO (Either ResultError a)
run :: forall a. Result a -> (Bool, Result) -> IO (Either ResultError a)
run (Result ReaderT (Bool, Result) (ExceptT ResultError IO) a
reader) (Bool, Result)
env =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Bool, Result) (ExceptT ResultError IO) a
reader (Bool, Result)
env)

{-# INLINE noResult #-}
noResult :: Result ()
noResult :: Result ()
noResult =
  (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
    ExecStatus
LibPQ.CommandOk -> Bool
True
    ExecStatus
LibPQ.TuplesOk -> Bool
True
    ExecStatus
_ -> Bool
False

{-# INLINE rowsAffected #-}
rowsAffected :: Result Int64
rowsAffected :: Result Int64
rowsAffected =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.CommandOk -> Bool
True
      ExecStatus
_ -> Bool
False
    forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) ->
        forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
          Result -> IO (Maybe ByteString)
LibPQ.cmdTuples Result
result forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {c}. Integral c => Maybe ByteString -> Either ResultError c
cmdTuplesReader
  where
    cmdTuplesReader :: Maybe ByteString -> Either ResultError c
cmdTuplesReader =
      forall {b}. Maybe b -> Either ResultError b
notNothing forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either ResultError ByteString
notEmpty forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall {b}. Integral b => ByteString -> Either ResultError b
decimal
      where
        notNothing :: Maybe b -> Either ResultError b
notNothing =
          forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (forall a b. a -> Either a b
Left (Text -> ResultError
UnexpectedResult Text
"No bytes")) forall a b. b -> Either a b
Right
        notEmpty :: ByteString -> Either ResultError ByteString
notEmpty ByteString
bytes =
          if ByteString -> Bool
ByteString.null ByteString
bytes
            then forall a b. a -> Either a b
Left (Text -> ResultError
UnexpectedResult Text
"Empty bytes")
            else forall a b. b -> Either a b
Right ByteString
bytes
        decimal :: ByteString -> Either ResultError b
decimal ByteString
bytes =
          forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (\String
m -> Text -> ResultError
UnexpectedResult (Text
"Decimal parsing failure: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
m)) forall a b. (a -> b) -> a -> b
$
            forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly (forall a. Integral a => Parser a
Attoparsec.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
Attoparsec.endOfInput) ByteString
bytes

{-# INLINE checkExecStatus #-}
checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()
checkExecStatus :: (ExecStatus -> Bool) -> Result ()
checkExecStatus ExecStatus -> Bool
predicate =
  {-# SCC "checkExecStatus" #-}
  do
    ExecStatus
status <- forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Result -> IO ExecStatus
LibPQ.resultStatus Result
result
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExecStatus -> Bool
predicate ExecStatus
status) forall a b. (a -> b) -> a -> b
$ do
      case ExecStatus
status of
        ExecStatus
LibPQ.BadResponse -> Result ()
serverError
        ExecStatus
LibPQ.NonfatalError -> Result ()
serverError
        ExecStatus
LibPQ.FatalError -> Result ()
serverError
        ExecStatus
LibPQ.EmptyQuery -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExecStatus
_ -> forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ResultError
UnexpectedResult forall a b. (a -> b) -> a -> b
$ Text
"Unexpected result status: " forall a. Semigroup a => a -> a -> a
<> (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ExecStatus
status)

{-# INLINE serverError #-}
serverError :: Result ()
serverError :: Result ()
serverError =
  forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
      ByteString
code <-
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$
          Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagSqlstate
      ByteString
message <-
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$
          Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagMessagePrimary
      Maybe ByteString
detail <-
        Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagMessageDetail
      Maybe ByteString
hint <-
        Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagMessageHint
      Maybe Int
position <-
        forall {a}. Integral a => Maybe ByteString -> Maybe a
parsePosition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagStatementPosition
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe Int
-> ResultError
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 -> forall a. Maybe a
Nothing
      Just ByteString
pos ->
        case forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly (forall a. Integral a => Parser a
Attoparsec.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
Attoparsec.endOfInput) ByteString
pos of
          Right a
pos -> forall a. a -> Maybe a
Just a
pos
          Either String a
_ -> forall a. Maybe a
Nothing

{-# INLINE maybe #-}
maybe :: Row.Row a -> Result (Maybe a)
maybe :: forall a. Row a -> Result (Maybe a)
maybe Row a
rowDec =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
        Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
        case Row
maxRows of
          Row
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
          Row
1 -> do
            Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
            let fromRowError :: (Int, RowError) -> ResultError
fromRowError (Int
col, RowError
err) = Int -> Int -> RowError -> ResultError
RowError Int
0 Int
col RowError
err
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Int, RowError) -> ResultError
fromRowError) forall a b. (a -> b) -> a -> b
$ forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row a
rowDec (Result
result, Row
0, Column
maxCols, Bool
integerDatetimes)
          Row
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Int -> ResultError
UnexpectedAmountOfRows (forall {b}. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE single #-}
single :: Row.Row a -> Result a
single :: forall a. Row a -> Result a
single Row a
rowDec =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
        Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
        case Row
maxRows of
          Row
1 -> do
            Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
            let fromRowError :: (Int, RowError) -> ResultError
fromRowError (Int
col, RowError
err) = Int -> Int -> RowError -> ResultError
RowError Int
0 Int
col RowError
err
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Int, RowError) -> ResultError
fromRowError) forall a b. (a -> b) -> a -> b
$ forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row a
rowDec (Result
result, Row
0, Column
maxCols, Bool
integerDatetimes)
          Row
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Int -> ResultError
UnexpectedAmountOfRows (forall {b}. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE vector #-}
vector :: Row.Row a -> Result (Vector a)
vector :: forall a. Row a -> Result (Vector a)
vector Row a
rowDec =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
        Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
        Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
        MVector RealWorld a
mvector <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MutableVector.unsafeNew (forall {b}. Num b => Row -> b
rowToInt Row
maxRows)
        IORef (Maybe ResultError)
failureRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
        forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMFromZero_ (forall {b}. Num b => Row -> b
rowToInt Row
maxRows) forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
          Either (Int, RowError) a
rowResult <- forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row a
rowDec (Result
result, forall {a}. Integral a => a -> Row
intToRow Int
rowIndex, Column
maxCols, Bool
integerDatetimes)
          case Either (Int, RowError) a
rowResult of
            Left !(!Int
colIndex, !RowError
x) -> forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (forall a. a -> Maybe a
Just (Int -> Int -> RowError -> ResultError
RowError Int
rowIndex Int
colIndex RowError
x))
            Right !a
x -> forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MutableVector.unsafeWrite MVector RealWorld a
mvector Int
rowIndex a
x
        forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe ResultError
Nothing -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.unsafeFreeze MVector RealWorld a
mvector
          Just ResultError
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE foldl #-}
foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a
foldl :: forall a b. (a -> b -> a) -> a -> Row b -> Result a
foldl a -> b -> a
step a
init Row b
rowDec =
  {-# SCC "foldl" #-}
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) ->
        forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
          {-# SCC "traversal" #-}
          do
            Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
            Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
            IORef a
accRef <- forall a. a -> IO (IORef a)
newIORef a
init
            IORef (Maybe ResultError)
failureRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
            forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMFromZero_ (forall {b}. Num b => Row -> b
rowToInt Row
maxRows) forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
              Either (Int, RowError) b
rowResult <- forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row b
rowDec (Result
result, forall {a}. Integral a => a -> Row
intToRow Int
rowIndex, Column
maxCols, Bool
integerDatetimes)
              case Either (Int, RowError) b
rowResult of
                Left !(!Int
colIndex, !RowError
x) -> forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (forall a. a -> Maybe a
Just (Int -> Int -> RowError -> ResultError
RowError Int
rowIndex Int
colIndex RowError
x))
                Right !b
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef a
accRef (\a
acc -> a -> b -> a
step a
acc b
x)
            forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe ResultError
Nothing -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef a
accRef
              Just ResultError
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE foldr #-}
foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a
foldr :: forall b a. (b -> a -> a) -> a -> Row b -> Result a
foldr b -> a -> a
step a
init Row b
rowDec =
  {-# SCC "foldr" #-}
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result forall a b. (a -> b) -> a -> b
$
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
        Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
        Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
        IORef a
accRef <- forall a. a -> IO (IORef a)
newIORef a
init
        IORef (Maybe ResultError)
failureRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
        forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMToZero_ (forall {b}. Num b => Row -> b
rowToInt Row
maxRows) forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
          Either (Int, RowError) b
rowResult <- forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row b
rowDec (Result
result, forall {a}. Integral a => a -> Row
intToRow Int
rowIndex, Column
maxCols, Bool
integerDatetimes)
          case Either (Int, RowError) b
rowResult of
            Left !(!Int
colIndex, !RowError
x) -> forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (forall a. a -> Maybe a
Just (Int -> Int -> RowError -> ResultError
RowError Int
rowIndex Int
colIndex RowError
x))
            Right !b
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
accRef (\a
acc -> b -> a -> a
step b
x a
acc)
        forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe ResultError
Nothing -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef a
accRef
          Just ResultError
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral