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