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

{-# INLINE noResult #-}
noResult :: Result ()
noResult :: Result ()
noResult =
  (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
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 ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.CommandOk -> Bool
True
      ExecStatus
_ -> Bool
False
    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 {b}. Integral b => ByteString -> Either ResultError b
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 b
decimal ByteString
bytes =
          (String -> ResultError) -> Either String b -> Either ResultError b
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (\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 b -> Either ResultError b)
-> Either String b -> Either ResultError b
forall a b. (a -> b) -> a -> b
$ Parser b -> ByteString -> Either String b
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly (Parser b
forall a. Integral a => Parser a
Attoparsec.decimal Parser b -> Parser ByteString () -> Parser b
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 -> Bool) -> Result ()
checkExecStatus :: (ExecStatus -> Bool) -> Result ()
checkExecStatus ExecStatus -> Bool
predicate =
  {-# 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 -> Bool
predicate ExecStatus
status) (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
_ -> 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
$ ExceptT ResultError IO ()
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
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 ()
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) ())
-> ExceptT ResultError IO ()
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
$ Either ResultError () -> IO (Either ResultError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResultError () -> IO (Either ResultError ()))
-> Either ResultError () -> IO (Either ResultError ())
forall a b. (a -> b) -> a -> b
$ ResultError -> Either ResultError ()
forall a b. a -> Either a b
Left (ResultError -> Either ResultError ())
-> ResultError -> Either ResultError ()
forall a b. (a -> b) -> a -> b
$ Text -> ResultError
UnexpectedResult (Text -> ResultError) -> Text -> ResultError
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ExecStatus -> String
forall a. Show a => a -> String
show ExecStatus
status)

{-# 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
      Either ResultError () -> IO (Either ResultError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResultError () -> IO (Either ResultError ()))
-> Either ResultError () -> IO (Either ResultError ())
forall a b. (a -> b) -> a -> b
$ 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 -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    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 c b. (a -> c) -> Either a b -> Either c b
mapLeft (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 -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    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 c b. (a -> c) -> Either a b -> Either c b
mapLeft (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 -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    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 -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    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 -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    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