{-# language GADTs #-}
{-# language NamedFieldPuns #-}
{-# language StandaloneKindSignatures #-}
{-# language StrictData #-}

module Rel8.Type.Information (
  TypeInformation(..),
  mapTypeInformation,
  parseTypeInformation,
) where

-- base
import Data.Functor.Contravariant ((>$<))
import Data.Kind (Type)
import Prelude

-- rel8
import Rel8.Type.Decoder (Decoder, parseDecoder)
import Rel8.Type.Encoder (Encoder)
import Rel8.Type.Name (TypeName)


-- | @TypeInformation@ describes how to encode and decode a Haskell type to and
-- from database queries. The @typeName@ is the name of the type in the
-- database, which is used to accurately type literals. 
type TypeInformation :: Type -> Type
data TypeInformation a = TypeInformation
  { forall a. TypeInformation a -> Encoder a
encode :: Encoder a
    -- ^ How to serialize a Haskell value to PostgreSQL.
  , forall a. TypeInformation a -> Decoder a
decode :: Decoder a
    -- ^ How to deserialize a PostgreSQL result back to Haskell.
  , forall a. TypeInformation a -> Char
delimiter :: Char
    -- ^ The delimiter that is used in PostgreSQL's text format in arrays of
    -- this type (this is almost always ',').
  , forall a. TypeInformation a -> TypeName
typeName :: TypeName
    -- ^ The name of the SQL type.
  }
 

-- | Simultaneously map over how a type is both encoded and decoded, while
-- retaining the name of the type. This operation is useful if you want to
-- essentially @newtype@ another 'Rel8.DBType'.
-- 
-- The mapping is required to be total. If you have a partial mapping, see
-- 'parseTypeInformation'.
mapTypeInformation :: ()
  => (a -> b) -> (b -> a)
  -> TypeInformation a -> TypeInformation b
mapTypeInformation :: forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation = (a -> Either String b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
forall a b.
(a -> Either String b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation ((a -> Either String b)
 -> (b -> a) -> TypeInformation a -> TypeInformation b)
-> ((a -> b) -> a -> Either String b)
-> (a -> b)
-> (b -> a)
-> TypeInformation a
-> TypeInformation b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either String b) -> (a -> b) -> a -> Either String b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either String b
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- | Apply a parser to 'TypeInformation'.
-- 
-- This can be used if the data stored in the database should only be subset of
-- a given 'TypeInformation'. The parser is applied when deserializing rows
-- returned - the encoder assumes that the input data is already in the
-- appropriate form.
parseTypeInformation :: ()
  => (a -> Either String b) -> (b -> a)
  -> TypeInformation a -> TypeInformation b
parseTypeInformation :: forall a b.
(a -> Either String b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation a -> Either String b
to b -> a
from TypeInformation {Encoder a
encode :: forall a. TypeInformation a -> Encoder a
encode :: Encoder a
encode, Decoder a
decode :: forall a. TypeInformation a -> Decoder a
decode :: Decoder a
decode, Char
delimiter :: forall a. TypeInformation a -> Char
delimiter :: Char
delimiter, TypeName
typeName :: forall a. TypeInformation a -> TypeName
typeName :: TypeName
typeName} =
  TypeInformation
    { decode :: Decoder b
decode = (a -> Either String b) -> Decoder a -> Decoder b
forall a b. (a -> Either String b) -> Decoder a -> Decoder b
parseDecoder a -> Either String b
to Decoder a
decode
    , encode :: Encoder b
encode = b -> a
from (b -> a) -> Encoder a -> Encoder b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encoder a
encode
    , Char
delimiter :: Char
delimiter :: Char
delimiter
    , TypeName
typeName :: TypeName
typeName :: TypeName
typeName
    }