module Hasql.Decoders.Row where

import Hasql.Decoders.Value qualified as Value
import Hasql.Errors
import Hasql.LibPq14 qualified as LibPQ
import Hasql.Prelude hiding (error)
import PostgreSQL.Binary.Decoding qualified as A

newtype Row a
  = Row (ReaderT Env (ExceptT RowError IO) a)
  deriving ((forall a b. (a -> b) -> Row a -> Row b)
-> (forall a b. a -> Row b -> Row a) -> Functor Row
forall a b. a -> Row b -> Row a
forall a b. (a -> b) -> Row a -> Row 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) -> Row a -> Row b
fmap :: forall a b. (a -> b) -> Row a -> Row b
$c<$ :: forall a b. a -> Row b -> Row a
<$ :: forall a b. a -> Row b -> Row a
Functor, Functor Row
Functor Row =>
(forall a. a -> Row a)
-> (forall a b. Row (a -> b) -> Row a -> Row b)
-> (forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c)
-> (forall a b. Row a -> Row b -> Row b)
-> (forall a b. Row a -> Row b -> Row a)
-> Applicative Row
forall a. a -> Row a
forall a b. Row a -> Row b -> Row a
forall a b. Row a -> Row b -> Row b
forall a b. Row (a -> b) -> Row a -> Row b
forall a b c. (a -> b -> c) -> Row a -> Row b -> Row 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 -> Row a
pure :: forall a. a -> Row a
$c<*> :: forall a b. Row (a -> b) -> Row a -> Row b
<*> :: forall a b. Row (a -> b) -> Row a -> Row b
$cliftA2 :: forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c
liftA2 :: forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c
$c*> :: forall a b. Row a -> Row b -> Row b
*> :: forall a b. Row a -> Row b -> Row b
$c<* :: forall a b. Row a -> Row b -> Row a
<* :: forall a b. Row a -> Row b -> Row a
Applicative, Applicative Row
Applicative Row =>
(forall a b. Row a -> (a -> Row b) -> Row b)
-> (forall a b. Row a -> Row b -> Row b)
-> (forall a. a -> Row a)
-> Monad Row
forall a. a -> Row a
forall a b. Row a -> Row b -> Row b
forall a b. Row a -> (a -> Row b) -> Row 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. Row a -> (a -> Row b) -> Row b
>>= :: forall a b. Row a -> (a -> Row b) -> Row b
$c>> :: forall a b. Row a -> Row b -> Row b
>> :: forall a b. Row a -> Row b -> Row b
$creturn :: forall a. a -> Row a
return :: forall a. a -> Row a
Monad)

instance MonadFail Row where
  fail :: forall a. String -> Row a
fail = RowError -> Row a
forall a. RowError -> Row a
error (RowError -> Row a) -> (String -> RowError) -> String -> Row 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 -> RowError
ValueError (Text -> RowError) -> (String -> Text) -> String -> RowError
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
. String -> Text
forall a. IsString a => String -> a
fromString

data Env
  = Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column)

-- * Functions

{-# INLINE run #-}
run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either (Int, RowError) a)
run :: forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
run (Row ReaderT Env (ExceptT RowError IO) a
impl) (Result
result, Row
row, Column
columnsAmount, Bool
integerDatetimes) =
  do
    IORef Column
columnRef <- Column -> IO (IORef Column)
forall a. a -> IO (IORef a)
newIORef Column
0
    ExceptT RowError IO a -> IO (Either RowError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT Env (ExceptT RowError IO) a -> Env -> ExceptT RowError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Env (ExceptT RowError IO) a
impl (Result -> Row -> Column -> Bool -> IORef Column -> Env
Env Result
result Row
row Column
columnsAmount Bool
integerDatetimes IORef Column
columnRef)) IO (Either RowError a)
-> (Either RowError a -> IO (Either (Int, RowError) a))
-> IO (Either (Int, RowError) 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
      Left RowError
e -> do
        LibPQ.Col CInt
col <- IORef Column -> IO Column
forall a. IORef a -> IO a
readIORef IORef Column
columnRef
        -- -1 because succ is applied before the error is returned
        Either (Int, RowError) a -> IO (Either (Int, RowError) a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Int, RowError) a -> IO (Either (Int, RowError) a))
-> Either (Int, RowError) a -> IO (Either (Int, RowError) a)
forall a b. (a -> b) -> a -> b
$ (Int, RowError) -> Either (Int, RowError) a
forall a b. a -> Either a b
Left (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, RowError
e)
      Right a
