{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasql.Interpolate.Internal.Decoder
  ( -- * Decoding type classes
    DecodeValue (..),
    DecodeField (..),
    DecodeRow (..),
    DecodeResult (..),

    -- * Generics
    GDecodeRow (..),
  )
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 GHC.Generics
import Hasql.Decoders
import Hasql.Interpolate.Internal.Decoder.TH

-- | This type class determines which decoder we will apply to a query
-- field by the type of the result.
--
-- ==== __Example__
--
-- @
--
-- data ThreatLevel = None | Midnight
--
-- instance DecodeValue ThreatLevel where
--   decodeValue = enum \\case
--     "none"     -> Just None
--     "midnight" -> Just Midnight
--     _          -> Nothing
-- @
class DecodeValue a where
  decodeValue :: Value a

-- | 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 DecodeField a where
  decodeField :: NullableOrNot Value a

-- | Determine a row decoder from a Haskell type. Derivable with
-- generics for any product type.
--
-- ==== __Examples__
--
-- A manual instance:
--
-- @
-- data T = T Int64 Bool Text
--
-- instance DecodeRow T where
--   decodeRow = T
--     <$> column decodeField
--     <*> column decodeField
--     <*> column decodeField
-- @
--
-- A generic instance:
--
-- @
-- data T
--  = T Int64 Bool Text
--  deriving stock (Generic)
--  deriving anyclass (DecodeRow)
-- @
class DecodeRow a where
  decodeRow :: Row a
  default decodeRow :: (Generic a, GDecodeRow (Rep a)) => Row a
  decodeRow = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Row (Rep a Any) -> Row a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Rep a Any)
forall (a :: * -> *) p. GDecodeRow a => Row (a p)
gdecodeRow

class GDecodeRow a where
  gdecodeRow :: Row (a p)

-- | Determine a result decoder from a Haskell type.
class DecodeResult a where
  decodeResult :: Result a

instance GDecodeRow a => GDecodeRow (M1 t i a) where
  gdecodeRow :: Row (M1 t i a p)
