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

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

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 = forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
foldableArray 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 = forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
foldableArray 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

-- | 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 = forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
nonNullable 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 = forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
nullable forall a. EncodeValue a => Value a
encodeValue