module Hasql.Decoders.Result 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.Decoders.Row qualified as Row
import Hasql.Errors
import Hasql.LibPq14 qualified as LibPQ
import Hasql.Prelude hiding (many, maybe)
import Hasql.Prelude qualified as Prelude

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

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

{-# INLINE noResult #-}
noResult :: Result ()
noResult :: Result ()
noResult =
  [ExecStatus] -> Result ()
checkExecStatus [ExecStatus
LibPQ.CommandOk, ExecStatus
LibPQ.TuplesOk]

{-# INLINE rowsAffected #-}
rowsAffected :: Result Int64
rowsAffected :: Result Int64
rowsAffected =
  do
    [ExecStatus] -> Result ()
checkExecStatus [ExecStatus
LibPQ.CommandOk]
    ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
-> Result Int64
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
      (ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
 -> Result Int64)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
-> Result Int64
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO Int64)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      (((Bool, Result) -> ExceptT ResultError IO Int64)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64)
-> ((Bool, Result) -> ExceptT ResultError IO Int64)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) ->
        IO (Either ResultError Int64) -> ExceptT ResultError IO Int64
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
          (IO (Either ResultError Int64) -> ExceptT ResultError IO Int64)
-> IO (Either ResultError Int64) -> ExceptT ResultError IO Int64
forall a b. (a -> b) -> a -> b
$ Result -> IO (Maybe ByteString)
LibPQ.cmdTuples Result
result
          IO (Maybe ByteString)
-> (IO (Maybe ByteString) -> IO (Either ResultError Int64))
-> IO (Either ResultError Int64)
forall a b. a -> (a -> b) -> b
& (Maybe ByteString -> Either ResultError Int64)
-> IO (Maybe ByteString) -> IO (Either ResultError Int64)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> Either ResultError Int64
forall {c}. Integral c => Maybe ByteString -> Either ResultError c
cmdTuplesReader
  where
    cmdTuplesReader :: Maybe ByteString -> Either ResultError c
cmdTuplesReader =
      Maybe ByteString -> Either ResultError ByteString
forall {b}. Maybe b -> Either ResultError b
notNothing (Maybe ByteString -> Either ResultError ByteString)
-> (ByteString -> Either ResultError c)
-> Maybe ByteString
-> Either ResultError c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either ResultError ByteString
notEmpty (ByteString -> Either ResultError ByteString)
-> (ByteString -> Either ResultError c)
-> ByteString
-> Either ResultError c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either ResultError c
forall {c}. Integral c => ByteString -> Either ResultError c
decimal
      where
        notNothing :: Maybe b -> Either ResultError b
notNothing =
          Either ResultError b
-> (b -> Either ResultError b) -> Maybe b -> Either ResultError b
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (ResultError -> Either ResultError b
forall a b. a -> Either a b
Left (Text -> ResultError
UnexpectedResult Text
"No bytes")) b -> Either ResultError b
forall a b. b -> Either a b
Right
        notEmpty :: ByteString -> Either ResultError ByteString
notEmpty ByteString
bytes =
          if ByteString -> Bool
ByteString.null ByteString
bytes
            then ResultError -> Either ResultError ByteString
forall a b. a -> Either a b
Left (Text -> ResultError
UnexpectedResult Text
"Empty bytes")
            else ByteString -> Either ResultError ByteString
forall a b. b -> Either a b
Right ByteString
bytes
        decimal :: ByteString -> Either ResultError c
decimal ByteString
bytes =
          (String -> ResultError) -> Either String c -> Either ResultError 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 -> ResultError
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))
            (Either String c -> Either ResultError c)
-> Either String c -> Either ResultError c
forall a b. (a -> b) -> a -> b
$ 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 :: [LibPQ.ExecStatus] -> Result ()
checkExecStatus :: [ExecStatus] -> Result ()
checkExecStatus [ExecStatus]
expectedList =
  {-# SCC "checkExecStatus" #-}
  do
    ExecStatus
status <- ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
-> Result ExecStatus
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
 -> Result ExecStatus)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
-> Result ExecStatus
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO ExecStatus)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO ExecStatus)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus)
-> ((Bool, Result) -> ExceptT ResultError IO ExecStatus)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> IO ExecStatus -> ExceptT ResultError IO ExecStatus
forall (m :: * -> *) a. Monad m => m a -> ExceptT ResultError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ExecStatus -> ExceptT ResultError IO ExecStatus)
-> IO ExecStatus -> ExceptT ResultError IO ExecStatus
forall a b. (a -> b) -> a -> b
$ Result -> IO ExecStatus
LibPQ.resultStatus Result
result
    Bool -> Result () -> Result ()
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) (Result () -> Result ()) -> Result () -> Result ()
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 -> () -> Result ()
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExecStatus
_ -> Text -> Result ()
forall a. Text -> Result a
unexpectedResult (Text -> Result ()) -> Text -> Result ()
forall a b. (a -> b) -> a -> b
$ 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)

