{-# 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 = Value a -> Value (CompositeValue a)
coerce @(Value a) (Composite a -> Value a
forall a. Composite a -> Value a
composite (Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Composite (Rep a Any) -> Composite a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Composite (Rep a Any)
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 :: Composite (M1 t i a p)
gtoComposite = 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) -> Composite (a p) -> Composite (M1 t i a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Composite (a p)
forall (a :: * -> *) p. GToComposite a => Composite (a p)
gtoComposite

instance (GToComposite a, GToComposite b) => GToComposite (a :*: b) where
  gtoComposite :: Composite ((:*:) a b p)
gtoComposite = 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)
-> Composite (a p) -> Composite (b p -> (:*:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Composite (a p)
forall (a :: * -> *) p. GToComposite a => Composite (a p)
gtoComposite Composite (b p -> (:*:) a b p)
-> Composite (b p) -> Composite ((:*:) a b p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Composite (b p)
forall (a :: * -> *) p. GToComposite a => Composite (a p)
gtoComposite

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