{-# 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.Generic.GScan
( ScanRef (..),
ProxyMap (..),
useProxies,
scan,
scanNode,
scanLeaf,
)
where
import Data.HashMap.Strict (fromList, insert, member)
import Data.Morpheus.Generic.Gmap (Gmap, gmap)
import Data.Morpheus.Generic.Proxy
( CBox (..),
CProxy (..),
)
import GHC.Generics (Generic (Rep))
import Relude hiding (fromList)
-- GENERIC
type Fingerprint = Text
useProxies :: (Hashable k, Eq k) => (CBox f c -> [v]) -> (v -> k) -> [CBox f c] -> HashMap k v
useProxies toValue toKey = fromList . map (\x -> (toKey x, x)) . concatMap toValue
scan :: (c a, ProxyMap f) => (forall a'. (c a') => f a' -> [ScanRef f c]) -> f a -> [CBox f c]
scan f = toList . scanRefs (Scanner f) mempty . f
type ScannerMap f c = HashMap Fingerprint (CBox f c)
class ProxyMap p where
proxyMap :: f b -> p a -> p b
instance ProxyMap Proxy where
proxyMap p _ = toProxy p
where
toProxy :: f a -> Proxy a
toProxy _ = Proxy
runProxy :: (ProxyMap f) => f a -> Scanner f c -> CProxy c -> [ScanRef f c]
runProxy cat scanner (CProxy prx) = runScanner scanner (proxyMap prx cat)
fieldRefs :: (ProxyMap f) => Scanner f c -> ScanRef f c -> [ScanRef f c]
fieldRefs scanner (ScanNode _ _ prx) = concatMap (runProxy prx scanner) (gmap prx)
fieldRefs _ ScanLeaf {} = []
visited :: HashMap Fingerprint v -> ScanRef f c -> Bool
visited lib (ScanNode _ fp _) = member fp lib
visited lib (ScanLeaf fp _) = member fp lib
getFingerprint :: ScanRef f c -> Fingerprint
getFingerprint (ScanNode _ fp _) = fp
getFingerprint (ScanLeaf fp _) = fp
scanRefs :: (ProxyMap f) => Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
scanRefs _ lib [] = lib
scanRefs ctx lib (x : xs) = do
let values = runRef x
let newLib = foldr (insert (getFingerprint x)) lib values
let refs = filter (not . visited newLib) (xs <> fieldRefs ctx x)
scanRefs ctx newLib refs
runRef :: ScanRef f c -> [CBox f c]
runRef (ScanNode visible _ p) = [CBox p | visible]
runRef (ScanLeaf _ p) = [CBox p]
scanLeaf :: (c a, Show fp) => fp -> f a -> ScanRef f c
scanLeaf fp = ScanLeaf (show fp)
scanNode :: (Gmap c (Rep a), c a, Show fp) => Bool -> fp -> f a -> ScanRef f c
scanNode visible fp = ScanNode visible (show fp)
data ScanRef f (c :: Type -> Constraint) where
ScanNode :: forall a f c. (Gmap c (Rep a), c a) => Bool -> Fingerprint -> f a -> ScanRef f c
ScanLeaf :: forall a f c. (c a) => Fingerprint -> f a -> ScanRef f c
newtype Scanner f (c :: Type -> Constraint) = Scanner
{runScanner :: forall a. (c a) => f a -> [ScanRef f c]}