Encoder.hs

{-# 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.IP (IPRange)
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 = foldableArray encodeField

-- | Encode a 'Vector' as a postgres array using 'foldableArray'
instance (EncodeField a) => EncodeValue (Vector a) where
  encodeValue = foldableArray encodeField

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Encode an 'IPRange' as a postgres @inet@ using 'inet'
instance EncodeValue IPRange where
  encodeValue = inet

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

-- | Encode a 'LazyByteString' as a postgres @bytea@ using 'bytea'
instance EncodeValue LazyByteString where
  encodeValue = contramap ByteString.Lazy.toStrict 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 = nonNullable encodeValue

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