{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasql.Interpolate.Internal.Encoder
  ( EncodeValue (..),
    EncodeField (..),
  )
where

import Data.ByteString (ByteString)
import Data.ByteString.Lazy (LazyByteString)
import Data.ByteString.Lazy qualified as ByteString.Lazy
import Data.Functor.Contravariant (contramap)
import Data.Int
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Time (Day, DiffTime, LocalTime, UTCTime)
import Data.UUID (UUID)
import Data.Vector (Vector)
import Hasql.Encoders

-- | This type class determines which encoder we will apply to a field
-- by its type.
--
-- ==== __Example__
--
-- @
--
-- data ThreatLevel = None | Midnight
--
-- instance EncodeValue ThreatLevel where
--   encodeValue = enum \\case
--     None     -> "none"
--     Midnight -> "midnight"
-- @
class EncodeValue a where
  encodeValue :: Value a

-- | Encode a list as a postgres array using 'foldableArray'
instance EncodeField a => EncodeValue [a] where
  encodeValue :: Value [a]
encodeValue = NullableOrNot Value a -> Value [a]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
foldableArray NullableOrNot Value a
forall a. EncodeField a => NullableOrNot Value a
encodeField

-- | Encode a 'Vector' as a postgres array using 'foldableArray'
instance EncodeField a => EncodeValue (Vector a) where
  encodeValue :: Value (Vector a)
encodeValue = NullableOrNot Value a -> Value (Vector a)
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
foldableArray NullableOrNot Value a
forall a. EncodeField a => NullableOrNot Value a
encodeField

-- | Encode a 'Bool' as a postgres @boolean@ using 'bool'
instance EncodeValue Bool where
  encodeValue :: Value Bool
encodeValue = Value Bool
bool

-- | Encode a 'Text' as a postgres @text@ using 'text'
instance EncodeValue Text where
  encodeValue :: Value Text
encodeValue = Value Text
text

-- | Encode a 'Int16' as a postgres @int2@ using 'int2'
instance EncodeValue Int16 where
  encodeValue :: Value Int16
encodeValue = Value Int16
int2

-- | Encode a 'Int32' as a postgres @int4@ using 'int4'
instance EncodeValue Int32 where
  encodeValue :: Value Int32
encodeValue = Value Int32
int4

-- | Encode a 'Int64' as a postgres @int8@ using 'int8'
instance EncodeValue Int64 where
  encodeValue :: Value Int64
encodeValue = Value Int64
int8

-- | Encode a 'Float' as a postgres @float4@ using 'float4'
instance EncodeValue Float where
  encodeValue :: Value Float
encodeValue = Value Float
float4

-- | Encode a 'Double' as a postgres @float8@ using 'float8'
instance EncodeValue Double where
  encodeValue :: Value Double
encodeValue = Value Double
float8

-- | Encode a 'Char' as a postgres @char@ using 'char'
instance EncodeValue Char where
  encodeValue :: Value Char
encodeValue = Value Char
char

-- | Encode a 'Day' as a postgres @date@ using 'date'
instance EncodeValue Day where
  encodeValue :: Value Day
encodeValue = Value Day
date

-- | Encode a 'LocalTime' as a postgres @timestamp@ using 'timestamp'
instance EncodeValue LocalTime where
  encodeValue :: Value LocalTime
encodeValue = Value LocalTime
timestamp

-- | Encode a 'UTCTime' as a postgres @timestamptz@ using 'timestamptz'
instance EncodeValue UTCTime where
  encodeValue :: Value UTCTime
encodeValue = Value UTCTime
timestamptz

-- | Encode a 'Scientific' as a postgres @numeric@ using 'numeric'
instance EncodeValue Scientific where
  encodeValue :: Value Scientific
encodeValue = Value Scientific
numeric

-- | Encode a 'DiffTime' as a postgres @interval@ using 'interval'
instance EncodeValue DiffTime where
  encodeValue :: Value DiffTime
encodeValue = Value DiffTime
interval

-- | Encode a 'UUID' as a postgres @uuid@ using 'uuid'
instance EncodeValue UUID where
  encodeValue :: Value UUID
encodeValue = Value UUID
uuid

-- | Encode a 'ByteString' as a postgres @bytea@ using 'bytea'
instance EncodeValue ByteString where
  encodeValue :: Value ByteString
encodeValue = Value ByteString
bytea

-- | Encode a 'LazyByteString' as a postgres @bytea@ using 'bytea'
instance EncodeValue LazyByteString where
  encodeValue :: Value LazyByteString
encodeValue = (LazyByteString -> ByteString)
-> Value ByteString -> Value LazyByteString
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap LazyByteString -> ByteString
ByteString.Lazy.toStrict Value ByteString
bytea

-- | You do not need to define instances for this class; The two
-- instances exported here cover all uses. The class only exists to
-- lift 'Value' to hasql's 'NullableOrNot' GADT.
class EncodeField a where
  encodeField :: NullableOrNot Value a

-- | Overlappable instance for all non-nullable types.
instance {-# OVERLAPPABLE #-} EncodeValue a => EncodeField a where
  encodeField :: NullableOrNot Value a
encodeField = Value a -> NullableOrNot Value a
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
nonNullable Value a
forall a. EncodeValue a => Value a
encodeValue

-- | Instance for all nullable types. 'Nothing' is encoded as @null@.
instance EncodeValue a => EncodeField (Maybe a) where
  encodeField :: NullableOrNot Value (Maybe a)
encodeField = Value a -> NullableOrNot Value (Maybe a)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
nullable Value a
forall a. EncodeValue a => Value a
encodeValue