{-# 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 :: forall {k} k (f :: k -> *) (c :: k -> Constraint) v.
(Hashable k, Eq k) =>
(CBox f c -> [v]) -> (v -> k) -> [CBox f c] -> HashMap k v
useProxies CBox f c -> [v]
toValue v -> k
toKey = [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(k, v)] -> HashMap k v)
-> ([CBox f c] -> [(k, v)]) -> [CBox f c] -> HashMap k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> (k, v)) -> [v] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
map (\v
x -> (v -> k
toKey v
x, v
x)) ([v] -> [(k, v)]) -> ([CBox f c] -> [v]) -> [CBox f c] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CBox f c -> [v]) -> [CBox f c] -> [v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CBox f c -> [v]
toValue

scan :: (c a, ProxyMap f) => (forall a'. (c a') => f a' -> [ScanRef f c]) -> f a -> [CBox f c]
scan :: forall (c :: * -> Constraint) a (f :: * -> *).
(c a, ProxyMap f) =>
(forall a'. c a' => f a' -> [ScanRef f c]) -> f a -> [CBox f c]
scan forall a'. c a' => f a' -> [ScanRef f c]
f = ScannerMap f c -> [CBox f c]
forall a. HashMap Fingerprint a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ScannerMap f c -> [CBox f c])
-> (f a -> ScannerMap f c) -> f a -> [CBox f c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
forall (f :: * -> *) (c :: * -> Constraint).
ProxyMap f =>
Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
scanRefs ((forall a'. c a' => f a' -> [ScanRef f c]) -> Scanner f c
forall (f :: * -> *) (c :: * -> Constraint).
(forall a. c a => f a -> [ScanRef f c]) -> Scanner f c
Scanner f a -> [ScanRef f c]
forall a'. c a' => f a' -> [ScanRef f c]
f) ScannerMap f c
forall a. Monoid a => a
mempty ([ScanRef f c] -> ScannerMap f c)
-> (f a -> [ScanRef f c]) -> f a -> ScannerMap f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [ScanRef f c]
forall a'. c a' => f a' -> [ScanRef f c]
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 :: forall (f :: k -> *) (b :: k) (a :: k). f b -> Proxy a -> Proxy b
proxyMap f b
p Proxy a
_ = f b -> Proxy b
forall {k} (f :: k -> *) (a :: k). f a -> Proxy a
toProxy f b
p
    where
      toProxy :: f a -> Proxy a
      toProxy :: forall {k} (f :: k -> *) (a :: k). f a -> Proxy a
toProxy f a
_ = Proxy a
forall {k} (t :: k). Proxy t
Proxy

runProxy :: (ProxyMap f) => f a -> Scanner f c -> CProxy c -> [ScanRef f c]
runProxy :: forall (f :: * -> *) a (c :: * -> Constraint).
ProxyMap f =>
f a -> Scanner f c -> CProxy c -> [ScanRef f c]
runProxy f a
cat Scanner f c
scanner (CProxy f a
prx) = Scanner f c -> forall a. c a => f a -> [ScanRef f c]
forall (f :: * -> *) (c :: * -> Constraint).
Scanner f c -> forall a. c a => f a -> [ScanRef f c]
runScanner Scanner f c
scanner (f a -> f a -> f a
forall {k} (p :: k -> *) (f :: k -> *) (b :: k) (a :: k).
ProxyMap p =>
f b -> p a -> p b
forall (f :: * -> *) b a. f b -> f a -> f b
proxyMap f a
prx f a
cat)

fieldRefs :: (ProxyMap f) => Scanner f c -> ScanRef f c -> [ScanRef f c]
fieldRefs :: forall (f :: * -> *) (c :: * -> Constraint).
ProxyMap f =>
Scanner f c -> ScanRef f c -> [ScanRef f c]
fieldRefs Scanner f c
scanner (ScanNode Bool
_ Fingerprint
_ f a
prx) = (CProxy c -> [ScanRef f c]) -> [CProxy c] -> [ScanRef f c]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (f a -> Scanner f c -> CProxy c -> [ScanRef f c]
forall (f :: * -> *) a (c :: * -> Constraint).
ProxyMap f =>
f a -> Scanner f c -> CProxy c -> [ScanRef f c]
runProxy f a
prx Scanner f c
scanner) (f a -> [CProxy c]
forall (c :: * -> Constraint) a (f :: * -> *).
Gmap c (Rep a) =>
f a -> [CProxy c]
gmap f a
prx)
fieldRefs Scanner f c
_ ScanLeaf {} = []

visited :: HashMap Fingerprint v -> ScanRef f c -> Bool
visited :: forall v (f :: * -> *) (c :: * -> Constraint).
HashMap Fingerprint v -> ScanRef f c -> Bool
visited HashMap Fingerprint v
lib (ScanNode Bool
_ Fingerprint
fp f a
_) = Fingerprint -> HashMap Fingerprint v -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
member Fingerprint
fp HashMap Fingerprint v
lib
visited HashMap Fingerprint v
lib (ScanLeaf Fingerprint
fp f a
_) = Fingerprint -> HashMap Fingerprint v -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
member Fingerprint
fp HashMap Fingerprint v
lib

getFingerprint :: ScanRef f c -> Fingerprint
getFingerprint :: forall (f :: * -> *) (c :: * -> Constraint).
ScanRef f c -> Fingerprint
getFingerprint (ScanNode Bool
_ Fingerprint
fp f a
_) = Fingerprint
fp
getFingerprint (ScanLeaf Fingerprint
fp f a
_) = Fingerprint
fp

scanRefs :: (ProxyMap f) => Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
scanRefs :: forall (f :: * -> *) (c :: * -> Constraint).
ProxyMap f =>
Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
scanRefs Scanner f c
_ ScannerMap f c
lib [] = ScannerMap f c
lib
scanRefs Scanner f c
ctx ScannerMap f c
lib (ScanRef f c
x : [ScanRef f c]
xs) = do
  let values :: [CBox f c]
values = ScanRef f c -> [CBox f c]
forall (f :: * -> *) (c :: * -> Constraint).
ScanRef f c -> [CBox f c]
runRef ScanRef f c
x
  let newLib :: ScannerMap f c
newLib = (CBox f c -> ScannerMap f c -> ScannerMap f c)
-> ScannerMap f c -> [CBox f c] -> ScannerMap f c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Fingerprint -> CBox f c -> ScannerMap f c -> ScannerMap f c
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert (ScanRef f c -> Fingerprint
forall (f :: * -> *) (c :: * -> Constraint).
ScanRef f c -> Fingerprint
getFingerprint ScanRef f c
x)) ScannerMap f c
lib [CBox f c]
values
  let refs :: [ScanRef f c]
refs = (ScanRef f c -> Bool) -> [ScanRef f c] -> [ScanRef f c]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ScanRef f c -> Bool) -> ScanRef f c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScannerMap f c -> ScanRef f c -> Bool
forall v (f :: * -> *) (c :: * -> Constraint).
HashMap Fingerprint v -> ScanRef f c -> Bool
visited ScannerMap f c
newLib) ([ScanRef f c]
xs [ScanRef f c] -> [ScanRef f c] -> [ScanRef f c]
forall a. Semigroup a => a -> a -> a
<> Scanner f c -> ScanRef f c -> [ScanRef f c]
forall (f :: * -> *) (c :: * -> Constraint).
ProxyMap f =>
Scanner f c -> ScanRef f c -> [ScanRef f c]
fieldRefs Scanner f c
ctx ScanRef f c
x)
  Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