x -> Either (Int, RowError) a -> IO (Either (Int, RowError) a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Int, RowError) a -> IO (Either (Int, RowError) a))
-> Either (Int, RowError) a -> IO (Either (Int, RowError) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (Int, RowError) a
forall a b. b -> Either a b
Right a
x

{-# INLINE error #-}
error :: RowError -> Row a
error :: forall a. RowError -> Row a
error RowError
x =
  ReaderT Env (ExceptT RowError IO) a -> Row a
forall a. ReaderT Env (ExceptT RowError IO) a -> Row a
Row ((Env -> ExceptT RowError IO a)
-> ReaderT Env (ExceptT RowError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (ExceptT RowError IO a -> Env -> ExceptT RowError IO a
forall a b. a -> b -> a
const (IO (Either RowError a) -> ExceptT RowError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either RowError a -> IO (Either RowError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowError -> Either RowError a
forall a b. a -> Either a b
Left RowError
x)))))

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE value #-}
value :: Value.Value a -> Row (Maybe a)
value :: forall a. Value a -> Row (Maybe a)
value Value a
valueDec =
  {-# SCC "value" #-}
  ReaderT Env (ExceptT RowError IO) (Maybe a) -> Row (Maybe a)
forall a. ReaderT Env (ExceptT RowError IO) a -> Row a
Row
    (ReaderT Env (ExceptT RowError IO) (Maybe a) -> Row (Maybe a))
-> ReaderT Env (ExceptT RowError IO) (Maybe a) -> Row (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Env -> ExceptT RowError IO (Maybe a))
-> ReaderT Env (ExceptT RowError IO) (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
    ((Env -> ExceptT RowError IO (Maybe a))
 -> ReaderT Env (ExceptT RowError IO) (Maybe a))
-> (Env -> ExceptT RowError IO (Maybe a))
-> ReaderT Env (ExceptT RowError IO) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(Env Result
result Row
row Column
columnsAmount Bool
integerDatetimes IORef Column
columnRef) -> IO (Either RowError (Maybe a)) -> ExceptT RowError IO (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either RowError (Maybe a)) -> ExceptT RowError IO (Maybe a))
-> IO (Either RowError (Maybe a)) -> ExceptT RowError IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      Column
col <- IORef Column -> IO Column
forall a. IORef a -> IO a
readIORef IORef Column
columnRef
      IORef Column -> Column -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Column
columnRef (Column -> Column
forall a. Enum a => a -> a
succ Column
col)
      if Column
col Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
columnsAmount
        then do
          Maybe ByteString
valueMaybe <- {-# SCC "getvalue'" #-} Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue' Result
result Row
row Column
col
          pure
            $ case Maybe ByteString
valueMaybe of
              Maybe ByteString
Nothing ->
                Maybe a -> Either RowError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
              Just ByteString
value ->
                (a -> Maybe a) -> Either RowError a -> Either RowError (Maybe a)
forall a b. (a -> b) -> Either RowError a -> Either RowError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just
                  (Either RowError a -> Either RowError (Maybe a))
-> Either RowError a -> Either RowError (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Text -> RowError) -> Either Text a -> Either RowError 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 Text -> RowError
ValueError
                  (Either Text a -> Either RowError a)
-> Either Text a -> Either RowError a
forall a b. (a -> b) -> a -> b
$ {-# SCC "decode" #-} Value a -> ByteString -> Either Text a
forall a. Value a -> ByteString -> Either Text a
A.valueParser (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
valueDec Bool
integerDatetimes) ByteString
value
        else Either RowError (Maybe a) -> IO (Either RowError (Maybe a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowError -> Either RowError (Maybe a)
forall a b. a -> Either a b
Left RowError
EndOfInput)

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE nonNullValue #-}
nonNullValue :: Value.Value a -> Row a
nonNullValue :: forall a. Value a -> Row a
nonNullValue Value a
valueDec =
  {-# SCC "nonNullValue" #-}
  Value a -> Row (Maybe a)
forall a. Value a -> Row (Maybe a)
value Value a
valueDec Row (Maybe a) -> (Maybe a -> Row a) -> Row a
forall a b. Row a -> (a -> Row b) -> Row b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Row a -> (a -> Row a) -> Maybe a -> Row a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RowError -> Row a
forall a. RowError -> Row a
error RowError
UnexpectedNull) a -> Row a
forall a. a -> Row a
forall (f :: * -> *) a. Applicative f => a -> f a
pure