{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Things in this module are used for processing Postgres query result rows.
module PostgreSQL.Result.Row
  ( Row
  , runRow
  , runRowPq

  , ColumnRequest (..)
  , ColumnPosition (..)

    -- * Combinators
  , column
  , columnWith
  , fixedColumn
  , fixedColumnWith
  , namedColumn
  , namedColumnWith

    -- * Class
  , AutoRow (..)
  , genericRow
  , AutoColumnDelegate

    -- * Helpers
  , Fixed (..)
  , Named (..)
  )
where

import           Control.Applicative (liftA2)
import           Control.Monad (when)
import qualified Control.Monad.Except as Except
import           Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Control.Monad.Reader as Reader
import qualified Control.Monad.State.Strict as State
import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import           Data.Data (Proxy (..))
import           Data.Functor.Apply (Apply (..))
import           Data.Functor.Identity (Identity (..))
import           Data.Void (Void)
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified GHC.Generics as Generics
import           GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import           GHC.TypeNats (KnownNat, Nat, natVal)
import qualified PostgreSQL.Result.Cell as Cell
import qualified PostgreSQL.Result.Column as Column
import qualified PostgreSQL.Types as Types

-- | Position of a column
--
-- @since 0.0.0
data ColumnPosition
  = FixedColumn Types.ColumnNum
  -- ^ Column is at a fixed index.
  --
  -- @since 0.0.0
  | NamedColumn ByteString
  -- ^ Column has a fixed name.
  --
  -- @since 0.0.0
  deriving stock (Int -> ColumnPosition -> ShowS
[ColumnPosition] -> ShowS
ColumnPosition -> String
(Int -> ColumnPosition -> ShowS)
-> (ColumnPosition -> String)
-> ([ColumnPosition] -> ShowS)
-> Show ColumnPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnPosition] -> ShowS
$cshowList :: [ColumnPosition] -> ShowS
show :: ColumnPosition -> String
$cshow :: ColumnPosition -> String
showsPrec :: Int -> ColumnPosition -> ShowS
$cshowsPrec :: Int -> ColumnPosition -> ShowS
Show, ReadPrec [ColumnPosition]
ReadPrec ColumnPosition
Int -> ReadS ColumnPosition
ReadS [ColumnPosition]
(Int -> ReadS ColumnPosition)
-> ReadS [ColumnPosition]
-> ReadPrec ColumnPosition
-> ReadPrec [ColumnPosition]
-> Read ColumnPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColumnPosition]
$creadListPrec :: ReadPrec [ColumnPosition]
readPrec :: ReadPrec ColumnPosition
$creadPrec :: ReadPrec ColumnPosition
readList :: ReadS [ColumnPosition]
$creadList :: ReadS [ColumnPosition]
readsPrec :: Int -> ReadS ColumnPosition
$creadsPrec :: Int -> ReadS ColumnPosition
Read, ColumnPosition -> ColumnPosition -> Bool
(ColumnPosition -> ColumnPosition -> Bool)
-> (ColumnPosition -> ColumnPosition -> Bool) -> Eq ColumnPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnPosition -> ColumnPosition -> Bool
$c/= :: ColumnPosition -> ColumnPosition -> Bool
== :: ColumnPosition -> ColumnPosition -> Bool
$c== :: ColumnPosition -> ColumnPosition -> Bool
Eq, Eq ColumnPosition
Eq ColumnPosition
-> (ColumnPosition -> ColumnPosition -> Ordering)
-> (ColumnPosition -> ColumnPosition -> Bool)
-> (ColumnPosition -> ColumnPosition -> Bool)
-> (ColumnPosition -> ColumnPosition -> Bool)
-> (ColumnPosition -> ColumnPosition -> Bool)
-> (ColumnPosition -> ColumnPosition -> ColumnPosition)
-> (ColumnPosition -> ColumnPosition -> ColumnPosition)
-> Ord ColumnPosition
ColumnPosition -> ColumnPosition -> Bool
ColumnPosition -> ColumnPosition -> Ordering
ColumnPosition -> ColumnPosition -> ColumnPosition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColumnPosition -> ColumnPosition -> ColumnPosition
$cmin :: ColumnPosition -> ColumnPosition -> ColumnPosition
max :: ColumnPosition -> ColumnPosition -> ColumnPosition
$cmax :: ColumnPosition -> ColumnPosition -> ColumnPosition
>= :: ColumnPosition -> ColumnPosition -> Bool
$c>= :: ColumnPosition -> ColumnPosition -> Bool
> :: ColumnPosition -> ColumnPosition -> Bool
$c> :: ColumnPosition -> ColumnPosition -> Bool
<= :: ColumnPosition -> ColumnPosition -> Bool
$c<= :: ColumnPosition -> ColumnPosition -> Bool
< :: ColumnPosition -> ColumnPosition -> Bool
$c< :: ColumnPosition -> ColumnPosition -> Bool
compare :: ColumnPosition -> ColumnPosition -> Ordering
$ccompare :: ColumnPosition -> ColumnPosition -> Ordering
$cp1Ord :: Eq ColumnPosition
Ord)

