{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Exports of this module are concerned with columns in a Postgres query result. This includes
-- validation of type and format. Parsing of the actual cell values in a column is delegated to
-- "PostgreSQL.Result.Cell".
module PostgreSQL.Result.Column
  ( -- * Column
    Column (..)

    -- ** Basics
  , ignored
  , raw
  , text
  , readable

    -- ** Helpful combinators
  , unchecked
  , validate
  , onlyTextual
  , onlyBinary

    -- * Class
  , AutoColumn (..)

    -- * Helpers
  , Readable (..)
  , RawValue (..)
  )
where

import           Data.ByteString (ByteString)
import           Data.Coerce (coerce)
import           Data.Functor.Alt (Alt (..))
import           Data.Text (Text)
import           Numeric.Natural (Natural)
import qualified PostgreSQL.Result.Cell as Cell
import           PostgreSQL.Types (Format (..), Oid (..), ParserError (..), ParserErrors, Value)

-- | Result column parser
--
-- @since 0.0.0
newtype Column a = Column
  { Column a -> Oid -> Format -> Either ParserErrors (Cell a)
parseColumn
      :: Oid -- OID of the column type
      -> Format -- Format in which the cells of this column will appear
      -> Either ParserErrors (Cell.Cell a)
  }
  deriving stock Functor -- ^ @since 0.0.0

-- | @since 0.0.0
instance Alt Column where
  Column Oid -> Format -> Either ParserErrors (Cell a)
lhs <!> :: Column a -> Column a -> Column a
<!> Column Oid -> Format -> Either ParserErrors (Cell a)
rhs = (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a.
(Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
Column ((Oid -> Format -> Either ParserErrors (Cell a)) -> Column a)
-> (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a b. (a -> b) -> a -> b
$ \Oid
typ Format
format ->
    case (Oid -> Format -> Either ParserErrors (Cell a)
lhs Oid
typ Format
format, Oid -> Format -> Either ParserErrors (Cell a)
rhs Oid
typ Format
format) of
      (Right Cell a
lhsParser, Right Cell a
rhsParser) ->
        -- Both parsers at the column level succeeded. This means we must pass the alternation down
        -- to the cell-level parser.
        Cell a -> Either ParserErrors (Cell a)
forall a b. b -> Either a b
Right (Cell a
lhsParser Cell a -> Cell a -> Cell a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Cell a
rhsParser)

      (Left ParserErrors
lhsErrors, Left ParserErrors
rhsErrors) ->
        -- Both have failed, therefore we must combine the errors.
        ParserErrors -> Either ParserErrors (Cell a)
forall a b. a -> Either a b
Left (ParserErrors
lhsErrors ParserErrors -> ParserErrors -> ParserErrors
forall a. Semigroup a => a -> a -> a
<> ParserErrors
rhsErrors)

      (Either ParserErrors (Cell a)
lhs, Either ParserErrors (Cell a)
rhs) ->
        -- At this point we know that exactly one parser at the column level has failed.
        Either ParserErrors (Cell a)
lhs Either ParserErrors (Cell a)
-> Either ParserErrors (Cell a) -> Either ParserErrors (Cell a)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Either ParserErrors (Cell a)
rhs

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

-- | Lift a cell parser. This does perform any validation on column type or format.
--
-- @since 0.0.0
unchecked :: Cell.Cell a -> Column a
unchecked :: Cell a -> Column a
unchecked Cell a
parser = (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a.
(Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
Column ((Oid -> Format -> Either ParserErrors (Cell a)) -> Column a)
-> (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a b. (a -> b) -> a -> b
$ \Oid
_ Format
_ -> Cell a -> Either ParserErrors (Cell a)
forall a b. b -> Either a b
Right Cell a
parser

{-# INLINE unchecked #-}

-- | Only allow textual format.
--
-- @since 0.0.0
onlyTextual :: Column a -> Column a
onlyTextual :: Column a -> Column a
onlyTextual (Column Oid -> Format -> Either ParserErrors (Cell a)
run) = (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a.
(Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
Column ((Oid -> Format -> Either ParserErrors (Cell a)) -> Column a)
-> (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a b. (a -> b) -> a -> b
$ \Oid
oid Format
format ->
  case Format
format of
    Format
Binary -> ParserErrors -> Either ParserErrors (Cell a)
forall a b. a -> Either a b
Left [Format -> ParserError
UnsupportedFormat Format
format]
    Format
Text -> Oid -> Format -> Either ParserErrors (Cell a)
run Oid
oid Format
format

{-# INLINE onlyTextual #-}

-- | Only allow binary format.
--
-- @since 0.0.0
onlyBinary :: Column a -> Column a
onlyBinary :: Column a -> Column a
onlyBinary (Column Oid -> Format -> Either ParserErrors (Cell a)
run) = (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a.
(Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
Column ((Oid -> Format -> Either ParserErrors (Cell a)) -> Column a)
-> (Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
forall a b. (a -> b) -> a -> b
$ \Oid
oid Format
format ->
  case Format
format of
    Format
Text -> ParserErrors -> Either ParserErrors (Cell a)
forall a b. a -> Either a b
Left [Format -> ParserError
UnsupportedFormat Format
format]
    Format
Binary -> Oid -> Format -> Either ParserErrors (Cell a)
run Oid
oid Format
format

{-# INLINE onlyBinary #-}

-- | Validate the result of a cell parser.
--
-- @since 0.0.0
validate :: Column a -> (a -> Either Text b) -> Column b
validate :: Column a -> (a -> Either Text b) -> Column b
validate (Column Oid -> Format -> Either ParserErrors (Cell a)
run) a -> Either Text b
f = (Oid -> Format -> Either ParserErrors (Cell b)) -> Column b
forall a.
(Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
Column ((Oid -> Format -> Either ParserErrors (Cell b)) -> Column b)
-> (Oid -> Format -> Either ParserErrors (Cell b)) -> Column b
forall a b. (a -> b) -> a -> b
$ \Oid
oid Format
fmt -> do
  Cell a
parser <- Oid -> Format -> Either ParserErrors (Cell a)
run Oid
oid Format
fmt
  Cell b -> Either ParserErrors (Cell b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cell a -> (a -> Either Text b) -> Cell b
forall a b. Cell a -> (a -> Either Text b) -> Cell b
Cell.validate Cell a
parser a -> Either Text b
f)

{-# INLINE validate #-}

-- | Don't parse the column.
--
-- @since 0.0.0
ignored :: Column ()
ignored :: Column ()
ignored = Cell () -> Column ()
forall a. Cell a -> Column a
unchecked Cell ()
Cell.ignored

{-# INLINE ignored #-}

-- | Raw value. Rejects @NULL@.
--
-- @since 0.0.0
raw :: Column ByteString
raw :: Column ByteString
raw = Cell ByteString -> Column ByteString
forall a. Cell a -> Column a
unchecked Cell ByteString
Cell.raw

{-# INLINE raw #-}

-- | Parse as UTF-8 'Text'. See 'Cell.text'.
--
-- @since 0.0.0
text :: Column Text
text :: Column Text
text = Column Text -> Column Text
forall a. Column a -> Column a
onlyTextual (Cell Text -> Column Text
forall a. Cell a -> Column a
unchecked Cell Text
Cell.text)

{-# INLINE text #-}

-- | Parse something using its 'Read' instance. Only supports textual format. See 'Cell.readable'.
--
-- @since 0.0.0
readable :: Read a => Column a
readable :: Column a
readable = Column a -> Column a
forall a. Column a -> Column a
onlyTextual (Cell a -> Column a
forall a. Cell a -> Column a
unchecked Cell a
forall a. Read a => Cell a
Cell.readable)

{-# INLINE readable #-}

-- | Default column parser for a type
--
-- @since 0.0.0
class AutoColumn a where
  -- | Default column parser for @a@
  --
  -- @since 0.0.0
  autoColumn :: Column a

-- | @since 0.0.0
instance AutoColumn () where
  autoColumn :: Column ()
autoColumn = Column ()
ignored

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Int where
  autoColumn :: Column Int
autoColumn = Column Int
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Word where
  autoColumn :: Column Word
autoColumn = Column Word
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Integer where
  autoColumn :: Column Integer
autoColumn = Column Integer
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Natural where
  autoColumn :: Column Natural
autoColumn = Column Natural
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Float where
  autoColumn :: Column Float
autoColumn = Column Float
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Double where
  autoColumn :: Column Double
autoColumn = Column Double
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Oid where
  autoColumn :: Column Oid
autoColumn = CUInt -> Oid
Oid (CUInt -> Oid) -> Column CUInt -> Column Oid
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Column CUInt
forall a. Read a => Column a
readable

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance AutoColumn Text where
  autoColumn :: Column Text
autoColumn = Column Text
text

  {-# INLINE autoColumn #-}

-- | @since 0.0.0
instance (AutoColumn a, AutoColumn b) => AutoColumn (Either a b) where
  autoColumn :: Column (Either a b)
autoColumn = (a -> Either a b) -> Column a -> Column (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left Column a
forall a. AutoColumn a => Column a
autoColumn Column (Either a b) -> Column (Either a b) -> Column (Either a b)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (b -> Either a b) -> Column b -> Column (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right Column b
forall a. AutoColumn a => Column a
autoColumn

  {-# INLINE autoColumn #-}

-- | Provides a 'AutoColumn' instance using the 'Read' for @a@
--
-- @since 0.0.0
newtype Readable a = Readable a

-- | @since 0.0.0
instance Read a => AutoColumn (Readable a) where
  autoColumn :: Column (Readable a)
autoColumn = Column a -> Column (Readable a)
coerce (Read a => Column a
forall a. Read a => Column a
readable @a)

  {-# INLINE autoColumn #-}

-- | The raw cell value
--
-- @since 0.0.0
data RawValue = RawValue
  { RawValue -> Oid
rawValue_type :: Oid
  , RawValue -> Format
rawValue_format :: Format
  , RawValue -> Value
rawValue_value :: Value
  }
  deriving stock (Int -> RawValue -> ShowS
[RawValue] -> ShowS
RawValue -> String
(Int -> RawValue -> ShowS)
-> (RawValue -> String) -> ([RawValue] -> ShowS) -> Show RawValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawValue] -> ShowS
$cshowList :: [RawValue] -> ShowS
show :: RawValue -> String
$cshow :: RawValue -> String
showsPrec :: Int -> RawValue -> ShowS
$cshowsPrec :: Int -> RawValue -> ShowS
Show, RawValue -> RawValue -> Bool
(RawValue -> RawValue -> Bool)
-> (RawValue -> RawValue -> Bool) -> Eq RawValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawValue -> RawValue -> Bool
$c/= :: RawValue -> RawValue -> Bool
== :: RawValue -> RawValue -> Bool
$c== :: RawValue -> RawValue -> Bool
Eq, Eq RawValue
Eq RawValue
-> (RawValue -> RawValue -> Ordering)
-> (RawValue -> RawValue -> Bool)
-> (RawValue -> RawValue -> Bool)
-> (RawValue -> RawValue -> Bool)
-> (RawValue -> RawValue -> Bool)
-> (RawValue -> RawValue -> RawValue)
-> (RawValue -> RawValue -> RawValue)
-> Ord RawValue
RawValue -> RawValue -> Bool
RawValue -> RawValue -> Ordering
RawValue -> RawValue -> RawValue
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 :: RawValue -> RawValue -> RawValue
$cmin :: RawValue -> RawValue -> RawValue
max :: RawValue -> RawValue -> RawValue
$cmax :: RawValue -> RawValue -> RawValue
>= :: RawValue -> RawValue -> Bool
$c>= :: RawValue -> RawValue -> Bool
> :: RawValue -> RawValue -> Bool
$c> :: RawValue -> RawValue -> Bool
<= :: RawValue -> RawValue -> Bool
$c<= :: RawValue -> RawValue -> Bool
< :: RawValue -> RawValue -> Bool
$c< :: RawValue -> RawValue -> Bool
compare :: RawValue -> RawValue -> Ordering
$ccompare :: RawValue -> RawValue -> Ordering
$cp1Ord :: Eq RawValue
Ord)

-- | @since 0.0.0
instance AutoColumn RawValue where
  autoColumn :: Column RawValue
autoColumn = (Oid -> Format -> Either ParserErrors (Cell RawValue))
-> Column RawValue
forall a.
(Oid -> Format -> Either ParserErrors (Cell a)) -> Column a
Column ((Oid -> Format -> Either ParserErrors (Cell RawValue))
 -> Column RawValue)
-> (Oid -> Format -> Either ParserErrors (Cell RawValue))
-> Column RawValue
forall a b. (a -> b) -> a -> b
$ \Oid
oid Format
format ->
    Cell RawValue -> Either ParserErrors (Cell RawValue)
forall a b. b -> Either a b
Right (Cell RawValue -> Either ParserErrors (Cell RawValue))
-> Cell RawValue -> Either ParserErrors (Cell RawValue)
forall a b. (a -> b) -> a -> b
$ (Value -> Either (NonEmpty Text) RawValue) -> Cell RawValue
forall a. (Value -> Either (NonEmpty Text) a) -> Cell a
Cell.Cell ((Value -> Either (NonEmpty Text) RawValue) -> Cell RawValue)
-> (Value -> Either (NonEmpty Text) RawValue) -> Cell RawValue
forall a b. (a -> b) -> a -> b
$ RawValue -> Either (NonEmpty Text) RawValue
forall a b. b -> Either a b
Right (RawValue -> Either (NonEmpty Text) RawValue)
-> (Value -> RawValue) -> Value -> Either (NonEmpty Text) RawValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Oid -> Format -> Value -> RawValue
RawValue Oid
oid Format
format

  {-# INLINE autoColumn #-}