{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module: IHP.Hasql.Encoders
Description: DefaultParamEncoder instances for common types
Copyright: (c) digitally induced GmbH, 2025

This module provides orphan 'DefaultParamEncoder' instances for types that
hasql-implicits doesn't support out of the box, most importantly 'Int'.

These instances are needed because hasql-implicits only provides instances for
fixed-width integer types ('Int16', 'Int32', 'Int64'), not Haskell's
platform-dependent 'Int'. Since most IHP applications use 'Int' for
integer columns, we provide these instances to make the transition seamless.
-}
module IHP.Hasql.Encoders
( ToSnippetParams(..)
, sqlToSnippet
) where

import Prelude
import Data.Int (Int64)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Hasql.Encoders as Encoders
import Hasql.Implicits.Encoders (DefaultParamEncoder(..))
import qualified Hasql.DynamicStatements.Snippet as Snippet
import Hasql.DynamicStatements.Snippet (Snippet)
import Database.PostgreSQL.Simple (Only(..), (:.)(..))
import Data.Functor.Contravariant (contramap)
import Data.Functor.Contravariant.Divisible (divide)
import Data.Vector (Vector)
import IHP.ModelSupport.Types (Id'(..), PrimaryKey)
import Data.UUID (UUID)
import Database.PostgreSQL.Simple.Types (Binary(..))
import qualified Hasql.Mapping.IsScalar as Mapping
import Hasql.PostgresqlTypes ()
import PostgresqlTypes.Point (Point)
import PostgresqlTypes.Polygon (Polygon)
import PostgresqlTypes.Inet (Inet)
import PostgresqlTypes.Interval (Interval)
import PostgresqlTypes.Tsvector (Tsvector)

-- | Encode 'Int' as PostgreSQL int8 (bigint)
--
-- This treats Haskell's 'Int' as 'Int64', which is safe on 64-bit platforms
-- (where 'Int' is 64 bits) and may truncate on 32-bit platforms (where 'Int'
-- is 32 bits but int8 can hold the full range).
instance DefaultParamEncoder Int where
    defaultParam :: NullableOrNot Value Int
defaultParam = Value Int -> NullableOrNot Value Int
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Int -> Int64) -> Value Int64 -> Value Int
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64) Value Int64
Encoders.int8)

-- | Encode '[Int]' as PostgreSQL int8[] (bigint array)
instance DefaultParamEncoder [Int] where
    defaultParam :: NullableOrNot Value [Int]
defaultParam = Value [Int] -> NullableOrNot Value [Int]
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value [Int] -> NullableOrNot Value [Int])
-> Value [Int] -> NullableOrNot Value [Int]
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value Int -> Value [Int]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value Int -> Value [Int])
-> NullableOrNot Value Int -> Value [Int]
forall a b. (a -> b) -> a -> b
$ Value Int -> NullableOrNot Value Int
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Int -> Int64) -> Value Int64 -> Value Int
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64) Value Int64
Encoders.int8)

-- | Encode 'Maybe Int' as nullable PostgreSQL int8
instance DefaultParamEncoder (Maybe Int) where
    defaultParam :: NullableOrNot Value (Maybe Int)
defaultParam = Value Int -> NullableOrNot Value (Maybe Int)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable ((Int -> Int64) -> Value Int64 -> Value Int
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64) Value Int64
Encoders.int8)

-- | Encode '[Maybe Int]' as PostgreSQL int8[] with nullable elements
instance DefaultParamEncoder [Maybe Int] where
    defaultParam :: NullableOrNot Value [Maybe Int]
defaultParam = Value [Maybe Int] -> NullableOrNot Value [Maybe Int]
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value [Maybe Int] -> NullableOrNot Value [Maybe Int])
-> Value [Maybe Int] -> NullableOrNot Value [Maybe Int]
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value (Maybe Int) -> Value [Maybe Int]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value (Maybe Int) -> Value [Maybe Int])
-> NullableOrNot Value (Maybe Int) -> Value [Maybe Int]
forall a b. (a -> b) -> a -> b
$ Value Int -> NullableOrNot Value (Maybe Int)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable ((Int -> Int64) -> Value Int64 -> Value Int
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64) Value Int64
Encoders.int8)