-- | Request a column
--
-- @since 0.0.0
data ColumnRequest a = ColumnReqest -- ^ @since 0.0.0
  { ColumnRequest a -> ColumnPosition
columnRequest_position :: ColumnPosition
  -- ^ Location of the column
  --
  -- @since 0.0.0
  , ColumnRequest a -> Column a
columnRequest_parser :: Column.Column a
  -- ^ Parser for the column
  --
  -- @since 0.0.0
  }
  deriving stock a -> ColumnRequest b -> ColumnRequest a
(a -> b) -> ColumnRequest a -> ColumnRequest b
(forall a b. (a -> b) -> ColumnRequest a -> ColumnRequest b)
-> (forall a b. a -> ColumnRequest b -> ColumnRequest a)
-> Functor ColumnRequest
forall a b. a -> ColumnRequest b -> ColumnRequest a
forall a b. (a -> b) -> ColumnRequest a -> ColumnRequest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ColumnRequest b -> ColumnRequest a
$c<$ :: forall a b. a -> ColumnRequest b -> ColumnRequest a
fmap :: (a -> b) -> ColumnRequest a -> ColumnRequest b
$cfmap :: forall a b. (a -> b) -> ColumnRequest a -> ColumnRequest b
Functor

-- | Result row parser
--
-- @since 0.0.0
newtype Row a = Row
  { Row a
-> forall (m :: * -> *) (row :: * -> *).
   (Monad m, Applicative row) =>
   (forall x. ColumnRequest x -> m (row x))
   -> StateT ColumnNum m (row a)
_unRow
      :: forall m row
      .  (Monad m, Applicative row)
      => (forall x. ColumnRequest x -> m (row x))
      -> State.StateT Types.ColumnNum m (row a)
  }

-- | @since 0.0.0
instance Functor Row where
  fmap :: (a -> b) -> Row a -> Row b