gdecodeRow = a p -> M1 t i a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a p -> M1 t i a p) -> Row (a p) -> Row (M1 t i a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (a p)
forall (a :: * -> *) p. GDecodeRow a => Row (a p)
gdecodeRow

instance (GDecodeRow a, GDecodeRow b) => GDecodeRow (a :*: b) where
  gdecodeRow :: Row ((:*:) a b p)
gdecodeRow = a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a p -> b p -> (:*:) a b p)
-> Row (a p) -> Row (b p -> (:*:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (a p)
forall (a :: * -> *) p. GDecodeRow a => Row (a p)
gdecodeRow Row (b p -> (:*:) a b p) -> Row (b p) -> Row ((:*:) a b p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row (b p)
forall (a :: * -> *) p. GDecodeRow a => Row (a p)
gdecodeRow

instance DecodeField a => GDecodeRow (K1 i a) where
  gdecodeRow :: Row (K1 i a p)
gdecodeRow = a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a p) -> Row a -> Row (K1 i a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NullableOrNot Value a -> Row a
forall a. NullableOrNot Value a -> Row a
column NullableOrNot Value a
forall a. DecodeField a => NullableOrNot Value a
decodeField

-- | Parse a postgres @array@ using 'listArray'
instance DecodeField a => DecodeValue [a] where
  decodeValue :: Value [a]
decodeValue = NullableOrNot Value a -> Value [a]
forall element. NullableOrNot Value element -> Value [element]
listArray NullableOrNot Value a
forall a. DecodeField a => NullableOrNot Value a
decodeField

-- | Parse a postgres @array@ using 'vectorArray'
instance DecodeField a => DecodeValue (Vector a) where
  decodeValue :: Value (Vector a)
decodeValue = NullableOrNot Value a -> Value (Vector a)
forall (vector :: * -> *) element.
Vector vector element =>
NullableOrNot Value element -> Value (vector element)
vectorArray NullableOrNot Value a
forall a. DecodeField a => NullableOrNot Value a
decodeField

-- | Parse a postgres @bool@ using 'bool'
instance DecodeValue Bool where
  decodeValue :: Value Bool
decodeValue = Value Bool
bool

-- | Parse a postgres @text@ using 'text'
instance DecodeValue Text where
  decodeValue :: Value Text
decodeValue = Value Text
text

-- | Parse a postgres @int2@ using 'int2'
instance DecodeValue Int16 where
  decodeValue :: Value Int16
decodeValue = Value Int16
int2

-- | Parse a postgres @int4@ using 'int4'
instance DecodeValue Int32 where
  decodeValue :: Value Int32
decodeValue = Value Int32
int4

-- | Parse a postgres @int8@ using 'int8'
instance DecodeValue Int64 where
  decodeValue :: Value Int64
decodeValue = Value Int64
int8

-- | Parse a postgres @float4@ using 'float4'
instance DecodeValue Float where
  decodeValue :: Value Float
decodeValue = Value Float
float4

-- | Parse a postgres @float8@ using 'float8'
instance DecodeValue Double where
  decodeValue :: Value Double
decodeValue = Value Double
float8

-- | Parse a postgres @char@ using 'char'
instance DecodeValue Char where
  decodeValue :: Value Char
decodeValue = Value Char
char

-- | Parse a postgres @date@ using 'date'
instance DecodeValue Day where
  decodeValue :: Value Day
decodeValue = Value Day
date

-- | Parse a postgres @timestamp@ using 'timestamp'
instance DecodeValue LocalTime where
  decodeValue :: Value LocalTime
decodeValue = Value LocalTime
timestamp

-- | Parse a postgres @timestamptz@ using 'timestamptz'
instance DecodeValue UTCTime where
  decodeValue :: Value UTCTime
decodeValue = Value UTCTime
timestamptz

-- | Parse a postgres @numeric@ using 'numeric'
instance DecodeValue Scientific where
  decodeValue :: Value Scientific
decodeValue = Value Scientific
numeric

-- | Parse a postgres @interval@ using 'interval'
instance DecodeValue DiffTime where
  decodeValue :: Value DiffTime
decodeValue = Value DiffTime
interval

-- | Parse a postgres @uuid@ using 'uuid'
instance DecodeValue UUID where
  decodeValue :: Value UUID
decodeValue = Value UUID
uuid

-- | Overlappable instance for parsing non-nullable values
instance {-# OVERLAPPABLE #-} DecodeValue a => DecodeField a where
  decodeField :: NullableOrNot Value a
decodeField = Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
nonNullable Value a
forall a. DecodeValue a => Value a
decodeValue

-- | Instance for parsing nullable values
instance DecodeValue a => DecodeField (Maybe a) where
  decodeField :: NullableOrNot Value (Maybe a)
decodeField = Value a -> NullableOrNot Value (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
nullable Value a
forall a. DecodeValue a => Value a
decodeValue

-- | Parse any number of rows into a list ('rowList')
instance DecodeRow a => DecodeResult [a] where
  decodeResult :: Result [a]
decodeResult = Row a -> Result [a]
forall a. Row a -> Result [a]
rowList Row a
forall a. DecodeRow a => Row a
decodeRow

-- | Parse any number of rows into a 'Vector' ('rowVector')
instance DecodeRow a => DecodeResult (Vector a) where
  decodeResult :: Result (Vector a)
decodeResult = Row a -> Result (Vector a)
forall a. Row a -> Result (Vector a)
rowVector Row a
forall a. DecodeRow a => Row a
decodeRow

-- | Parse zero or one rows, throw 'Hasql.Errors.UnexpectedAmountOfRows' otherwise. ('rowMaybe')
instance DecodeRow a => DecodeResult (Maybe a) where
  decodeResult :: Result (Maybe a)
decodeResult = Row a -> Result (Maybe a)
forall a. Row a -> Result (Maybe a)
rowMaybe Row a
forall a. DecodeRow a => Row a
decodeRow

-- | Ignore the query response ('noResult')
instance DecodeResult () where
  decodeResult :: Result ()
decodeResult = Result ()
noResult

$(traverse genDecodeRowInstance [2 .. 8])