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

module Data.Morpheus.Server.Deriving.Utils.GScan
  ( Scanner (..),
    ScanRef (..),
    scan,
  )
where

import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import Data.Morpheus.Server.Deriving.Utils.Gmap
  ( Gmap,
    GmapContext (..),
    useGmap,
  )
import Data.Morpheus.Server.Types.TypeName (TypeFingerprint)
import GHC.Generics (Generic (Rep))
import Relude

scan :: (Hashable k, Eq k) => (b -> k) -> Scanner c b -> [ScanRef c] -> HashMap k b
scan :: forall k b (c :: * -> Constraint).
(Hashable k, Eq k) =>
(b -> k) -> Scanner c b -> [ScanRef c] -> HashMap k b
scan b -> k
toKey Scanner c b
ctx = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> (b -> k
toKey b
x, b
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> Constraint) v.
Scanner c v
-> Map TypeFingerprint v -> [ScanRef c] -> Map TypeFingerprint v
scanRefs Scanner c b
ctx forall a. Monoid a => a
mempty

fieldRefs :: Scanner c v -> ScanRef c -> [ScanRef c]
fieldRefs :: forall (c :: * -> Constraint) v.
Scanner c v -> ScanRef c -> [ScanRef c]
fieldRefs Scanner c v
ctx (ScanObject TypeFingerprint
_ f a
x) = forall {k} (c :: * -> Constraint) (a :: k) b (f :: k -> *).
(Gmap c a, Monoid b) =>
f a -> GmapContext c b -> b
useGmap (forall (f :: * -> *) a. f a -> Proxy (Rep a)
rep f a
x) (forall (c :: * -> Constraint) v.
Scanner c v -> GmapContext c [ScanRef c]
mapContext Scanner c v
ctx)
fieldRefs Scanner c v
_ ScanType {} = []

rep :: f a -> Proxy (Rep a)
rep :: forall (f :: * -> *) a. f a -> Proxy (Rep a)
rep f a
_ = forall {k} (t :: k). Proxy t
Proxy

visited :: Map TypeFingerprint v -> ScanRef c -> Bool
visited :: forall v (c :: * -> Constraint).
Map TypeFingerprint v -> ScanRef c -> Bool
visited Map TypeFingerprint v
lib (ScanObject TypeFingerprint
fp f a
_) = forall k a. Ord k => k -> Map k a -> Bool
M.member TypeFingerprint
fp Map TypeFingerprint v
lib
visited Map TypeFingerprint v
lib (ScanType TypeFingerprint
fp f a
_) = forall k a. Ord k => k -> Map k a -> Bool
M.member TypeFingerprint
fp Map TypeFingerprint v
lib

getFingerprint :: ScanRef c -> TypeFingerprint
getFingerprint :: forall (c :: * -> Constraint). ScanRef c -> TypeFingerprint
getFingerprint (ScanObject TypeFingerprint
fp f a
_) = TypeFingerprint
fp
getFingerprint (ScanType TypeFingerprint
fp f a
_) = TypeFingerprint
fp

scanRefs :: Scanner c v -> Map TypeFingerprint v -> [ScanRef c] -> Map TypeFingerprint v
scanRefs :: forall (c :: * -> Constraint) v.
Scanner c v
-> Map TypeFingerprint v -> [ScanRef c] -> Map TypeFingerprint v
scanRefs Scanner c v
_ Map TypeFingerprint v
lib [] = Map TypeFingerprint v
lib
scanRefs Scanner c v
ctx Map TypeFingerprint v
lib (ScanRef c
x : [ScanRef c]
xs) = do
  let values :: [v]
values = forall (c :: * -> Constraint) v. Scanner c v -> ScanRef c -> [v]
runRef Scanner c v
ctx ScanRef c
x
  let newLib :: Map TypeFingerprint v
newLib = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall (c :: * -> Constraint). ScanRef c -> TypeFingerprint
getFingerprint ScanRef c
x)) Map TypeFingerprint v
lib [v]
values
  let refs :: [ScanRef c]
refs = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (c :: * -> Constraint).
Map TypeFingerprint v -> ScanRef c -> Bool
visited Map TypeFingerprint v
newLib) ([ScanRef c]
xs forall a. Semigroup a => a -> a -> a
<> forall (c :: * -> Constraint) v.
Scanner c v -> ScanRef c -> [ScanRef c]
fieldRefs Scanner c v
ctx ScanRef c
x)
  forall (c :: * -> Constraint) v.
Scanner c v
-> Map TypeFingerprint v -> [ScanRef c] -> Map TypeFingerprint v
scanRefs Scanner c v
ctx Map TypeFingerprint v
newLib [ScanRef c]
refs

runRef :: Scanner c v -> ScanRef c -> [v]
runRef :: forall (c :: * -> Constraint) v. Scanner c v -> ScanRef c -> [v]
runRef Scanner {forall (f :: * -> *) a. c a => f a -> [v]
forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerRefs :: forall (c :: * -> Constraint) v.
Scanner c v -> forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerFun :: forall (c :: * -> Constraint) v.
Scanner c v -> forall (f :: * -> *) a. c a => f a -> [v]
scannerRefs :: forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerFun :: forall (f :: * -> *) a. c a => f a -> [v]
..} (ScanObject TypeFingerprint
_ f a
t) = forall (f :: * -> *) a. c a => f a -> [v]
scannerFun f a
t
runRef Scanner {forall (f :: * -> *) a. c a => f a -> [v]
forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerRefs :: forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerFun :: forall (f :: * -> *) a. c a => f a -> [v]
scannerRefs :: forall (c :: * -> Constraint) v.
Scanner c v -> forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerFun :: forall (c :: * -> Constraint) v.
Scanner c v -> forall (f :: * -> *) a. c a => f a -> [v]
..} (ScanType TypeFingerprint
_ f a
t) = forall (f :: * -> *) a. c a => f a -> [v]
scannerFun f a
t

mapContext :: Scanner c v -> GmapContext c [ScanRef c]
mapContext :: forall (c :: * -> Constraint) v.
Scanner c v -> GmapContext c [ScanRef c]
mapContext (Scanner forall (f :: * -> *) a. c a => f a -> [v]
_ forall (f :: * -> *) a. c a => f a -> [ScanRef c]
f) = forall (fun :: * -> Constraint) v.
(forall (f :: * -> *) a. fun a => f a -> v) -> GmapContext fun v
GmapContext forall (f :: * -> *) a. c a => f a -> [ScanRef c]
f

data ScanRef (c :: Type -> Constraint) where
  ScanObject :: forall f a c. (Gmap c (Rep a), c a) => TypeFingerprint -> f a -> ScanRef c
  ScanType :: forall f a c. (c a) => TypeFingerprint -> f a -> ScanRef c

data Scanner (c :: Type -> Constraint) (v :: Type) = Scanner
  { forall (c :: * -> Constraint) v.
Scanner c v -> forall (f :: * -> *) a. c a => f a -> [v]
scannerFun :: forall f a. (c a) => f a -> [v],
    forall (c :: * -> Constraint) v.
Scanner c v -> forall (f :: * -> *) a. c a => f a -> [ScanRef c]
scannerRefs :: forall f a. (c a) => f a -> [ScanRef c]
  }