fmap a -> b
f (Row forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
run) = (forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row b))
-> Row b
forall a.
(forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
Row (\forall x. ColumnRequest x -> m (row x)
liftRequest -> (a -> b) -> row a -> row b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (row a -> row b)
-> StateT ColumnNum m (row a) -> StateT ColumnNum m (row b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
run forall x. ColumnRequest x -> m (row x)
liftRequest)

  {-# INLINE fmap #-}

-- | @since 0.0.0
instance Applicative Row where
  pure :: a -> Row a
pure a
x = (forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
forall a.
(forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
Row ((forall (m :: * -> *) (row :: * -> *).
  (Monad m, Applicative row) =>
  (forall x. ColumnRequest x -> m (row x))
  -> StateT ColumnNum m (row a))
 -> Row a)
-> (forall (m :: * -> *) (row :: * -> *).
    (Monad m, Applicative row) =>
    (forall x. ColumnRequest x -> m (row x))
    -> StateT ColumnNum m (row a))
-> Row a
forall a b. (a -> b) -> a -> b
$ \forall x. ColumnRequest x -> m (row x)
_liftRequest -> row a -> StateT ColumnNum m (row a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (row a -> StateT ColumnNum m (row a))
-> row a -> StateT ColumnNum m (row a)
forall a b. (a -> b) -> a -> b
$ a -> row a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

  {-# INLINE pure #-}

  Row forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row (a -> b))
f <*> :: Row (a -> b) -> Row a -> Row b
<*> Row forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
x = (forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row b))
-> Row b
forall a.
(forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
Row ((forall (m :: * -> *) (row :: * -> *).
  (Monad m, Applicative row) =>
  (forall x. ColumnRequest x -> m (row x))
  -> StateT ColumnNum m (row b))
 -> Row b)
-> (forall (m :: * -> *) (row :: * -> *).
    (Monad m, Applicative row) =>
    (forall x. ColumnRequest x -> m (row x))
    -> StateT ColumnNum m (row b))
-> Row b
forall a b. (a -> b) -> a -> b
$ \forall x. ColumnRequest x -> m (row x)
liftRequest -> (row (a -> b) -> row a -> row b)
-> StateT ColumnNum m (row (a -> b))
-> StateT ColumnNum m (row a)
-> StateT ColumnNum m (row b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 row (a -> b) -> row a -> row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row (a -> b))
forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row (a -> b))
f forall x. ColumnRequest x -> m (row x)
liftRequest) ((forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
x forall x. ColumnRequest x -> m (row x)
liftRequest)

  {-# INLINE (<*>) #-}

-- | @since 0.0.0
instance Apply Row where
  <.> :: Row (a -> b) -> Row a -> Row b
(<.>) = Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

-- | Translate a 'Row' expression. Validate things in @m@ and parse each row in @row@.
--
-- @since 0.0.0
runRow
  :: (Monad m, Applicative row)
  => Row a
  -> (forall x. ColumnRequest x -> m (row x))
  -> m (row a)
runRow :: Row a -> (forall x. ColumnRequest x -> m (row x)) -> m (row a)
runRow (Row forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
run) forall x. ColumnRequest x -> m (row x)
liftRequest =
  StateT ColumnNum m (row a) -> ColumnNum -> m (row a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT ((forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
forall (m :: * -> *) (row :: * -> *).
(Monad m, Applicative row) =>
(forall x. ColumnRequest x -> m (row x))
-> StateT ColumnNum m (row a)
run forall x. ColumnRequest x -> m (row x)
liftRequest) ColumnNum
0

{-# INLINE runRow #-}

-- | Generate a row runner for libpq\'s 'PQ.Result'.
--
-- @since 0.0.0
runRowPq
  :: (Except.MonadError Types.ProcessorErrors m, MonadIO m)
  => PQ.Result
  -> Row a
  -> m (Types.RowNum -> m a)
runRowPq :: Result -> Row a -> m (RowNum -> m a)
runRowPq Result
result Row a
row = ReaderT RowNum m a -> RowNum -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (ReaderT RowNum m a -> RowNum -> m a)
-> m (ReaderT RowNum m a) -> m (RowNum -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Column
numCols <- IO Column -> m Column
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> IO Column
PQ.nfields Result
result)

  Row a
-> (forall x. ColumnRequest x -> m (ReaderT RowNum m x))
-> m (ReaderT RowNum m a)
forall (m :: * -> *) (row :: * -> *) a.
(Monad m, Applicative row) =>
Row a -> (forall x. ColumnRequest x -> m (row x)) -> m (row a)
runRow Row a
row ((forall x. ColumnRequest x -> m (ReaderT RowNum m x))
 -> m (ReaderT RowNum m a))
-> (forall x. ColumnRequest x -> m (ReaderT RowNum m x))
-> m (ReaderT RowNum m a)
forall a b. (a -> b) -> a -> b
$ \ColumnRequest x
req -> do
    Column
col <-
      case ColumnRequest x -> ColumnPosition
forall a. ColumnRequest a -> ColumnPosition
columnRequest_position ColumnRequest x
req of
        FixedColumn origCol :: ColumnNum
origCol@(Types.ColumnNum Column
col) -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Column
col Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
numCols) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            ProcessorErrors -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
Except.throwError [ColumnNum -> ColumnNum -> ProcessorError
Types.NotEnoughColumns ColumnNum
origCol (Column -> ColumnNum
Types.ColumnNum Column
numCols)]

          Column -> m Column
forall (f :: * -> *) a. Applicative f => a -> f a
pure Column
col

        NamedColumn ByteString
name -> do
          Maybe Column
mbCol <- IO (Maybe Column) -> m (Maybe Column)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> ByteString -> IO (Maybe Column)
PQ.fnumber Result
result ByteString
name)
          m Column -> (Column -> m Column) -> Maybe Column -> m Column
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ProcessorErrors -> m Column
forall e (m :: * -> *) a. MonadError e m => e -> m a
Except.throwError [ByteString -> ProcessorError
Types.MissingNamedColumn ByteString
name]) Column -> m Column
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Column
mbCol

    Oid
oid <- IO Oid -> m Oid
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> Column -> IO Oid
PQ.ftype Result
result Column
col)
    Format
format <- IO Format -> m Format
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> Column -> IO Format
PQ.fformat Result
result Column
col)

    Cell x
cell <-
      Either ProcessorErrors (Cell x) -> m (Cell x)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
Except.liftEither (Either ProcessorErrors (Cell x) -> m (Cell x))
-> Either ProcessorErrors (Cell x) -> m (Cell x)
forall a b. (a -> b) -> a -> b
$ (NonEmpty ParserError -> ProcessorErrors)
-> Either (NonEmpty ParserError) (Cell x)
-> Either ProcessorErrors (Cell x)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ParserError -> ProcessorError)
-> NonEmpty ParserError -> ProcessorErrors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnNum -> Oid -> Format -> ParserError -> ProcessorError
Types.ColumnParserError (Column -> ColumnNum
Types.ColumnNum Column
col) Oid
oid Format
format)) (Either (NonEmpty ParserError) (Cell x)
 -> Either ProcessorErrors (Cell x))
-> Either (NonEmpty ParserError) (Cell x)
-> Either ProcessorErrors (Cell x)
forall a b. (a -> b) -> a -> b
$
        Column x -> Oid -> Format -> Either (NonEmpty ParserError) (Cell x)
forall a.
Column a -> Oid -> Format -> Either (NonEmpty ParserError) (Cell a)
Column.parseColumn (ColumnRequest x -> Column x
forall a. ColumnRequest a -> Column a
columnRequest_parser ColumnRequest x
req) Oid
oid Format
format

    ReaderT RowNum m x -> m (ReaderT RowNum m x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReaderT RowNum m x -> m (ReaderT RowNum m x))
-> ReaderT RowNum m x -> m (ReaderT RowNum m x)
forall a b. (a -> b) -> a -> b
$ (RowNum -> m x) -> ReaderT RowNum m x
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((RowNum -> m x) -> ReaderT RowNum m x)
-> (RowNum -> m x) -> ReaderT RowNum m x
forall a b. (a -> b) -> a -> b
$ \(Types.RowNum Row
row) -> do
      Maybe ByteString
valueBare <- IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Result -> Row -> Column -> IO (Maybe ByteString)
PQ.getvalue' Result
result Row
row Column
col)
      let value :: Value
