-- | Lower level context focused on just the actual decoding of values. No metadata involved.
module Hasql.Comms.RowReader
  ( RowReader,
    nullableColumn,
    nonNullableColumn,

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

    -- * Relations
    toHandler,
  )
where

import Hasql.Platform.Prelude
import Hasql.Pq qualified as Pq

data Error
  = CellError
      -- | Column index, 0-based.
      Int
      -- | OID of the column type as reported by Postgres.
      Word32
      -- | Underlying error.
      CellError
  | RefinementError Text
  deriving stock (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)

data CellError
  = DecodingCellError Text
  | UnexpectedNullCellError
  deriving stock (CellError -> CellError -> Bool
(CellError -> CellError -> Bool)
-> (CellError -> CellError -> Bool) -> Eq CellError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellError -> CellError -> Bool
== :: CellError -> CellError -> Bool
$c/= :: CellError -> CellError -> Bool
/= :: CellError -> CellError -> Bool
Eq, Int -> CellError -> ShowS
[CellError] -> ShowS
CellError -> String
(Int -> CellError -> ShowS)
-> (CellError -> String)
-> ([CellError] -> ShowS)
-> Show CellError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellError -> ShowS
showsPrec :: Int -> CellError -> ShowS
$cshow :: CellError -> String
show :: CellError -> String
$cshowList :: [CellError] -> ShowS
showList :: [CellError] -> ShowS
Show)

newtype RowReader a
  = RowReader (StateT Pq.Column (ReaderT Env (ExceptT Error IO)) a)
  deriving
    ((forall a b. (a -> b) -> RowReader a -> RowReader b)
-> (forall a b. a -> RowReader b -> RowReader a)
-> Functor RowReader
forall a b. a -> RowReader b -> RowReader a
forall a b. (a -> b) -> RowReader a -> RowReader 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) -> RowReader a -> RowReader b
fmap :: forall a b. (a -> b) -> RowReader a -> RowReader b
$c<$ :: forall a b. a -> RowReader b -> RowReader a
<$ :: forall a b. a -> RowReader b -> RowReader a
Functor, Functor RowReader
Functor RowReader =>
(forall a. a -> RowReader a)
-> (forall a b. RowReader (a -> b) -> RowReader a -> RowReader b)
-> (forall a b c.
    (a -> b -> c) -> RowReader a -> RowReader b -> RowReader c)
-> (forall a b. RowReader a -> RowReader b -> RowReader b)
-> (forall a b. RowReader a -> RowReader b -> RowReader a)
-> Applicative RowReader
forall a. a -> RowReader a
forall a b. RowReader a -> RowReader b -> RowReader a
forall a b. RowReader a -> RowReader b -> RowReader b
forall a b. RowReader (a -> b) -> RowReader a -> RowReader b
forall a b c.
(a -> b -> c) -> RowReader a -> RowReader b -> RowReader 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 -> RowReader a
pure :: forall a. a -> RowReader a
$c<*> :: forall a b. RowReader (a -> b) -> RowReader a -> RowReader b
<*> :: forall a b. RowReader (a -> b) -> RowReader a -> RowReader b
$cliftA2 :: forall a b c.
(a -> b -> c) -> RowReader a -> RowReader b -> RowReader c
liftA2 :: forall a b c.
(a -> b -> c) -> RowReader a -> RowReader b -> RowReader c
$c*> :: forall a b. RowReader a -> RowReader b -> RowReader b
*> :: forall a b. RowReader a -> RowReader b -> RowReader b
$c<* :: forall a b. RowReader a -> RowReader b -> RowReader a
<* :: forall a b. RowReader a -> RowReader b -> RowReader a
Applicative)
    via (StateT Pq.Column (ReaderT Env (ExceptT Error IO)))

data Env
  = Env
      Pq.Result
      Pq.Row

-- * Instances

instance Filterable RowReader where
  {-# INLINE mapMaybe #-}
  mapMaybe :: forall a b. (a -> Maybe b) -> RowReader a -> RowReader b
mapMaybe a -> Maybe b
fn (RowReader StateT Column (ReaderT Env (ExceptT Error IO)) a
run) =
    StateT Column (ReaderT Env (ExceptT Error IO)) b -> RowReader b
forall a.
StateT Column (ReaderT Env (ExceptT Error IO)) a -> RowReader a
RowReader do
      a
result <- StateT Column (ReaderT Env (ExceptT Error IO)) a
run
      case a -> Maybe b
fn a
result of
        Just b
refined -> b -> StateT Column (ReaderT Env (ExceptT Error IO)) b
forall a. a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
refined
        Maybe b
Nothing -> Error -> StateT Column (ReaderT Env (ExceptT Error IO)) b
forall a. Error -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> Error
RefinementError Text
"Filtration failed")

-- * Functions

{-# INLINE toHandler #-}
toHandler :: RowReader a -> Pq.Result -> Pq.Row -> IO (Either Error a)
toHandler :: forall a. RowReader a -> Result -> Row -> IO (Either Error a)
toHandler (RowReader StateT Column (ReaderT Env (ExceptT Error IO)) a
f) Result
result Row
row =
  let env :: Env
env = Result -> Row -> Env
Env Result
result Row
row
   in ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT Env (ExceptT Error IO) a -> Env -> ExceptT Error IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT Column (ReaderT Env (ExceptT Error IO)) a
-> Column -> ReaderT Env (ExceptT Error IO) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT Column (ReaderT Env (ExceptT Error IO)) a
f Column
0) Env
env)

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE column #-}
column :: (Maybe a -> Maybe b) -> (ByteString -> Either Text a) -> RowReader b
column :: forall a b.
(Maybe a -> Maybe b)
-> (ByteString -> Either Text a) -> RowReader b
column Maybe a -> Maybe b
processNullable ByteString -> Either Text a
valueDec = StateT Column (ReaderT Env (ExceptT Error IO)) b -> RowReader b
forall a.
StateT Column (ReaderT Env (ExceptT Error IO)) a -> RowReader a
RowReader do
  Column
col <- StateT Column (ReaderT Env (ExceptT Error IO)) Column
forall s (m :: * -> *). MonadState s m => m s
get
  Env Result
result Row
row <- StateT Column (ReaderT Env (ExceptT Error IO)) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let colInt :: Int
colInt = Column -> Int
Pq.colToInt Column
col
  Column -> StateT Column (ReaderT Env (ExceptT Error IO)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Column -> Column
forall a. Enum a => a -> a
succ Column
col)

  Maybe ByteString
valueMaybe <- IO (Maybe ByteString)
-> StateT
     Column (ReaderT Env (ExceptT Error IO)) (Maybe ByteString)
forall a. IO a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ({-# SCC "getvalue'" #-} Result -> Row -> Column -> IO (Maybe ByteString)
Pq.getvalue' Result
result Row
row Column
col)

  Maybe a
valueMaybe <- case Maybe ByteString
valueMaybe of
    Maybe ByteString
Nothing -> Maybe a -> StateT Column (ReaderT Env (ExceptT Error IO)) (Maybe a)
forall a. a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just ByteString
v -> do
      Word32
oid <- Oid -> Word32
Pq.oidToWord32 (Oid -> Word32)
-> StateT Column (ReaderT Env (ExceptT Error IO)) Oid
-> StateT Column (ReaderT Env (ExceptT Error IO)) Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Oid -> StateT Column (ReaderT Env (ExceptT Error IO)) Oid
forall a. IO a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> Column -> IO Oid
Pq.ftype Result
result Column
col)
      case {-# SCC "decode" #-} ByteString -> Either Text a
valueDec ByteString
v of
        Left Text
err -> Error -> StateT Column (ReaderT Env (ExceptT Error IO)) (Maybe a)
forall a. Error -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Int -> Word32 -> CellError -> Error
CellError Int
colInt Word32
oid (Text -> CellError
DecodingCellError Text
err))
        Right a
decoded -> Maybe a -> StateT Column (ReaderT Env (ExceptT Error IO)) (Maybe a)
forall a. a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
decoded)

  case Maybe a -> Maybe b
processNullable Maybe a
valueMaybe of
    Maybe b
Nothing -> do
      Word32
oid <- Oid -> Word32
Pq.oidToWord32 (Oid -> Word32)
-> StateT Column (ReaderT Env (ExceptT Error IO)) Oid
-> StateT Column (ReaderT Env (ExceptT Error IO)) Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Oid -> StateT Column (ReaderT Env (ExceptT Error IO)) Oid
forall a. IO a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> Column -> IO Oid
Pq.ftype Result
result Column
col)
      Error -> StateT Column (ReaderT Env (ExceptT Error IO)) b
forall a. Error -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Int -> Word32 -> CellError -> Error
CellError Int
colInt Word32
oid CellError
UnexpectedNullCellError)
    Just b
decoded -> b -> StateT Column (ReaderT Env (ExceptT Error IO)) b
forall a. a -> StateT Column (ReaderT Env (ExceptT Error IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
decoded

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE nullableColumn #-}
nullableColumn :: (ByteString -> Either Text a) -> RowReader (Maybe a)
nullableColumn :: forall a. (ByteString -> Either Text a) -> RowReader (Maybe a)
nullableColumn = (Maybe a -> Maybe (Maybe a))
-> (ByteString -> Either Text a) -> RowReader (Maybe a)
forall a b.
(Maybe a -> Maybe b)
-> (ByteString -> Either Text a) -> RowReader b
column Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE nonNullableColumn #-}
nonNullableColumn :: (ByteString -> Either Text a) -> RowReader a
nonNullableColumn :: forall a. (ByteString -> Either Text a) -> RowReader a
nonNullableColumn = (Maybe a -> Maybe a)
-> (ByteString -> Either Text a) -> RowReader a
forall a b.
(Maybe a -> Maybe b)
-> (ByteString -> Either Text a) -> RowReader b
column Maybe a -> Maybe a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id