-- | Encode 'Vector Int' as PostgreSQL int8[] (bigint array)
instance DefaultParamEncoder (Vector Int) where
    defaultParam :: NullableOrNot Value (Vector Int)
defaultParam = Value (Vector Int) -> NullableOrNot Value (Vector Int)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value (Vector Int) -> NullableOrNot Value (Vector Int))
-> Value (Vector Int) -> NullableOrNot Value (Vector Int)
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value Int -> Value (Vector Int)
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value Int -> Value (Vector Int))
-> NullableOrNot Value Int -> Value (Vector Int)
forall a b. (a -> b) -> a -> b
$ Value Int -> NullableOrNot Value Int
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Int -> Int64) -> Value Int64 -> Value Int
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64) Value Int64
Encoders.int8)

-- | Encode 'Id' table' for tables with UUID primary keys
-- This covers the common case in IHP where most tables use UUID as the primary key.
instance PrimaryKey table ~ UUID => DefaultParamEncoder (Id' table) where
    defaultParam :: NullableOrNot Value (Id' table)
defaultParam = Value (Id' table) -> NullableOrNot Value (Id' table)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Id' table -> UUID) -> Value UUID -> Value (Id' table)
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Id PrimaryKey table
uuid) -> UUID
PrimaryKey table
uuid) Value UUID
Encoders.uuid)

-- | Encode list of 'Id' table' for tables with UUID primary keys
-- Used by filterWhereIdIn for simple primary keys
instance PrimaryKey table ~ UUID => DefaultParamEncoder [Id' table] where
    defaultParam :: NullableOrNot Value [Id' table]
defaultParam = Value [Id' table] -> NullableOrNot Value [Id' table]
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value [Id' table] -> NullableOrNot Value [Id' table])
-> Value [Id' table] -> NullableOrNot Value [Id' table]
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value (Id' table) -> Value [Id' table]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value (Id' table) -> Value [Id' table])
-> NullableOrNot Value (Id' table) -> Value [Id' table]
forall a b. (a -> b) -> a -> b
$ Value (Id' table) -> NullableOrNot Value (Id' table)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Id' table -> UUID) -> Value UUID -> Value (Id' table)
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Id PrimaryKey table
uuid) -> UUID
PrimaryKey table
uuid) Value UUID
Encoders.uuid)

