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

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

-- base
import Data.Bifunctor ( first )
import Data.Kind ( Type )
import Prelude

-- hasql
import qualified Hasql.Decoders as Hasql

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- text
import qualified Data.Text as Text


-- | @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 -> a -> PrimExpr
encode :: a -> Opaleye.PrimExpr
    -- ^ How to encode a single Haskell value as a SQL expression.
  , forall a. TypeInformation a -> Value a
decode :: Hasql.Value a
    -- ^ How to deserialize a single result back to Haskell.
  , forall a. TypeInformation a -> String
typeName :: String
    -- ^ 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 = forall a b.
(a -> Either String b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 {a -> PrimExpr
encode :: a -> PrimExpr
encode :: forall a. TypeInformation a -> a -> PrimExpr
encode, Value a
decode :: Value a
decode :: forall a. TypeInformation a -> Value a
decode, String
typeName :: String
typeName :: forall a. TypeInformation a -> String
typeName} =
  TypeInformation
    { encode :: b -> PrimExpr
encode = a -> PrimExpr
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
from
    , decode :: Value b
decode = forall a b. (a -> Either Text b) -> Value a -> Value b
Hasql.refine (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
to) Value a
decode
    , String
typeName :: String
typeName :: String
typeName
    }