forall (f :: * -> *) (c :: * -> Constraint).
ProxyMap f =>
Scanner f c -> ScannerMap f c -> [ScanRef f c] -> ScannerMap f c
scanRefs Scanner f c
ctx ScannerMap f c
newLib [ScanRef f c]
refs

runRef :: ScanRef f c -> [CBox f c]
runRef :: forall (f :: * -> *) (c :: * -> Constraint).
ScanRef f c -> [CBox f c]
runRef (ScanNode Bool
visible Fingerprint
_ f a
p) = [f a -> CBox f c
forall {k} (constraint :: k -> Constraint) (box :: k -> *)
       (a :: k).
constraint a =>
box a -> CBox box constraint
CBox f a
p | Bool
visible]
runRef (ScanLeaf Fingerprint
_ f a
p) = [f a -> CBox f c
forall {k} (constraint :: k -> Constraint) (box :: k -> *)
       (a :: k).
constraint a =>
box a -> CBox box constraint
CBox f a
p]

scanLeaf :: (c a, Show fp) => fp -> f a -> ScanRef f c
scanLeaf :: forall (c :: * -> Constraint) a fp (f :: * -> *).
(c a, Show fp) =>
fp -> f a -> ScanRef f c
scanLeaf fp
fp = Fingerprint -> f a -> ScanRef f c
forall a (f :: * -> *) (c :: * -> Constraint).
c a =>
Fingerprint -> f a -> ScanRef f c
ScanLeaf (fp -> Fingerprint
forall b a. (Show a, IsString b) => a -> b
show fp
fp)

scanNode :: (Gmap c (Rep a), c a, Show fp) => Bool -> fp -> f a -> ScanRef f c
scanNode :: forall (c :: * -> Constraint) a fp (f :: * -> *).
(Gmap c (Rep a), c a, Show fp) =>
Bool -> fp -> f a -> ScanRef f c
scanNode Bool
visible fp
fp = Bool -> Fingerprint -> f a -> ScanRef f c
forall a (f :: * -> *) (c :: * -> Constraint).
(Gmap c (Rep a), c a) =>
Bool -> Fingerprint -> f a -> ScanRef f c
ScanNode Bool
visible (fp -> Fingerprint
forall b a. (Show a, IsString b) => a -> b
show fp
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
  {forall (f :: * -> *) (c :: * -> Constraint).
Scanner f c -> forall a. c a => f a -> [ScanRef f c]
runScanner :: forall a. (c a) => f a -> [ScanRef f c]}