unexpectedResult :: Text -> Result a
unexpectedResult :: forall a. Text -> Result a
unexpectedResult =
  ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> (Text -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> Text
-> Result a
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
. ExceptT ResultError IO a
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Bool, Result) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ResultError IO a
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> (Text -> ExceptT ResultError IO a)
-> Text
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
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
. IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> (Text -> IO (Either ResultError a))
-> Text
-> ExceptT ResultError IO a
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
. Either ResultError a -> IO (Either ResultError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResultError a -> IO (Either ResultError a))
-> (Text -> Either ResultError a)
-> Text
-> IO (Either ResultError a)
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
. ResultError -> Either ResultError a
forall a b. a -> Either a b
Left (ResultError -> Either ResultError a)
-> (Text -> ResultError) -> Text -> Either ResultError a
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
. Text -> ResultError
UnexpectedResult

{-# INLINE serverError #-}
serverError :: Result ()
serverError :: Result ()
serverError =
  ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ()
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
    (ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ()
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
    (((Bool, Result) -> ExceptT ResultError IO ())
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) ())
-> ((Bool, Result) -> ExceptT ResultError IO ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> IO (Either ResultError ()) -> ExceptT ResultError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError ()) -> ExceptT ResultError IO ())
-> IO (Either ResultError ()) -> ExceptT ResultError IO ()
forall a b. (a -> b) -> a -> b
$ do
      ByteString
