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

module Data.Morpheus.Server.Deriving.Utils.GScan
  ( scanFree,
    FreeCatType (..),
    freeLeaf,
    freeNode,
    ScanRef,
  )
where

import Data.Morpheus.Generic
  ( CBox,
    Gmap,
    ProxyMap (..),
    ScanRef (..),
    scan,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded (mapCat)
import Data.Morpheus.Server.Deriving.Utils.Types (CatType (..))
import Data.Morpheus.Server.Types.TypeName (TypeFingerprint (..))
import GHC.Generics (Generic (Rep))
import Relude hiding (fromList)

instance ProxyMap FreeCatType where
  proxyMap :: forall (f :: k -> *) (b :: k) (a :: k).
f b -> FreeCatType a -> FreeCatType b
proxyMap f b
prx (FreeCatType CatType c a
cat) = CatType c b -> FreeCatType b
forall {k} (c :: TypeCategory) (a :: k).
CatType c a -> FreeCatType a
FreeCatType (f b -> CatType c a -> CatType c b
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat f b
prx CatType c a
cat)

data FreeCatType a where
  FreeCatType :: forall c a. CatType c a -> FreeCatType a

freeLeaf :: (c1 a) => TypeFingerprint -> CatType c2 a -> ScanRef FreeCatType c1
freeLeaf :: forall (c1 :: * -> Constraint) a (c2 :: TypeCategory).
c1 a =>
TypeFingerprint -> CatType c2 a -> ScanRef FreeCatType c1
freeLeaf TypeFingerprint
fp CatType c2 a
p = Fingerprint -> FreeCatType a -> ScanRef FreeCatType c1
forall a (f :: * -> *) (c :: * -> Constraint).
c a =>
Fingerprint -> f a -> ScanRef f c
ScanLeaf (TypeFingerprint -> Fingerprint
forall b a. (Show a, IsString b) => a -> b
show TypeFingerprint
fp) (CatType c2 a -> FreeCatType a
forall {k} (c :: TypeCategory) (a :: k).
CatType c a -> FreeCatType a
FreeCatType CatType c2 a
p)

freeNode :: (c a, Gmap c (Rep a)) => Bool -> TypeFingerprint -> CatType c2 a -> ScanRef FreeCatType c
freeNode :: forall (c :: * -> Constraint) a (c2 :: TypeCategory).
(c a, Gmap c (Rep a)) =>
Bool -> TypeFingerprint -> CatType c2 a -> ScanRef FreeCatType c
freeNode Bool
visible TypeFingerprint
fp CatType c2 a
p = Bool -> Fingerprint -> FreeCatType a -> ScanRef FreeCatType c
forall a (f :: * -> *) (c :: * -> Constraint).
(Gmap c (Rep a), c a) =>
Bool -> Fingerprint -> f a -> ScanRef f c
ScanNode Bool
visible (TypeFingerprint -> Fingerprint
forall b a. (Show a, IsString b) => a -> b
show TypeFingerprint
fp) (CatType c2 a -> FreeCatType a
forall {k} (c :: TypeCategory) (a :: k).
CatType c a -> FreeCatType a
FreeCatType CatType c2 a
p)

scanFree :: (c a) => (forall k' a'. (c a') => CatType k' a' -> [ScanRef FreeCatType c]) -> CatType k a -> [CBox FreeCatType c]
scanFree :: forall (c :: * -> Constraint) a (k :: TypeCategory).
c a =>
(forall (k' :: TypeCategory) a'.
 c a' =>
 CatType k' a' -> [ScanRef FreeCatType c])
-> CatType k a -> [CBox FreeCatType c]
scanFree forall (k' :: TypeCategory) a'.
c a' =>
CatType k' a' -> [ScanRef FreeCatType c]
f = (forall a'. c a' => FreeCatType a' -> [ScanRef FreeCatType c])
-> FreeCatType a -> [CBox FreeCatType c]
forall (c :: * -> Constraint) a (f :: * -> *).
(c a, ProxyMap f) =>
(forall a'. c a' => f a' -> [ScanRef f c]) -> f a -> [CBox f c]
scan (\(FreeCatType CatType c a'
x) -> CatType c a' -> [ScanRef FreeCatType c]
forall (k' :: TypeCategory) a'.
c a' =>
CatType k' a' -> [ScanRef FreeCatType c]
f CatType c a'
x) (FreeCatType a -> [CBox FreeCatType c])
-> (CatType k a -> FreeCatType a)
-> CatType k a
-> [CBox FreeCatType c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType k a -> FreeCatType a
forall {k} (c :: TypeCategory) (a :: k).
CatType c a -> FreeCatType a
FreeCatType