value = Value -> (ByteString -> Value) -> Maybe ByteString -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Types.Null ByteString -> Value
Types.Value Maybe ByteString
valueBare
      Either ProcessorErrors x -> m x
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
Except.liftEither
        (Either ProcessorErrors x -> m x)
-> Either ProcessorErrors x -> m x
forall a b. (a -> b) -> a -> b
$ (NonEmpty Text -> ProcessorErrors)
-> Either (NonEmpty Text) x -> Either ProcessorErrors x
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
            ((Text -> ProcessorError) -> NonEmpty Text -> ProcessorErrors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (ColumnNum
-> Oid -> Format -> RowNum -> Value -> Text -> ProcessorError
Types.CellParserError
                (Column -> ColumnNum
Types.ColumnNum Column
col)
                Oid
oid
                Format
format
                (Row -> RowNum
Types.RowNum Row
row)
                Value
value))
        (Either (NonEmpty Text) x -> Either ProcessorErrors x)
-> Either (NonEmpty Text) x -> Either ProcessorErrors x
forall a b. (a -> b) -> a -> b
$ Cell x -> Value -> Either (NonEmpty Text) x
forall a. Cell a -> Value -> Either (NonEmpty Text) a
Cell.parseCell Cell x
cell Value
value

{-# INLINE runRowPq #-}

-- | Floating column using the default 'Column.Column' for @a@
--
-- The position of this column is depenend on other floating columns left of it.
--
-- For example:
--
-- > foo = baz <$> column <*> column <*> column
-- > --            ^ A        ^ B        ^ C
--
-- Here, @A@ would be at index 0, @B@ at 1 and @C@ at 2.
-- Other non-floating columns do not impact the column indices.
--
-- @since 0.0.0
column :: Column.AutoColumn a => Row a
column :: Row a
column = Column a -> Row a
forall a. Column a -> Row a
columnWith Column a
forall a. AutoColumn a => Column a
Column.autoColumn

{-# INLINE column #-}

-- | Same as 'column' but lets you specify the 'Column.Column'.
--
-- @since 0.0.0
columnWith :: Column.Column a -> Row a
columnWith :: Column a -> Row a
columnWith Column a
column = (forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
forall a.
(forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
Row ((forall (m :: * -> *) (row :: * -> *).
  (Monad m, Applicative row) =>
  (forall x. ColumnRequest x -> m (row x))
  -> StateT ColumnNum m (row a))
 -> Row a)
-> (forall (m :: * -> *) (row :: * -> *).
    (Monad m, Applicative row) =>
    (forall x. ColumnRequest x -> m (row x))
    -> StateT ColumnNum m (row a))
-> Row a
forall a b. (a -> b) -> a -> b
$ \forall x. ColumnRequest x -> m (row x)
liftRequest -> do
  ColumnNum
col <- (ColumnNum -> (ColumnNum, ColumnNum))
-> StateT ColumnNum m ColumnNum
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (\ColumnNum
col -> (ColumnNum
col, ColumnNum
col ColumnNum -> ColumnNum -> ColumnNum
forall a. Num a => a -> a -> a
+ ColumnNum
1))
  m (row a) -> StateT ColumnNum m (row a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (m (row a) -> StateT ColumnNum m (row a))
-> m (row a) -> StateT ColumnNum m (row a)
forall a b. (a -> b) -> a -> b
$ ColumnRequest a -> m (row a)
forall x. ColumnRequest x -> m (row x)
liftRequest ColumnReqest :: forall a. ColumnPosition -> Column a -> ColumnRequest a
ColumnReqest
    { columnRequest_position :: ColumnPosition
columnRequest_position = ColumnNum -> ColumnPosition
FixedColumn ColumnNum
col
    , columnRequest_parser :: Column a
columnRequest_parser = Column a
column
    }

{-# INLINE columnWith #-}

-- | Fixed-position column using the default 'Column.Column' for @a@
--
-- @since 0.0.0
fixedColumn :: Column.AutoColumn a => Types.ColumnNum -> Row a
fixedColumn :: ColumnNum -> Row a
fixedColumn ColumnNum
num = ColumnNum -> Column a -> Row a
forall a. ColumnNum -> Column a -> Row a
fixedColumnWith ColumnNum
num Column a
forall a. AutoColumn a => Column a
Column.autoColumn

{-# INLINE fixedColumn #-}

-- | Same as 'fixedColumn' but lets you specify the 'Column.Column'.
--
-- @since 0.0.0
fixedColumnWith :: Types.ColumnNum -> Column.Column a -> Row a
fixedColumnWith :: ColumnNum -> Column a -> Row a
fixedColumnWith ColumnNum
number Column a
column = (forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
forall a.
(forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
Row ((forall (m :: * -> *) (row :: * -> *).
  (Monad m, Applicative row) =>
  (forall x. ColumnRequest x -> m (row x))
  -> StateT ColumnNum m (row a))
 -> Row a)
-> (forall (m :: * -> *) (row :: * -> *).
    (Monad m, Applicative row) =>
    (forall x. ColumnRequest x -> m (row x))
    -> StateT ColumnNum m (row a))
-> Row a
forall a b. (a -> b) -> a -> b
$ \forall x. ColumnRequest x -> m (row x)
liftRequest -> m (row a) -> StateT ColumnNum m (row a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (m (row a) -> StateT ColumnNum m (row a))
-> m (row a) -> StateT ColumnNum m (row a)
forall a b. (a -> b) -> a -> b
$
  ColumnRequest a -> m (row a)
forall x. ColumnRequest x -> m (row x)
liftRequest ColumnReqest :: forall a. ColumnPosition -> Column a -> ColumnRequest a
ColumnReqest
    { columnRequest_position :: ColumnPosition
columnRequest_position = ColumnNum -> ColumnPosition
FixedColumn ColumnNum
number
    , columnRequest_parser :: Column a
columnRequest_parser = Column a
column
    }

{-# INLINE fixedColumnWith #-}

-- | Named column using the default 'Column.Column' for @a@
--
-- @since 0.0.0
namedColumn :: Column.AutoColumn a => ByteString -> Row a
namedColumn :: ByteString -> Row a
namedColumn ByteString
name = ByteString -> Column a -> Row a
forall a. ByteString -> Column a -> Row a
namedColumnWith ByteString
name Column a
forall a. AutoColumn a => Column a
Column.autoColumn

{-# INLINE namedColumn #-}

-- | Same as 'namedColumn' but lets you specify the 'Column.Column'.
--
-- @since 0.0.0
namedColumnWith :: ByteString -> Column.Column a -> Row a
namedColumnWith :: ByteString -> Column a -> Row a
namedColumnWith ByteString
name Column a
column = (forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
forall a.
(forall (m :: * -> *) (row :: * -> *).
 (Monad m, Applicative row) =>
 (forall x. ColumnRequest x -> m (row x))
 -> StateT ColumnNum m (row a))
-> Row a
Row ((forall (m :: * -> *) (row :: * -> *).
  (Monad m, Applicative row) =>
  (forall x. ColumnRequest x -> m (row x))
  -> StateT ColumnNum m (row a))
 -> Row a)
-> (forall (m :: * -> *) (row :: * -> *).
    (Monad m, Applicative row) =>
    (forall x. ColumnRequest x -> m (row x))
    -> StateT ColumnNum m (row a))
-> Row a
forall a b. (a -> b) -> a -> b
$ \forall x. ColumnRequest x -> m (row x)
liftRequest -> m (row a) -> StateT ColumnNum m (row a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (m (row a) -> StateT ColumnNum m (row a))
-> m (row a) -> StateT ColumnNum m (row a)
forall a b. (a -> b) -> a -> b
$
  ColumnRequest a -> m (row a)
forall x. ColumnRequest x -> m (row x)
liftRequest ColumnReqest :: forall a. ColumnPosition -> Column a -> ColumnRequest a
ColumnReqest
    { columnRequest_position :: ColumnPosition
columnRequest_position = ByteString -> ColumnPosition
NamedColumn ByteString
name
    , columnRequest_parser :: Column a
columnRequest_parser = Column a
column
    }

{-# INLINE namedColumnWith #-}

-- | Generic row parser
--
-- You can use this with your 'Generics.Generic'-implementing data types.
--
-- > data Foo = Foo
-- >   { bar :: Integer
-- >   , baz :: Text
-- >   }
-- >   deriving Generic
-- >
-- > fooRow :: Row Foo
-- > fooRow = genericRow
--
-- @since 0.0.0
genericRow :: (Generics.Generic a, AutoRow (Generics.Rep a Void)) => Row a
genericRow :: Row a
genericRow = Rep a Void -> a
forall a x. Generic a => Rep a x -> a
Generics.to @_ @Void (Rep a Void -> a) -> Row (Rep a Void) -> Row a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Rep a Void)
forall a. AutoRow a => Row a
autoRow

{-# INLINE genericRow #-}

-- | Value for a column at a fixed location
--
-- @since 0.0.0
newtype Fixed (index :: Nat) a = Fixed
  { Fixed index a -> a
fromFixed :: a }

-- | Value for a named column
--
-- @since 0.0.0
newtype Named (name :: Symbol) a = Named
  { Named name a -> a
fromNamed :: a }

-- | This class is used to intercept instance heads like 'Fixed' and 'Named' that have special
-- additional meaning. For most cases it will delegate to 'Column.AutoColumn'.
--
-- Use this class instead of 'Column.AutoColumn' when implementing 'AutoRow' instances.
--
-- @since 0.0.0
class AutoColumnDelegate a where
  autoColumnDelegate :: Row a

-- | Uses 'fixedColumn' with @index@ to construct the 'Row'
--
-- @since 0.0.0
instance (KnownNat index, Column.AutoColumn a) => AutoColumnDelegate (Fixed index a) where
  autoColumnDelegate :: Row (Fixed index a)
autoColumnDelegate = a -> Fixed index a
forall (index :: Nat) a. a -> Fixed index a
Fixed (a -> Fixed index a) -> Row a -> Row (Fixed index a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnNum -> Row a
forall a. AutoColumn a => ColumnNum -> Row a
fixedColumn (Natural -> ColumnNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy index -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal @index Proxy index
forall k (t :: k). Proxy t
Proxy))

-- | Uses 'namedColumn' with @name@ to construct the 'Row'
--
-- @since 0.0.0
instance (KnownSymbol name, Column.AutoColumn a) => AutoColumnDelegate (Named name a) where
  autoColumnDelegate :: Row (Named name a)
autoColumnDelegate = a -> Named name a
forall (name :: Symbol) a. a -> Named name a
Named (a -> Named name a) -> Row a -> Row (Named name a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Row a
forall a. AutoColumn a => ByteString -> Row a
namedColumn (String -> ByteString
Char8.pack (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @name Proxy name
forall k (t :: k). Proxy t
Proxy))

-- | Passthrough to 'Column.AutoColumn'
--
-- @since 0.0.0
instance {-# OVERLAPPABLE #-} Column.AutoColumn a => AutoColumnDelegate a where
  autoColumnDelegate :: Row a
autoColumnDelegate = Row a
forall a. AutoColumn a => Row a
column

-- | Default row parser for a type
--
-- @since 0.0.0
class AutoRow a where
  -- | Default row parser for @a@
  --
  -- You may omit a definition for 'autoRow' if @a@ implements 'Generics.Generic'.
  --
  -- @since 0.0.0
  autoRow :: Row a

  default autoRow :: (Generics.Generic a, AutoRow (Generics.Rep a Void)) => Row a
  autoRow = Row a
forall a. (Generic a, AutoRow (Rep a Void)) => Row a
genericRow

  {-# INLINE autoRow #-}

-- | @since 0.0.0
instance AutoColumnDelegate a => AutoRow (Generics.K1 tag a x) where
  autoRow :: Row (K1 tag a x)
autoRow = a -> K1 tag a x
forall k i c (p :: k). c -> K1 i c p
Generics.K1 (a -> K1 tag a x) -> Row a -> Row (K1 tag a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
forall a. AutoColumnDelegate a => Row a
autoColumnDelegate

  {-# INLINE autoRow #-}

-- | @since 0.0.0
instance AutoRow (f x) => AutoRow (Generics.M1 tag meta f x) where
  autoRow :: Row (M1 tag meta f x)
autoRow = f x -> M1 tag meta f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (f x -> M1 tag meta f x) -> Row (f x) -> Row (M1 tag meta f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (f x)
forall a. AutoRow a => Row a
autoRow

  {-# INLINE autoRow #-}

-- | @since 0.0.0
instance (AutoRow (lhs x), AutoRow (rhs x)) => AutoRow ((Generics.:*:) lhs rhs x) where
  autoRow :: Row ((:*:) lhs rhs x)
autoRow = lhs x -> rhs x -> (:*:) lhs rhs x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(Generics.:*:) (lhs x -> rhs x -> (:*:) lhs rhs x)
-> Row (lhs x) -> Row (rhs x -> (:*:) lhs rhs x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (lhs x)
forall a. AutoRow a => Row a
autoRow Row (rhs x -> (:*:) lhs rhs x)
-> Row (rhs x) -> Row ((:*:) lhs rhs x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row (rhs x)
forall a. AutoRow a => Row a
autoRow

  {-# INLINE autoRow #-}

-- | @since 0.0.0
instance AutoColumnDelegate a => AutoRow (Identity a)

-- | @since 0.0.0
instance
  ( AutoColumnDelegate a
  , AutoColumnDelegate b
  )
  => AutoRow (a, b)

-- | @since 0.0.0
instance
  ( AutoColumnDelegate a
  , AutoColumnDelegate b
  , AutoColumnDelegate c
  )
  => AutoRow (a, b, c)

-- | @since 0.0.0
instance
  ( AutoColumnDelegate a
  , AutoColumnDelegate b
  , AutoColumnDelegate c
  , AutoColumnDelegate d
  )
  => AutoRow (a, b, c, d)

-- | @since 0.0.0
instance
  ( AutoColumnDelegate a
  , AutoColumnDelegate b
  , AutoColumnDelegate c
  , AutoColumnDelegate d
  , AutoColumnDelegate e
  )
  => AutoRow (a, b, c, d, e)

-- | @since 0.0.0
instance
  ( AutoColumnDelegate a
  , AutoColumnDelegate b
  , AutoColumnDelegate c
  , AutoColumnDelegate d
  , AutoColumnDelegate e
  , AutoColumnDelegate f
  )
  => AutoRow (a, b, c, d, e, f)

-- | @since 0.0.0
instance
  ( AutoColumnDelegate a
  , AutoColumnDelegate b
  , AutoColumnDelegate c
  , AutoColumnDelegate d
  , AutoColumnDelegate e
  , AutoColumnDelegate f
  , AutoColumnDelegate g
  )
  => AutoRow (a, b, c, d, e, f, g)