-- | Encode 'Maybe (Id' table)' for nullable foreign keys
instance PrimaryKey table ~ UUID => DefaultParamEncoder (Maybe (Id' table)) where
    defaultParam :: NullableOrNot Value (Maybe (Id' table))
defaultParam = Value (Id' table) -> NullableOrNot Value (Maybe (Id' table))
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable ((Id' table -> UUID) -> Value UUID -> Value (Id' table)
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Id PrimaryKey table
uuid) -> UUID
PrimaryKey table
uuid) Value UUID
Encoders.uuid)

-- | Encode '[Maybe (Id' table)]' for filterWhereIn with nullable foreign keys
instance PrimaryKey table ~ UUID => DefaultParamEncoder [Maybe (Id' table)] where
    defaultParam :: NullableOrNot Value [Maybe (Id' table)]
defaultParam = Value [Maybe (Id' table)]
-> NullableOrNot Value [Maybe (Id' table)]
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value [Maybe (Id' table)]
 -> NullableOrNot Value [Maybe (Id' table)])
-> Value [Maybe (Id' table)]
-> NullableOrNot Value [Maybe (Id' table)]
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value (Maybe (Id' table))
-> Value [Maybe (Id' table)]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value (Maybe (Id' table))
 -> Value [Maybe (Id' table)])
-> NullableOrNot Value (Maybe (Id' table))
-> Value [Maybe (Id' table)]
forall a b. (a -> b) -> a -> b
$ Value (Id' table) -> NullableOrNot Value (Maybe (Id' table))
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable ((Id' table -> UUID) -> Value UUID -> Value (Id' table)
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Id PrimaryKey table
uuid) -> UUID
PrimaryKey table
uuid) Value UUID
Encoders.uuid)

-- | Encode '(UUID, UUID)' as PostgreSQL composite/record type
-- Used for composite primary keys with two UUID columns
instance DefaultParamEncoder (UUID, UUID) where
    defaultParam :: NullableOrNot Value (UUID, UUID)
defaultParam = Value (UUID, UUID) -> NullableOrNot Value (UUID, UUID)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value (UUID, UUID) -> NullableOrNot Value (UUID, UUID))
-> Value (UUID, UUID) -> NullableOrNot Value (UUID, UUID)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Composite (UUID, UUID) -> Value (UUID, UUID)
forall a. Maybe Text -> Text -> Composite a -> Value a
Encoders.composite (Maybe Text
forall a. Maybe a
Nothing :: Maybe Text) Text
"" Composite (UUID, UUID)
uuidPairComposite

-- | Encode '[(UUID, UUID)]' as PostgreSQL array of composite types
-- Used by filterWhereIdIn for tables with composite primary keys of two UUIDs
instance DefaultParamEncoder [(UUID, UUID)] where
    defaultParam :: NullableOrNot Value [(UUID, UUID)]
defaultParam = Value [(UUID, UUID)] -> NullableOrNot Value [(UUID, UUID)]
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value [(UUID, UUID)] -> NullableOrNot Value [(UUID, UUID)])
-> Value [(UUID, UUID)] -> NullableOrNot Value [(UUID, UUID)]
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value (UUID, UUID) -> Value [(UUID, UUID)]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value (UUID, UUID) -> Value [(UUID, UUID)])
-> NullableOrNot Value (UUID, UUID) -> Value [(UUID, UUID)]
forall a b. (a -> b) -> a -> b
$ Value (UUID, UUID) -> NullableOrNot Value (UUID, UUID)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value (UUID, UUID) -> NullableOrNot Value (UUID, UUID))
-> Value (UUID, UUID) -> NullableOrNot Value (UUID, UUID)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Composite (UUID, UUID) -> Value (UUID, UUID)
forall a. Maybe Text -> Text -> Composite a -> Value a
Encoders.composite (Maybe Text
forall a. Maybe a
Nothing :: Maybe Text) Text
"" Composite (UUID, UUID)
uuidPairComposite

-- | Encode '(Id' a, Id' b)' as PostgreSQL composite/record type
-- Used for composite primary keys with two Id columns (where both resolve to UUID)
instance (PrimaryKey a ~ UUID, PrimaryKey b ~ UUID) => DefaultParamEncoder (Id' a, Id' b) where
    defaultParam :: NullableOrNot Value (Id' a, Id' b)
defaultParam = Value (Id' a, Id' b) -> NullableOrNot Value (Id' a, Id' b)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value (Id' a, Id' b) -> NullableOrNot Value (Id' a, Id' b))
-> Value (Id' a, Id' b) -> NullableOrNot Value (Id' a, Id' b)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Composite (Id' a, Id' b) -> Value (Id' a, Id' b)
forall a. Maybe Text -> Text -> Composite a -> Value a
Encoders.composite (Maybe Text
forall a. Maybe a
Nothing :: Maybe Text) Text
"" (Composite (Id' a, Id' b) -> Value (Id' a, Id' b))
-> Composite (Id' a, Id' b) -> Value (Id' a, Id' b)
forall a b. (a -> b) -> a -> b
$
        ((Id' a, Id' b) -> (UUID, UUID))
-> Composite (UUID, UUID) -> Composite (Id' a, Id' b)
forall a' a. (a' -> a) -> Composite a -> Composite a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Id PrimaryKey a
a, Id PrimaryKey b
b) -> (UUID
PrimaryKey a
a, UUID
PrimaryKey b
b)) Composite (UUID, UUID)
uuidPairComposite

-- | Encode '[(Id' a, Id' b)]' as PostgreSQL array of composite types
-- Used by filterWhereIdIn for tables with composite primary keys of two Id columns
instance (PrimaryKey a ~ UUID, PrimaryKey b ~ UUID) => DefaultParamEncoder [(Id' a, Id' b)] where
    defaultParam :: NullableOrNot Value [(Id' a, Id' b)]
defaultParam = Value [(Id' a, Id' b)] -> NullableOrNot Value [(Id' a, Id' b)]
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value [(Id' a, Id' b)] -> NullableOrNot Value [(Id' a, Id' b)])
-> Value [(Id' a, Id' b)] -> NullableOrNot Value [(Id' a, Id' b)]
forall a b. (a -> b) -> a -> b
$ NullableOrNot Value (Id' a, Id' b) -> Value [(Id' a, Id' b)]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (NullableOrNot Value (Id' a, Id' b) -> Value [(Id' a, Id' b)])
-> NullableOrNot Value (Id' a, Id' b) -> Value [(Id' a, Id' b)]
forall a b. (a -> b) -> a -> b
$ Value (Id' a, Id' b) -> NullableOrNot Value (Id' a, Id' b)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (Value (Id' a, Id' b) -> NullableOrNot Value (Id' a, Id' b))
-> Value (Id' a, Id' b) -> NullableOrNot Value (Id' a, Id' b)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Composite (Id' a, Id' b) -> Value (Id' a, Id' b)
forall a. Maybe Text -> Text -> Composite a -> Value a
Encoders.composite (Maybe Text
forall a. Maybe a
Nothing :: Maybe Text) Text
"" (Composite (Id' a, Id' b) -> Value (Id' a, Id' b))
-> Composite (Id' a, Id' b) -> Value (Id' a, Id' b)
forall a b. (a -> b) -> a -> b
$
        ((Id' a, Id' b) -> (UUID, UUID))
-> Composite (UUID, UUID) -> Composite (Id' a, Id' b)
forall a' a. (a' -> a) -> Composite a -> Composite a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Id PrimaryKey a
a, Id PrimaryKey b
b) -> (UUID
PrimaryKey a
a, UUID
PrimaryKey b
b)) Composite (UUID, UUID)
uuidPairComposite

-- | Helper: composite encoder for a pair of UUIDs
uuidPairComposite :: Encoders.Composite (UUID, UUID)
uuidPairComposite :: Composite (UUID, UUID)
uuidPairComposite = ((UUID, UUID) -> (UUID, UUID))
-> Composite UUID -> Composite UUID -> Composite (UUID, UUID)
forall a b c.
(a -> (b, c)) -> Composite b -> Composite c -> Composite a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (UUID, UUID) -> (UUID, UUID)
forall a. a -> a
id (NullableOrNot Value UUID -> Composite UUID
forall a. NullableOrNot Value a -> Composite a
Encoders.field (Value UUID -> NullableOrNot Value UUID
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value UUID
Encoders.uuid)) (NullableOrNot Value UUID -> Composite UUID
forall a. NullableOrNot Value a -> Composite a
Encoders.field (Value UUID -> NullableOrNot Value UUID
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value UUID
Encoders.uuid))

-- | Encode 'Binary ByteString' as PostgreSQL bytea
-- IHP wraps bytea columns in Binary, so we need to unwrap before encoding
instance DefaultParamEncoder (Binary ByteString) where
    defaultParam :: NullableOrNot Value (Binary ByteString)
defaultParam = Value (Binary ByteString)
-> NullableOrNot Value (Binary ByteString)
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Binary ByteString -> ByteString)
-> Value ByteString -> Value (Binary ByteString)
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Binary ByteString
bs) -> ByteString
bs) Value ByteString
Encoders.bytea)

-- | Encode 'Maybe (Binary ByteString)' as nullable PostgreSQL bytea
instance DefaultParamEncoder (Maybe (Binary ByteString)) where
    defaultParam :: NullableOrNot Value (Maybe (Binary ByteString))
defaultParam = Value (Binary ByteString)
-> NullableOrNot Value (Maybe (Binary ByteString))
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable ((Binary ByteString -> ByteString)
-> Value ByteString -> Value (Binary ByteString)
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(Binary ByteString
bs) -> ByteString
bs) Value ByteString
Encoders.bytea)

-- | Encode 'Integer' as PostgreSQL int8 (bigint)
-- Used for BigInt and BigSerial columns
instance DefaultParamEncoder Integer where
    defaultParam :: NullableOrNot Value Integer
defaultParam = Value Integer -> NullableOrNot Value Integer
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable ((Integer -> Int64) -> Value Int64 -> Value Integer
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Value Int64
Encoders.int8)

-- | Encode 'Maybe Integer' as nullable PostgreSQL int8
instance DefaultParamEncoder (Maybe Integer) where
    defaultParam :: NullableOrNot Value (Maybe Integer)
defaultParam = Value Integer -> NullableOrNot Value (Maybe Integer)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable ((Integer -> Int64) -> Value Int64 -> Value Integer
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Value Int64
Encoders.int8)

-- | Encode 'Point' as PostgreSQL point via postgresql-types binary encoder
instance DefaultParamEncoder Point where
    defaultParam :: NullableOrNot Value Point
defaultParam = Value Point -> NullableOrNot Value Point
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value Point
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Maybe Point' as nullable PostgreSQL point
instance DefaultParamEncoder (Maybe Point) where
    defaultParam :: NullableOrNot Value (Maybe Point)
defaultParam = Value Point -> NullableOrNot Value (Maybe Point)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable Value Point
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Polygon' as PostgreSQL polygon via postgresql-types binary encoder
instance DefaultParamEncoder Polygon where
    defaultParam :: NullableOrNot Value Polygon
defaultParam = Value Polygon -> NullableOrNot Value Polygon
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value Polygon
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Maybe Polygon' as nullable PostgreSQL polygon
instance DefaultParamEncoder (Maybe Polygon) where
    defaultParam :: NullableOrNot Value (Maybe Polygon)
defaultParam = Value Polygon -> NullableOrNot Value (Maybe Polygon)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable Value Polygon
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Interval' as PostgreSQL interval via postgresql-types binary encoder
instance DefaultParamEncoder Interval where
    defaultParam :: NullableOrNot Value Interval
defaultParam = Value Interval -> NullableOrNot Value Interval
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value Interval
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Maybe Interval' as nullable PostgreSQL interval
instance DefaultParamEncoder (Maybe Interval) where
    defaultParam :: NullableOrNot Value (Maybe Interval)
defaultParam = Value Interval -> NullableOrNot Value (Maybe Interval)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable Value Interval
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Tsvector' as PostgreSQL tsvector via postgresql-types binary encoder
instance DefaultParamEncoder Tsvector where
    defaultParam :: NullableOrNot Value Tsvector
defaultParam = Value Tsvector -> NullableOrNot Value Tsvector
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value Tsvector
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Maybe Tsvector' as nullable PostgreSQL tsvector
instance DefaultParamEncoder (Maybe Tsvector) where
    defaultParam :: NullableOrNot Value (Maybe Tsvector)
defaultParam = Value Tsvector -> NullableOrNot Value (Maybe Tsvector)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable Value Tsvector
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Inet' as PostgreSQL inet via postgresql-types binary encoder
instance DefaultParamEncoder Inet where
    defaultParam :: NullableOrNot Value Inet
defaultParam = Value Inet -> NullableOrNot Value Inet
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable Value Inet
forall a. IsScalar a => Value a
Mapping.encoder

-- | Encode 'Maybe Inet' as nullable PostgreSQL inet
instance DefaultParamEncoder (Maybe Inet) where
    defaultParam :: NullableOrNot Value (Maybe Inet)
defaultParam = Value Inet -> NullableOrNot Value (Maybe Inet)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable Value Inet
forall a. IsScalar a => Value a
Mapping.encoder

-- | Converts parameter tuples into a list of hasql 'Snippet' values.
--
-- This mirrors postgresql-simple's 'ToRow' typeclass, allowing @sqlQuery@ and @sqlExec@
-- to use hasql's native parameterized queries instead of 'PG.formatQuery'.
class ToSnippetParams a where
    toSnippetParams :: a -> [Snippet]

instance ToSnippetParams () where
    toSnippetParams :: () -> [Snippet]
toSnippetParams () = []

instance DefaultParamEncoder a => ToSnippetParams (Only a) where
    toSnippetParams :: Only a -> [Snippet]
toSnippetParams (Only a
a) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a]

instance (DefaultParamEncoder a, DefaultParamEncoder b) => ToSnippetParams (a, b) where
    toSnippetParams :: (a, b) -> [Snippet]
toSnippetParams (a
a, b
b) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c) => ToSnippetParams (a, b, c) where
    toSnippetParams :: (a, b, c) -> [Snippet]
toSnippetParams (a
a, b
b, c
c) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d) => ToSnippetParams (a, b, c, d) where
    toSnippetParams :: (a, b, c, d) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d, DefaultParamEncoder e) => ToSnippetParams (a, b, c, d, e) where
    toSnippetParams :: (a, b, c, d, e) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d, e
e) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d, e -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param e
e]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d, DefaultParamEncoder e, DefaultParamEncoder f) => ToSnippetParams (a, b, c, d, e, f) where
    toSnippetParams :: (a, b, c, d, e, f) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d, e
e, f
f) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d, e -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param e
e, f -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param f
f]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d, DefaultParamEncoder e, DefaultParamEncoder f, DefaultParamEncoder g) => ToSnippetParams (a, b, c, d, e, f, g) where
    toSnippetParams :: (a, b, c, d, e, f, g) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d, e -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param e
e, f -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param f
f, g -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param g
g]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d, DefaultParamEncoder e, DefaultParamEncoder f, DefaultParamEncoder g, DefaultParamEncoder h) => ToSnippetParams (a, b, c, d, e, f, g, h) where
    toSnippetParams :: (a, b, c, d, e, f, g, h) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d, e -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param e
e, f -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param f
f, g -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param g
g, h -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param h
h]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d, DefaultParamEncoder e, DefaultParamEncoder f, DefaultParamEncoder g, DefaultParamEncoder h, DefaultParamEncoder i) => ToSnippetParams (a, b, c, d, e, f, g, h, i) where
    toSnippetParams :: (a, b, c, d, e, f, g, h, i) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d, e -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param e
e, f -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param f
f, g -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param g
g, h -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param h
h, i -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param i
i]

