{-# 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] }