{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Utils.Gmap
  ( GmapContext (..),
    useGmap,
    Gmap (..),
  )
where

import GHC.Generics
  ( C,
    D,
    Datatype,
    K1,
    M1,
    S,
    U1,
    type (:*:),
    type (:+:),
  )
import Relude

newtype GmapContext (fun :: Type -> Constraint) (v :: Type) = GmapContext
  { forall (fun :: * -> Constraint) v.
GmapContext fun v -> forall (f :: * -> *) a. fun a => f a -> v
gmapFun :: forall f a. (fun a) => f a -> v
  }

useGmap :: (Gmap c a, Monoid b) => f a -> GmapContext c b -> b
useGmap :: forall {k} (c :: * -> Constraint) (a :: k) b (f :: k -> *).
(Gmap c a, Monoid b) =>
f a -> GmapContext c b -> b
useGmap f a
x = forall r a. Reader r a -> r -> a
runReader (forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap f a
x)

class Gmap (c :: Type -> Constraint) a where
  gfmap :: (Monoid v) => proxy a -> Reader (GmapContext c v) v

instance (Datatype d, Gmap c a) => Gmap c (M1 D d a) where
  gfmap :: forall v (proxy :: (k -> *) -> *).
Monoid v =>
proxy (M1 D d a) -> Reader (GmapContext c v) v
gfmap proxy (M1 D d a)
_ = forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap (forall {k} (t :: k). Proxy t
Proxy @a)

instance (Gmap con a) => Gmap con (M1 C c a) where
  gfmap :: forall v (proxy :: (k -> *) -> *).
Monoid v =>
proxy (M1 C c a) -> Reader (GmapContext con v) v
gfmap proxy (M1 C c a)
_ = forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap (forall {k} (t :: k). Proxy t
Proxy @a)

instance (Gmap c a, Gmap c b) => Gmap c (a :+: b) where
  gfmap :: forall v (proxy :: (k -> *) -> *).
Monoid v =>
proxy (a :+: b) -> Reader (GmapContext c v) v
gfmap proxy (a :+: b)
_ = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap (forall {k} (t :: k). Proxy t
Proxy @a)) (forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap (forall {k} (t :: k). Proxy t
Proxy @b))

instance (Gmap c a, Gmap c b) => Gmap c (a :*: b) where
  gfmap :: forall v (proxy :: (k -> *) -> *).
Monoid v =>
proxy (a :*: b) -> Reader (GmapContext c v) v
gfmap proxy (a :*: b)
_ = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap (forall {k} (t :: k). Proxy t
Proxy @a)) (forall {k} (c :: * -> Constraint) (a :: k) v (proxy :: k -> *).
(Gmap c a, Monoid v) =>
proxy a -> Reader (GmapContext c v) v
gfmap (forall {k} (t :: k). Proxy t
Proxy @b))

instance (c a) => Gmap c (M1 S s (K1 x a)) where
  gfmap :: forall v (proxy :: (k -> *) -> *).
Monoid v =>
proxy (M1 S s (K1 x a)) -> Reader (GmapContext c v) v
gfmap proxy (M1 S s (K1 x a))
_ = forall v. GmapContext c v -> v
runFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
    where
      runFun :: GmapContext c v -> v
      runFun :: forall v. GmapContext c v -> v
runFun GmapContext {forall (f :: * -> *) a. c a => f a -> v
gmapFun :: forall (f :: * -> *) a. c a => f a -> v
gmapFun :: forall (fun :: * -> Constraint) v.
GmapContext fun v -> forall (f :: * -> *) a. fun a => f a -> v
..} = forall (f :: * -> *) a. c a => f a -> v
gmapFun (forall {k} (t :: k). Proxy t
Proxy @a)

instance Gmap c U1 where
  gfmap :: forall v (proxy :: (k -> *) -> *).
Monoid v =>
proxy U1 -> Reader (GmapContext c v) v
gfmap proxy U1
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty