{-# language DerivingStrategies #-}
{-# language DeriveFunctor #-}
{-# language GADTs #-}
{-# language NamedFieldPuns #-}
{-# language StandaloneKindSignatures #-}

module Rel8.Type.Decoder (
  Decoder (..),
  NullableOrNot (..),
  Parser,
  parseDecoder,
) where

-- base
import Control.Monad ((>=>))
import Data.Bifunctor (first)
import Data.Kind (Type)
import Prelude

-- bytestring
import Data.ByteString (ByteString)

-- hasql
import qualified Hasql.Decoders as Hasql

-- text
import qualified Data.Text as Text


type Parser :: Type -> Type
type Parser a = ByteString -> Either String a


type Decoder :: Type -> Type
data Decoder a = Decoder
  { forall a. Decoder a -> Value a
binary :: Hasql.Value a
    -- ^ How to deserialize from PostgreSQL's binary format.
  , forall a. Decoder a -> Parser a
parser :: Parser a
    -- ^ How to deserialize from PostgreSQL's text format.
  , forall a. Decoder a -> Char
delimiter :: Char
    -- ^ The delimiter that is used in PostgreSQL's text format in arrays of
    -- this type (this is almost always ',').
  }
  deriving stock ((forall a b. (a -> b) -> Decoder a -> Decoder b)
-> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
forall a b. a -> Decoder b -> Decoder a
forall a b. (a -> b) -> Decoder a -> Decoder 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) -> Decoder a -> Decoder b
fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
$c<$ :: forall a b. a -> Decoder b -> Decoder a
<$ :: forall a b. a -> Decoder b -> Decoder a
Functor)


-- | Apply a parser to 'Decoder'.
--
-- This can be used if the data stored in the database should only be subset of
-- a given 'Decoder'. The parser is applied when deserializing rows
-- returned.
parseDecoder :: (a -> Either String b) -> Decoder a -> Decoder b
parseDecoder :: forall a b. (a -> Either String b) -> Decoder a -> Decoder b
parseDecoder a -> Either String b
f Decoder {Value a
binary :: forall a. Decoder a -> Value a
binary :: Value a
binary, Parser a
parser :: forall a. Decoder a -> Parser a
parser :: Parser a
parser, Char
delimiter :: forall a. Decoder a -> Char
delimiter :: Char
delimiter} =
  Decoder
    { binary :: Value b
binary = (a -> Either Text b) -> Value a -> Value b
forall a b. (a -> Either Text b) -> Value a -> Value b
Hasql.refine ((String -> Text) -> Either String b -> Either Text b
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 String -> Text
Text.pack (Either String b -> Either Text b)
-> (a -> Either String b) -> a -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
f) Value a
binary
    , parser :: Parser b
parser = Parser a
parser Parser a -> (a -> Either String b) -> Parser b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Either String b
f
    , Char
delimiter :: Char
delimiter :: Char
delimiter
    }


type NullableOrNot :: (Type -> Type) -> Type -> Type
data NullableOrNot decoder a where
  NonNullable :: decoder a -> NullableOrNot decoder a
  Nullable :: decoder a -> NullableOrNot decoder (Maybe a)