{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-|
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 (..)
, HasqlDecodeValue (..)
, HasqlDecodeColumn (..)
) where

import Prelude
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.UUID (UUID)
import Data.Time.Clock (UTCTime, DiffTime)
import Data.Time.Calendar (Day)
import Data.Time.LocalTime (TimeOfDay)
import qualified Hasql.Decoders as Decoders
import Data.Int (Int16, Int32, Int64)
import Data.Scientific (Scientific)
import qualified Data.Aeson as Aeson
import qualified Database.PostgreSQL.Simple.Types as PG
import IHP.ModelSupport.Types (LabeledData(..), 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 mapping Haskell scalar types to hasql value decoders
class HasqlDecodeValue a where
    hasqlDecodeValue :: Decoders.Value a

instance HasqlDecodeValue Int16 where hasqlDecodeValue :: Value Int16
hasqlDecodeValue = Value Int16
Decoders.int2
instance HasqlDecodeValue Int32 where hasqlDecodeValue :: Value Int32
hasqlDecodeValue = Value Int32
Decoders.int4
instance HasqlDecodeValue Int64 where hasqlDecodeValue :: Value Int64
hasqlDecodeValue = Value Int64
Decoders.int8
instance HasqlDecodeValue Int where hasqlDecodeValue :: Value Int
hasqlDecodeValue = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Value Int64 -> Value Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Int64
Decoders.int8
instance HasqlDecodeValue Bool where hasqlDecodeValue :: Value Bool
hasqlDecodeValue = Value Bool
Decoders.bool
instance HasqlDecodeValue Text where hasqlDecodeValue :: Value Text
hasqlDecodeValue = Value Text
Decoders.text
instance HasqlDecodeValue ByteString where hasqlDecodeValue :: Value ByteString
hasqlDecodeValue = Value ByteString
Decoders.bytea
instance HasqlDecodeValue UUID where hasqlDecodeValue :: Value UUID
hasqlDecodeValue = Value UUID
Decoders.uuid
instance HasqlDecodeValue UTCTime where hasqlDecodeValue :: Value UTCTime
hasqlDecodeValue = Value UTCTime
Decoders.timestamptz
instance HasqlDecodeValue Day where hasqlDecodeValue :: Value Day
hasqlDecodeValue = Value Day
Decoders.date
instance HasqlDecodeValue TimeOfDay where hasqlDecodeValue :: Value TimeOfDay
hasqlDecodeValue = Value TimeOfDay
Decoders.time
instance HasqlDecodeValue DiffTime where hasqlDecodeValue :: Value DiffTime
hasqlDecodeValue = Value DiffTime
Decoders.interval
instance HasqlDecodeValue Scientific where hasqlDecodeValue :: Value Scientific
hasqlDecodeValue = Value Scientific
Decoders.numeric
instance HasqlDecodeValue Double where hasqlDecodeValue :: Value Double
hasqlDecodeValue = Value Double
Decoders.float8
instance HasqlDecodeValue Float where hasqlDecodeValue :: Value Float
hasqlDecodeValue = Value Float
Decoders.float4
instance HasqlDecodeValue Aeson.Value where hasqlDecodeValue :: Value Value
hasqlDecodeValue = Value Value
Decoders.jsonb
instance PrimaryKey table ~ UUID => HasqlDecodeValue (Id' table) where hasqlDecodeValue :: Value (Id' table)
hasqlDecodeValue = UUID -> Id' table
PrimaryKey table -> Id' table
forall (table :: Symbol). PrimaryKey table -> Id' table
Id (UUID -> Id' table) -> Value UUID -> Value (Id' table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value UUID
Decoders.uuid

-- | Typeclass for building column-level row decoders, handling nullable/non-nullable
class HasqlDecodeColumn a where
    hasqlColumnDecoder :: Decoders.Row a

instance {-# OVERLAPPABLE #-} HasqlDecodeValue 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. HasqlDecodeValue a => Value a
hasqlDecodeValue)

instance {-# OVERLAPPING #-} HasqlDecodeValue 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. HasqlDecodeValue a => Value a
hasqlDecodeValue)

-- 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

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