{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasql.Interpolate.Internal.CompositeValue
  ( CompositeValue (..),
  )
where

import Data.Coerce
import GHC.Generics
import Hasql.Decoders
import Hasql.Interpolate.Internal.Decoder

-- | Useful with @DerivingVia@ to get a 'DecodeValue' instance for any
-- product type by parsing it as a composite.
--
-- ==== __Example__
--
-- @
-- data Point = Point Int64 Int64
--   deriving stock (Generic)
--   deriving (DecodeValue) via CompositeValue Point
-- @
newtype CompositeValue a
  = CompositeValue a

instance (Generic a, GToComposite (Rep a)) => DecodeValue (CompositeValue a) where
  decodeValue :: Value (CompositeValue a)
decodeValue = coerce :: forall a b. Coercible a b => a -> b
coerce @(Value a) (forall a. Composite a -> Value a
composite (forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: * -> *) p. GToComposite a => Composite (a p)
gtoComposite))

class GToComposite a where
  gtoComposite :: Composite (a p)

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

instance (GToComposite a, GToComposite b) => GToComposite (a :*: b) where
  gtoComposite :: forall p. Composite ((:*:) a b p)
gtoComposite = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: * -> *) p. GToComposite a => Composite (a p)
gtoComposite forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: * -> *) p. GToComposite a => Composite (a p)
gtoComposite

instance DecodeValue a => GToComposite (K1 i a) where
  gtoComposite :: forall p. Composite (K1 i a p)
gtoComposite = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NullableOrNot Value a -> Composite a
field forall a. DecodeField a => NullableOrNot Value a
decodeField