{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module: IHP.Hasql.FromRow
Description: Typeclass for decoding hasql result rows
Copyright: (c) digitally induced GmbH, 2025

This module provides 'FromRowHasql', a typeclass parallel to postgresql-simple's 'FromRow',
for decoding database rows using hasql's more efficient prepared statement approach.

Instances are generated by the SchemaCompiler with explicit inline decoders in idiomatic
hasql applicative style.

Also provides parser functions used by the generated decoders for custom PostgreSQL types.
-}
module IHP.Hasql.FromRow
( FromRowHasql (..)
, HasqlDecodeColumn (..)
) where

import Prelude
import qualified Hasql.Decoders as Decoders
import qualified Hasql.Encoders as Encoders
import qualified Hasql.Mapping.IsScalar as Mapping
import qualified Database.PostgreSQL.Simple.Types as PG
import Data.Functor.Contravariant (contramap)
import IHP.ModelSupport.Types (Id'(..), PrimaryKey)

-- | Typeclass for types that can be decoded from a hasql result row
--
-- This is the hasql equivalent of postgresql-simple's 'FromRow' class.
-- The SchemaCompiler generates instances for all model types using idiomatic
-- hasql applicative style with explicit inline decoders.
class FromRowHasql a where
    -- | Decoder for a single row
    hasqlRowDecoder :: Decoders.Row a

-- | Typeclass for building column-level row decoders, handling nullable/non-nullable.
-- Uses 'Mapping.IsScalar' from hasql-mapping for value-level decoding.
class HasqlDecodeColumn a where
    hasqlColumnDecoder :: Decoders.Row a

instance {-# OVERLAPPABLE #-} Mapping.IsScalar a => HasqlDecodeColumn a where
    hasqlColumnDecoder :: Row a
hasqlColumnDecoder = NullableOrNot Value a -> Row a
forall a. NullableOrNot Value a -> Row a
Decoders.column (Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Decoders.nonNullable Value a
forall a. IsScalar a => Value a
Mapping.decoder)

instance {-# OVERLAPPING #-} Mapping.IsScalar a => HasqlDecodeColumn (Maybe a) where
    hasqlColumnDecoder :: Row (Maybe a)
hasqlColumnDecoder = NullableOrNot Value (Maybe a) -> Row (Maybe a)
forall a. NullableOrNot Value a -> Row a
Decoders.column (Value a -> NullableOrNot Value (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Decoders.nullable Value a
forall a. IsScalar a => Value a
Mapping.decoder)

-- | IHP's schema maps SQL @INT@ (int4) to Haskell 'Int', but hasql-mapping's
-- @IsScalar Int@ instance uses @int8@ (bigint). Override to match IHP conventions.
instance {-# OVERLAPPING #-} HasqlDecodeColumn Int where
    hasqlColumnDecoder :: Row Int
hasqlColumnDecoder = NullableOrNot Value Int -> Row Int
forall a. NullableOrNot Value a -> Row a
Decoders.column (Value Int -> NullableOrNot Value Int
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Decoders.nonNullable (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Value Int32 -> Value Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Int32
Decoders.int4))

instance {-# OVERLAPPING #-} HasqlDecodeColumn (Maybe Int) where
    hasqlColumnDecoder :: Row (Maybe Int)
hasqlColumnDecoder = NullableOrNot Value (Maybe Int) -> Row (Maybe Int)
forall a. NullableOrNot Value a -> Row a
Decoders.column (Value Int -> NullableOrNot Value (Maybe Int)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Decoders.nullable (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Value Int32 -> Value Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Int32
Decoders.int4))

-- | IHP's schema maps SQL @BIGINT@/@BIGSERIAL@ to Haskell 'Integer' (see @atomicType@
-- in @SchemaCompiler@). @hasql-mapping@ ships no 'IsScalar Integer' instance, so
-- @BIGSERIAL@ primary keys (and foreign keys referencing them) fail to typecheck
-- in generated 'RowDecoder' modules with @No instance for Mapping.IsScalar Integer@.
-- Provide one backed by the @int8@ codec, mirroring the 'DefaultParamEncoder Integer'
-- instance in "IHP.Hasql.Encoders".
instance Mapping.IsScalar Integer where
    encoder :: Value Integer
encoder = (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
    decoder :: Value Integer
decoder = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Value Int64 -> Value Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Int64
Decoders.int8

-- | 'IsScalar' instance for 'Id'' so that Id columns can use 'Mapping.encoder' and 'Mapping.decoder'
-- directly in generated code, without manual wrapping/unwrapping.
instance Mapping.IsScalar (PrimaryKey table) => Mapping.IsScalar (Id' table) where
    encoder :: Value (Id' table)
encoder = (Id' table -> PrimaryKey table)
-> Value (PrimaryKey table) -> 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
pk) -> PrimaryKey table
pk) Value (PrimaryKey table)
forall a. IsScalar a => Value a
Mapping.encoder
    decoder :: Value (Id' table)
decoder = PrimaryKey table -> Id' table
forall (table :: Symbol). PrimaryKey table -> Id' table
Id (PrimaryKey table -> Id' table)
-> Value (PrimaryKey table) -> Value (Id' table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (PrimaryKey table)
forall a. IsScalar a => Value a
Mapping.decoder

-- | Decode 'Id' table' by decoding the primary key type and wrapping with 'Id'
instance {-# OVERLAPPING #-} Mapping.IsScalar (PrimaryKey table) => HasqlDecodeColumn (Id' table) where
    hasqlColumnDecoder :: Row (Id' table)
hasqlColumnDecoder = NullableOrNot Value (Id' table) -> Row (Id' table)
forall a. NullableOrNot Value a -> Row a
Decoders.column (Value (Id' table) -> NullableOrNot Value (Id' table)
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Decoders.nonNullable Value (Id' table)
forall a. IsScalar a => Value a
Mapping.decoder)

-- | Decode 'Maybe (Id' table)' for nullable foreign keys
instance {-# OVERLAPPING #-} Mapping.IsScalar (PrimaryKey table) => HasqlDecodeColumn (Maybe (Id' table)) where
    hasqlColumnDecoder :: Row (Maybe (Id' table))
hasqlColumnDecoder = NullableOrNot Value (Maybe (Id' table)) -> Row (Maybe (Id' table))
forall a. NullableOrNot Value a -> Row a
Decoders.column (Value (Id' table) -> NullableOrNot Value (Maybe (Id' table))
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Decoders.nullable Value (Id' table)
forall a. IsScalar a => Value a
Mapping.decoder)

-- FromRowHasql instances for PG.Only and tuples (used by sqlQuery callers like fetchCount, fetchExists)

instance HasqlDecodeColumn a => FromRowHasql (PG.Only a) where
    hasqlRowDecoder :: Row (Only a)
hasqlRowDecoder = a -> Only a
forall a. a -> Only a
PG.Only (a -> Only a) -> Row a -> Row (Only a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder

instance (HasqlDecodeColumn a, HasqlDecodeColumn b) => FromRowHasql (a, b) where
    hasqlRowDecoder :: Row (a, b)
hasqlRowDecoder = (,) (a -> b -> (a, b)) -> Row a -> Row (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (b -> (a, b)) -> Row b -> Row (a, b)
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row b
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder

instance (HasqlDecodeColumn a, HasqlDecodeColumn b, HasqlDecodeColumn c) => FromRowHasql (a, b, c) where
    hasqlRowDecoder :: Row (a, b, c)
hasqlRowDecoder = (,,) (a -> b -> c -> (a, b, c)) -> Row a -> Row (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (b -> c -> (a, b, c)) -> Row b -> Row (c -> (a, b, c))
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row b
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (c -> (a, b, c)) -> Row c -> Row (a, b, c)
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row c
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder

instance (HasqlDecodeColumn a, HasqlDecodeColumn b, HasqlDecodeColumn c, HasqlDecodeColumn d) => FromRowHasql (a, b, c, d) where
    hasqlRowDecoder :: Row (a, b, c, d)
hasqlRowDecoder = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Row a -> Row (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (b -> c -> d -> (a, b, c, d))
-> Row b -> Row (c -> d -> (a, b, c, d))
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row b
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (c -> d -> (a, b, c, d)) -> Row c -> Row (d -> (a, b, c, d))
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row c
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (d -> (a, b, c, d)) -> Row d -> Row (a, b, c, d)
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row d
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder

instance (HasqlDecodeColumn a, HasqlDecodeColumn b, HasqlDecodeColumn c, HasqlDecodeColumn d, HasqlDecodeColumn e) => FromRowHasql (a, b, c, d, e) where
    hasqlRowDecoder :: Row (a, b, c, d, e)
hasqlRowDecoder = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Row a -> Row (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (b -> c -> d -> e -> (a, b, c, d, e))
-> Row b -> Row (c -> d -> e -> (a, b, c, d, e))
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row b
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (c -> d -> e -> (a, b, c, d, e))
-> Row c -> Row (d -> e -> (a, b, c, d, e))
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row c
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (d -> e -> (a, b, c, d, e))
-> Row d -> Row (e -> (a, b, c, d, e))
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row d
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder Row (e -> (a, b, c, d, e)) -> Row e -> Row (a, b, c, d, e)
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row e
forall a. HasqlDecodeColumn a => Row a
hasqlColumnDecoder