instance (DefaultParamEncoder a, DefaultParamEncoder b, DefaultParamEncoder c, DefaultParamEncoder d, DefaultParamEncoder e, DefaultParamEncoder f, DefaultParamEncoder g, DefaultParamEncoder h, DefaultParamEncoder i, DefaultParamEncoder j) => ToSnippetParams (a, b, c, d, e, f, g, h, i, j) where
    toSnippetParams :: (a, b, c, d, e, f, g, h, i, j) -> [Snippet]
toSnippetParams (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = [a -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param a
a, b -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param b
b, c -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param c
c, d -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param d
d, e -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param e
e, f -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param f
f, g -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param g
g, h -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param h
h, i -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param i
i, j -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param j
j]

-- | Append two parameter lists (mirrors postgresql-simple's ':.' operator)
instance (ToSnippetParams a, ToSnippetParams b) => ToSnippetParams (a :. b) where
    toSnippetParams :: (a :. b) -> [Snippet]
toSnippetParams (a
a :. b
b) = a -> [Snippet]
forall a. ToSnippetParams a => a -> [Snippet]
toSnippetParams a
a [Snippet] -> [Snippet] -> [Snippet]
forall a. Semigroup a => a -> a -> a
<> b -> [Snippet]
forall a. ToSnippetParams a => a -> [Snippet]
toSnippetParams b
b

-- | Converts a SQL query with @?@ placeholders and a list of 'Snippet' parameters
-- into a single 'Snippet' with native hasql @$1, $2, ...@ parameterization.
--
-- This mirrors postgresql-simple's @?@ placeholder convention.
--
-- __Example:__
--
-- > sqlToSnippet "SELECT * FROM users WHERE id = ? AND name = ?" [Snippet.param id, Snippet.param name]
-- > -- becomes: Snippet.sql "SELECT * FROM users WHERE id = " <> Snippet.param id <> Snippet.sql " AND name = " <> Snippet.param name
--
sqlToSnippet :: ByteString -> [Snippet] -> Snippet
sqlToSnippet :: ByteString -> [Snippet] -> Snippet
sqlToSnippet ByteString
sql [Snippet]
params = [Snippet] -> Snippet
forall a. Monoid a => [a] -> a
mconcat ([Snippet] -> [Snippet] -> [Snippet]
forall {a}. [a] -> [a] -> [a]
interleave [Snippet]
sqlParts [Snippet]
params)
  where
    sqlParts :: [Snippet]
sqlParts = (ByteString -> Snippet) -> [ByteString] -> [Snippet]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Snippet
Snippet.sql (Text -> Snippet) -> (ByteString -> Text) -> ByteString -> Snippet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8) (Char -> ByteString -> [ByteString]
BS8.split Char
'?' ByteString
sql)
    interleave :: [a] -> [a] -> [a]
interleave (a
s:[a]
ss) (a
p:[a]
ps) = a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
interleave [a]
ss [a]
ps
    interleave [a]
ss [] = [a]
ss
    interleave [] [a]
_ = []
{-# INLINE sqlToSnippet #-}