code <-
        (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
          (IO (Maybe ByteString) -> IO ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagSqlstate
      ByteString
message <-
        (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
          (IO (Maybe ByteString) -> IO ByteString)
-> IO (Maybe ByteString) -> IO ByteString
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 <-
        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)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagStatementPosition
      pure $ ResultError -> Either ResultError ()
forall a b. a -> Either a b
Left (ResultError -> Either ResultError ())
-> ResultError -> Either ResultError ()
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 -> 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

{-# INLINE maybe #-}
maybe :: Row.Row a -> Result (Maybe a)
maybe :: forall a. Row a -> Result (Maybe a)
maybe Row a
rowDec =
  do
    [ExecStatus] -> Result ()
checkExecStatus [ExecStatus
LibPQ.TuplesOk]
    ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
-> Result (Maybe a)
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
      (ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
 -> Result (Maybe a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
-> Result (Maybe a)
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO (Maybe a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      (((Bool, Result) -> ExceptT ResultError IO (Maybe a))
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a))
-> ((Bool, Result) -> ExceptT ResultError IO (Maybe a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError (Maybe a))
-> ExceptT ResultError IO (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError (Maybe a))
 -> ExceptT ResultError IO (Maybe a))
-> IO (Either ResultError (Maybe a))
-> ExceptT ResultError IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
        Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
        case Row
maxRows of
          Row
0 -> Either ResultError (Maybe a) -> IO (Either ResultError (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Either ResultError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
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
            (Either (Int, RowError) a -> Either ResultError (Maybe a))
-> IO (Either (Int, RowError) a)
-> IO (Either ResultError (Maybe a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a)
-> Either ResultError a -> Either ResultError (Maybe a)
forall a b.
(a -> b) -> Either ResultError a -> Either ResultError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either ResultError a -> Either ResultError (Maybe a))
-> (Either (Int, RowError) a -> Either ResultError a)
-> Either (Int, RowError) a
-> Either ResultError (Maybe a)
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
. ((Int, RowError) -> ResultError)
-> Either (Int, RowError) a -> Either ResultError 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, RowError) -> ResultError
fromRowError) (IO (Either (Int, RowError) a)
 -> IO (Either ResultError (Maybe a)))
-> IO (Either (Int, RowError) a)
-> IO (Either ResultError (Maybe a))
forall a b. (a -> b) -> a -> b
$ Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
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
_ -> Either ResultError (Maybe a) -> IO (Either ResultError (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultError -> Either ResultError (Maybe a)
forall a b. a -> Either a b
Left (Int -> ResultError
UnexpectedAmountOfRows (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n

{-# INLINE single #-}
single :: Row.Row a -> Result a
single :: forall a. Row a -> Result a
single Row a
rowDec =
  do
    [ExecStatus] -> Result ()
checkExecStatus [ExecStatus
LibPQ.TuplesOk]
    ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
      (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      (((Bool, Result) -> ExceptT ResultError IO a)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> IO (Either ResultError a) -> ExceptT ResultError IO a
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
            (Either (Int, RowError) a -> Either ResultError a)
-> IO (Either (Int, RowError) a) -> IO (Either ResultError a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, RowError) -> ResultError)
-> Either (Int, RowError) a -> Either ResultError 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, RowError) -> ResultError
fromRowError) (IO (Either (Int, RowError) a) -> IO (Either ResultError a))
-> IO (Either (Int, RowError) a) -> IO (Either ResultError a)
forall a b. (a -> b) -> a -> b
$ Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
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
_ -> Either ResultError a -> IO (Either ResultError a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultError -> Either ResultError a
forall a b. a -> Either a b
Left (Int -> ResultError
UnexpectedAmountOfRows (Row -> Int
forall {b}. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n

{-# INLINE vector #-}
vector :: Row.Row a -> Result (Vector a)
vector :: forall a. Row a -> Result (Vector a)
vector Row a
rowDec =
  do
    [ExecStatus] -> Result ()
checkExecStatus [ExecStatus
LibPQ.TuplesOk]
    ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
-> Result (Vector a)
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
      (ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
 -> Result (Vector a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
-> Result (Vector a)
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO (Vector a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      (((Bool, Result) -> ExceptT ResultError IO (Vector a))
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a))
-> ((Bool, Result) -> ExceptT ResultError IO (Vector a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError (Vector a))
-> ExceptT ResultError IO (Vector a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError (Vector a))
 -> ExceptT ResultError IO (Vector a))
-> IO (Either ResultError (Vector a))
-> ExceptT ResultError IO (Vector a)
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 <- 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 ResultError)
failureRef <- Maybe ResultError -> IO (IORef (Maybe ResultError))
forall a. a -> IO (IORef a)
newIORef Maybe ResultError
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 (Int, RowError) a
rowResult <- Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row a
rowDec (Result
result, Int -> Row
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) -> IORef (Maybe ResultError) -> Maybe ResultError -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (ResultError -> Maybe ResultError
forall a. a -> Maybe a
Just (Int -> Int -> RowError -> ResultError
RowError Int
rowIndex Int
colIndex RowError
x))
            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 ResultError) -> IO (Maybe ResultError)
forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef IO (Maybe ResultError)
-> (Maybe ResultError -> IO (Either ResultError (Vector a)))
-> IO (Either ResultError (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 ResultError
Nothing -> Vector a -> Either ResultError (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either ResultError (Vector a))
-> IO (Vector a) -> IO (Either ResultError (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 ResultError
x -> Either ResultError (Vector a) -> IO (Either ResultError (Vector a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultError -> Either ResultError (Vector a)
forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.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 -> 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] -> Result ()
checkExecStatus [ExecStatus
LibPQ.TuplesOk]
    ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
      (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      (((Bool, Result) -> ExceptT ResultError IO a)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) ->
        IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
          (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> IO (Either ResultError a) -> ExceptT ResultError IO a
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 <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
init
            IORef (Maybe ResultError)
failureRef <- Maybe ResultError -> IO (IORef (Maybe ResultError))
forall a. a -> IO (IORef a)
newIORef Maybe ResultError
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 (Int, RowError) b
rowResult <- Row b
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) b)
forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row b
rowDec (Result
result, Int -> Row
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) -> IORef (Maybe ResultError) -> Maybe ResultError -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (ResultError -> Maybe ResultError
forall a. a -> Maybe a
Just (Int -> Int -> RowError -> ResultError
RowError Int
rowIndex Int
colIndex RowError
x))
                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 ResultError) -> IO (Maybe ResultError)
forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef IO (Maybe ResultError)
-> (Maybe ResultError -> IO (Either ResultError a))
-> IO (Either ResultError 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 ResultError
Nothing -> a -> Either ResultError a
forall a b. b -> Either a b
Right (a -> Either ResultError a) -> IO a -> IO (Either ResultError 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 ResultError
x -> Either ResultError a -> IO (Either ResultError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultError -> Either ResultError a
forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.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 -> 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] -> Result ()
checkExecStatus [ExecStatus
LibPQ.TuplesOk]
    ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result
      (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      (((Bool, Result) -> ExceptT ResultError IO a)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> IO (Either ResultError a) -> ExceptT ResultError IO a
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 <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
init
        IORef (Maybe ResultError)
failureRef <- Maybe ResultError -> IO (IORef (Maybe ResultError))
forall a. a -> IO (IORef a)
newIORef Maybe ResultError
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 (Int, RowError) b
rowResult <- Row b
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) b)
forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
Row.run Row b
rowDec (Result
result, Int -> Row
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) -> IORef (Maybe ResultError) -> Maybe ResultError -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (ResultError -> Maybe ResultError
forall a. a -> Maybe a
Just (Int -> Int -> RowError -> ResultError
RowError Int
rowIndex Int
colIndex RowError
x))
            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 ResultError) -> IO (Maybe ResultError)
forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef IO (Maybe ResultError)
-> (Maybe ResultError -> IO (Either ResultError a))
-> IO (Either ResultError 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 ResultError
Nothing -> a -> Either ResultError a
forall a b. b -> Either a b
Right (a -> Either ResultError a) -> IO a -> IO (Either ResultError 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 ResultError
x -> Either ResultError a -> IO (Either ResultError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultError -> Either ResultError a
forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.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