{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE BlockArguments #-}
module Dep.Advice
(
Advice,
makeAdvice,
makeArgsAdvice,
makeExecutionAdvice,
advise,
Ensure,
restrictArgs,
runFinalDepT,
runFromEnv,
runFromDep,
deceive,
adviseRecord,
deceiveRecord,
component,
toSimple,
fromSimple,
fromSimple_,
Top,
And,
All,
NP (..),
I (..),
cfoldMap_NP,
Dict (..),
)
where
import Dep.Has
import Dep.Env
import Control.Monad.Dep
import Control.Monad.Trans.Reader (ReaderT (..), withReaderT)
import Data.Functor.Identity
import Data.Kind
import Data.List.NonEmpty qualified as N
import Data.List.NonEmpty (NonEmpty)
import Data.SOP
import Data.SOP.Dict
import Data.SOP.NP
import Data.Typeable
import GHC.Generics qualified as G
import GHC.TypeLits
import Data.Coerce
import Data.Bifunctor (first)
import Dep.SimpleAdvice.Internal qualified as SA
type Advice ::
(Type -> Constraint) ->
((Type -> Type) -> Type) ->
(Type -> Type) ->
Type ->
Type
data Advice (ca :: Type -> Constraint) (e_ :: (Type -> Type) -> Type) m r where
Advice ::
forall ca e_ m r.
( forall as.
All ca as =>
NP I as ->
DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
) ->
Advice ca e_ m r
instance Monad m => Semigroup (Advice ca e_ m r) where
Advice forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
outer <> :: Advice ca e_ m r -> Advice ca e_ m r -> Advice ca e_ m r
<> Advice forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
inner = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
Advice \NP I as
args -> do
(DepT e_ m r -> DepT e_ m r
tweakOuter, NP I as
argsOuter) <- forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
outer NP I as
args
(DepT e_ m r -> DepT e_ m r
tweakInner, NP I as
argsInner) <- forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
inner NP I as
argsOuter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DepT e_ m r -> DepT e_ m r
tweakOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. DepT e_ m r -> DepT e_ m r
tweakInner, NP I as
argsInner)
instance Monad m => Monoid (Advice ca e_ m r) where
mappend :: Advice ca e_ m r -> Advice ca e_ m r -> Advice ca e_ m r
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mempty :: Advice ca e_ m r
mempty = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
Advice \NP I as
args -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> a
id, NP I as
args)
makeAdvice ::
forall ca e_ m r.
( forall as.
All ca as =>
NP I as ->
DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
) ->
Advice ca e_ m r
makeAdvice :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
makeAdvice = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
Advice
makeArgsAdvice ::
forall ca e_ m r.
Monad m =>
( forall as.
All ca as =>
NP I as ->
DepT e_ m (NP I as)
) ->
Advice ca e_ m r
makeArgsAdvice :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
(forall (as :: [*]). All ca as => NP I as -> DepT e_ m (NP I as))
-> Advice ca e_ m r
makeArgsAdvice forall (as :: [*]). All ca as => NP I as -> DepT e_ m (NP I as)
tweakArgs =
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
makeAdvice forall a b. (a -> b) -> a -> b
$ \NP I as
args -> do
NP I as
args' <- forall (as :: [*]). All ca as => NP I as -> DepT e_ m (NP I as)
tweakArgs NP I as
args
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> a
id, NP I as
args')
makeExecutionAdvice ::
forall ca e_ m r.
Applicative m =>
( DepT e_ m r ->
DepT e_ m r
) ->
Advice ca e_ m r
makeExecutionAdvice :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Applicative m =>
(DepT e_ m r -> DepT e_ m r) -> Advice ca e_ m r
makeExecutionAdvice DepT e_ m r -> DepT e_ m r
tweakExecution = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
makeAdvice \NP I as
args -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (DepT e_ m r -> DepT e_ m r
tweakExecution, NP I as
args)
data Pair a b = Pair !a !b
type Ensure :: ((Type -> Type) -> Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Constraint
type Ensure c e_ m = c (DepT e_ m) (e_ (DepT e_ m))
advise ::
forall ca e_ m r as advisee.
(Multicurryable as e_ m r advisee, All ca as, Monad m) =>
Advice ca e_ m r ->
advisee ->
advisee
advise :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r (as :: [*]) advisee.
(Multicurryable as e_ m r advisee, All ca as, Monad m) =>
Advice ca e_ m r -> advisee -> advisee
advise (Advice forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
f) advisee
advisee = do
let uncurried :: NP I as -> DepT e_ m r
uncurried = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
curried -> NP I as -> DepT e_ m r
multiuncurry @as @e_ @m @r advisee
advisee
uncurried' :: NP I as -> DepT e_ m r
uncurried' NP I as
args = do
(DepT e_ m r -> DepT e_ m r
tweakExecution, NP I as
args') <- forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
f NP I as
args
DepT e_ m r -> DepT e_ m r
tweakExecution (NP I as -> DepT e_ m r
uncurried NP I as
args')
in forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
(NP I as -> DepT e_ m r) -> curried
multicurry @as @e_ @m @r NP I as -> DepT e_ m r
uncurried'
type Multicurryable ::
[Type] ->
((Type -> Type) -> Type) ->
(Type -> Type) ->
Type ->
Type ->
Constraint
class Multicurryable as e_ m r curried | curried -> as e_ m r where
type DownToBaseMonad as e_ m r curried :: Type
multiuncurry :: curried -> NP I as -> DepT e_ m r
multicurry :: (NP I as -> DepT e_ m r) -> curried
_runFromEnv :: m (e_ (DepT e_ m)) -> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
_askFinalDepT :: (e_ (DepT e_ m) -> m curried) -> curried
instance Monad m => Multicurryable '[] e_ m r (DepT e_ m r) where
type DownToBaseMonad '[] e_ m r (DepT e_ m r) = m r
multiuncurry :: DepT e_ m r -> NP I '[] -> DepT e_ m r
multiuncurry DepT e_ m r
action NP I '[]
Nil = DepT e_ m r
action
multicurry :: (NP I '[] -> DepT e_ m r) -> DepT e_ m r
multicurry NP I '[] -> DepT e_ m r
f = NP I '[] -> DepT e_ m r
f forall {k} (a :: k -> *). NP a '[]
Nil
_runFromEnv :: m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> DepT e_ m r)
-> DownToBaseMonad '[] e_ m r (DepT e_ m r)
_runFromEnv m (e_ (DepT e_ m))
producer e_ (DepT e_ m) -> DepT e_ m r
extractor = do
e_ (DepT e_ m)
e <- m (e_ (DepT e_ m))
producer
forall (e_ :: (* -> *) -> *) (m :: * -> *) r.
DepT e_ m r -> e_ (DepT e_ m) -> m r
runDepT (e_ (DepT e_ m) -> DepT e_ m r
extractor e_ (DepT e_ m)
e) e_ (DepT e_ m)
e
_askFinalDepT :: (e_ (DepT e_ m) -> m (DepT e_ m r)) -> DepT e_ m r
_askFinalDepT e_ (DepT e_ m) -> m (DepT e_ m r)
f = do
e_ (DepT e_ m)
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
DepT e_ m r
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (e_ (DepT e_ m) -> m (DepT e_ m r)
f e_ (DepT e_ m)
env)
DepT e_ m r
r
instance (Functor m, Multicurryable as e_ m r curried) => Multicurryable (a ': as) e_ m r (a -> curried) where
type DownToBaseMonad (a ': as) e_ m r (a -> curried) = a -> DownToBaseMonad as e_ m r curried
multiuncurry :: (a -> curried) -> NP I (a : as) -> DepT e_ m r
multiuncurry a -> curried
f (I x
a :* NP I xs
as) = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
curried -> NP I as -> DepT e_ m r
multiuncurry @as @e_ @m @r @curried (a -> curried
f x
a) NP I xs
as
multicurry :: (NP I (a : as) -> DepT e_ m r) -> a -> curried
multicurry NP I (a : as) -> DepT e_ m r
f a
a = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
(NP I as -> DepT e_ m r) -> curried
multicurry @as @e_ @m @r @curried (NP I (a : as) -> DepT e_ m r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (forall a. a -> I a
I a
a))
_runFromEnv :: m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> a -> curried)
-> DownToBaseMonad (a : as) e_ m r (a -> curried)
_runFromEnv m (e_ (DepT e_ m))
producer e_ (DepT e_ m) -> a -> curried
extractor a
a = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
_runFromEnv @as @e_ @m @r @curried m (e_ (DepT e_ m))
producer (\e_ (DepT e_ m)
f -> e_ (DepT e_ m) -> a -> curried
extractor e_ (DepT e_ m)
f a
a)
_askFinalDepT :: (e_ (DepT e_ m) -> m (a -> curried)) -> a -> curried
_askFinalDepT e_ (DepT e_ m) -> m (a -> curried)
f =
let switcheroo :: f (p -> b) -> p -> f b
switcheroo f (p -> b)
action p
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ p
a) f (p -> b)
action
in forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
(e_ (DepT e_ m) -> m curried) -> curried
_askFinalDepT @as @e_ @m @r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {f :: * -> *} {p} {b}. Functor f => f (p -> b) -> p -> f b
switcheroo e_ (DepT e_ m) -> m (a -> curried)
f)
runFinalDepT ::
forall as e_ m r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m)) ->
curried ->
DownToBaseMonad as e_ m r curried
runFinalDepT :: forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m)) -> curried -> DownToBaseMonad as e_ m r curried
runFinalDepT m (e_ (DepT e_ m))
producer curried
extractor = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
_runFromEnv m (e_ (DepT e_ m))
producer (forall a b. a -> b -> a
const curried
extractor)
askFinalDepT ::
forall as e_ m r curried.
Multicurryable as e_ m r curried =>
(e_ (DepT e_ m) -> m curried) -> curried
askFinalDepT :: forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
(e_ (DepT e_ m) -> m curried) -> curried
askFinalDepT = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
(e_ (DepT e_ m) -> m curried) -> curried
_askFinalDepT @as @e_ @m @r
runFromEnv ::
forall as e_ m r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m)) ->
(e_ (DepT e_ m) -> curried) ->
DownToBaseMonad as e_ m r curried
runFromEnv :: forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
runFromEnv = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
_runFromEnv
runFromDep ::
forall dep as e_ m r curried.
(Multicurryable as e_ m r curried, Has dep (DepT e_ m) (e_ (DepT e_ m))) =>
m (e_ (DepT e_ m)) ->
(dep (DepT e_ m) -> curried) ->
DownToBaseMonad as e_ m r curried
runFromDep :: forall (dep :: (* -> *) -> *) (as :: [*]) (e_ :: (* -> *) -> *)
(m :: * -> *) r curried.
(Multicurryable as e_ m r curried,
Has dep (DepT e_ m) (e_ (DepT e_ m))) =>
m (e_ (DepT e_ m))
-> (dep (DepT e_ m) -> curried)
-> DownToBaseMonad as e_ m r curried
runFromDep m (e_ (DepT e_ m))
envAction dep (DepT e_ m) -> curried
member = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
m (e_ (DepT e_ m))
-> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
_runFromEnv m (e_ (DepT e_ m))
envAction (dep (DepT e_ m) -> curried
member forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r_ :: (* -> *) -> *) (m :: * -> *) env.
Has r_ m env =>
env -> r_ m
dep)
restrictArgs ::
forall more less e_ m r.
(forall x. Dict more x -> Dict less x) ->
Advice less e_ m r ->
Advice more e_ m r
restrictArgs :: forall (more :: * -> Constraint) (less :: * -> Constraint)
(e_ :: (* -> *) -> *) (m :: * -> *) r.
(forall x. Dict more x -> Dict less x)
-> Advice less e_ m r -> Advice more e_ m r
restrictArgs forall x. Dict more x -> Dict less x
evidence (Advice forall (as :: [*]).
All less as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
advice) = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
Advice \NP I as
args ->
let advice' :: forall as. All more as => NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
advice' :: forall (as :: [*]).
All more as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
advice' NP I as
args' =
case forall {k} (c :: k -> Constraint) (d :: k -> Constraint)
(xs :: [k]).
(forall (a :: k). Dict c a -> Dict d a)
-> Dict (All c) xs -> Dict (All d) xs
Data.SOP.Dict.mapAll @more @less forall x. Dict more x -> Dict less x
evidence of
Dict (All more) as -> Dict (All less) as
f -> case Dict (All more) as -> Dict (All less) as
f (forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict @(All more) @as) of
Dict (All less) as
Dict -> forall (as :: [*]).
All less as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
advice NP I as
args'
in forall (as :: [*]).
All more as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
advice' NP I as
args
type Gullible ::
[Type] ->
Type ->
((Type -> Type) -> Type) ->
(Type -> Type) ->
Type ->
Type ->
Constraint
class Multicurryable as e_ m r curried => Gullible as e e_ m r curried where
type NewtypedEnv as e e_ m r curried :: Type
_deceive :: (e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
instance Monad m => Gullible '[] e e_ m r (DepT e_ m r) where
type NewtypedEnv '[] e e_ m r (DepT e_ m r) = ReaderT e m r
_deceive :: (e_ (DepT e_ m) -> e)
-> NewtypedEnv '[] e e_ m r (DepT e_ m r) -> DepT e_ m r
_deceive e_ (DepT e_ m) -> e
f NewtypedEnv '[] e e_ m r (DepT e_ m r)
action = forall (e_ :: (* -> *) -> *) (m :: * -> *) r.
ReaderT (e_ (DepT e_ m)) m r -> DepT e_ m r
DepT (forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT e_ (DepT e_ m) -> e
f NewtypedEnv '[] e e_ m r (DepT e_ m r)
action)
instance (Functor m, Gullible as e e_ m r curried) => Gullible (a ': as) e e_ m r (a -> curried) where
type NewtypedEnv (a ': as) e e_ m r (a -> curried) = a -> NewtypedEnv as e e_ m r curried
_deceive :: (e_ (DepT e_ m) -> e)
-> NewtypedEnv (a : as) e e_ m r (a -> curried) -> a -> curried
_deceive e_ (DepT e_ m) -> e
f NewtypedEnv (a : as) e e_ m r (a -> curried)
g a
a = forall (as :: [*]) e (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Gullible as e e_ m r curried =>
(e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
deceive @as @e @e_ @m @r e_ (DepT e_ m) -> e
f (NewtypedEnv (a : as) e e_ m r (a -> curried)
g a
a)
deceive ::
forall as e e_ m r curried.
Gullible as e e_ m r curried =>
(e_ (DepT e_ m) -> e) ->
NewtypedEnv as e e_ m r curried ->
curried
deceive :: forall (as :: [*]) e (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Gullible as e e_ m r curried =>
(e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
deceive = forall (as :: [*]) e (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Gullible as e e_ m r curried =>
(e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
_deceive
type GullibleRecord :: Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> ((Type -> Type) -> Type) -> Constraint
class GullibleRecord e e_ m gullible where
_deceiveRecord :: (e_ (DepT e_ m) -> e) -> gullible (ReaderT e m) -> gullible (DepT e_ m)
type GullibleProduct :: Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> (k -> Type) -> (k -> Type) -> Constraint
class GullibleProduct e e_ m gullible_ deceived_ | e e_ m deceived_ -> gullible_ where
_deceiveProduct :: (e_ (DepT e_ m) -> e) -> gullible_ k -> deceived_ k
instance
( GullibleProduct e e_ m gullible_left deceived_left,
GullibleProduct e e_ m gullible_right deceived_right
) =>
GullibleProduct e e_ m (gullible_left G.:*: gullible_right) (deceived_left G.:*: deceived_right)
where
_deceiveProduct :: forall (k :: k).
(e_ (DepT e_ m) -> e)
-> (:*:) gullible_left gullible_right k
-> (:*:) deceived_left deceived_right k
_deceiveProduct e_ (DepT e_ m) -> e
f (gullible_left k
gullible_left G.:*: gullible_right k
gullible_right) = forall k e (e_ :: (* -> *) -> *) (m :: * -> *)
(gullible_ :: k -> *) (deceived_ :: k -> *) (k :: k).
GullibleProduct e e_ m gullible_ deceived_ =>
(e_ (DepT e_ m) -> e) -> gullible_ k -> deceived_ k
_deceiveProduct @_ @e @e_ @m e_ (DepT e_ m) -> e
f gullible_left k
gullible_left forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
G.:*: forall k e (e_ :: (* -> *) -> *) (m :: * -> *)
(gullible_ :: k -> *) (deceived_ :: k -> *) (k :: k).
GullibleProduct e e_ m gullible_ deceived_ =>
(e_ (DepT e_ m) -> e) -> gullible_ k -> deceived_ k
_deceiveProduct @_ @e @e_ @m e_ (DepT e_ m) -> e
f gullible_right k
gullible_right
data RecordComponent
= Terminal
| IWrapped
| Recurse
type DiscriminateGullibleComponent :: Type -> RecordComponent
type family DiscriminateGullibleComponent c where
DiscriminateGullibleComponent (a -> b) = Terminal
DiscriminateGullibleComponent (ReaderT e m x) = Terminal
DiscriminateGullibleComponent (Identity _) = IWrapped
DiscriminateGullibleComponent (I _) = IWrapped
DiscriminateGullibleComponent _ = Recurse
type GullibleComponent :: RecordComponent -> Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type -> Constraint
class GullibleComponent component_type e e_ m gullible deceived | e e_ m deceived -> gullible where
_deceiveComponent :: (e_ (DepT e_ m) -> e) -> gullible -> deceived
instance
(Gullible as e e_ m r deceived, NewtypedEnv as e e_ m r deceived ~ gullible) =>
GullibleComponent Terminal e e_ m gullible deceived
where
_deceiveComponent :: (e_ (DepT e_ m) -> e) -> gullible -> deceived
_deceiveComponent e_ (DepT e_ m) -> e
f gullible
gullible = forall (as :: [*]) e (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Gullible as e e_ m r curried =>
(e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
deceive @as @e @_ @m @r e_ (DepT e_ m) -> e
f gullible
gullible
instance
GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
GullibleComponent IWrapped e e_ m (Identity gullible) (Identity deceived)
where
_deceiveComponent :: (e_ (DepT e_ m) -> e) -> Identity gullible -> Identity deceived
_deceiveComponent e_ (DepT e_ m) -> e
f (Identity gullible
gullible) = forall a. a -> Identity a
Identity (forall (component_type :: RecordComponent) e (e_ :: (* -> *) -> *)
(m :: * -> *) gullible deceived.
GullibleComponent component_type e e_ m gullible deceived =>
(e_ (DepT e_ m) -> e) -> gullible -> deceived
_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m e_ (DepT e_ m) -> e
f gullible
gullible)
instance
GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
GullibleComponent IWrapped e e_ m (I gullible) (I deceived)
where
_deceiveComponent :: (e_ (DepT e_ m) -> e) -> I gullible -> I deceived
_deceiveComponent e_ (DepT e_ m) -> e
f (I gullible
gullible) = forall a. a -> I a
I (forall (component_type :: RecordComponent) e (e_ :: (* -> *) -> *)
(m :: * -> *) gullible deceived.
GullibleComponent component_type e e_ m gullible deceived =>
(e_ (DepT e_ m) -> e) -> gullible -> deceived
_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m e_ (DepT e_ m) -> e
f gullible
gullible)
instance
GullibleRecord e e_ m gullible =>
GullibleComponent Recurse e e_ m (gullible (ReaderT e m)) (gullible (DepT e_ m))
where
_deceiveComponent :: (e_ (DepT e_ m) -> e)
-> gullible (ReaderT e m) -> gullible (DepT e_ m)
_deceiveComponent e_ (DepT e_ m) -> e
f gullible (ReaderT e m)
gullible = forall e (e_ :: (* -> *) -> *) (m :: * -> *)
(gullible :: (* -> *) -> *).
GullibleRecord e e_ m gullible =>
(e_ (DepT e_ m) -> e)
-> gullible (ReaderT e m) -> gullible (DepT e_ m)
_deceiveRecord @e @e_ @m e_ (DepT e_ m) -> e
f gullible (ReaderT e m)
gullible
instance
GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
GullibleProduct e e_ m (G.S1 x (G.Rec0 gullible)) (G.S1 x (G.Rec0 deceived))
where
_deceiveProduct :: forall (k :: k).
(e_ (DepT e_ m) -> e)
-> S1 x (Rec0 gullible) k -> S1 x (Rec0 deceived) k
_deceiveProduct e_ (DepT e_ m) -> e
f (G.M1 (G.K1 gullible
gullible)) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i c (p :: k). c -> K1 i c p
G.K1 (forall (component_type :: RecordComponent) e (e_ :: (* -> *) -> *)
(m :: * -> *) gullible deceived.
GullibleComponent component_type e e_ m gullible deceived =>
(e_ (DepT e_ m) -> e) -> gullible -> deceived
_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m e_ (DepT e_ m) -> e
f gullible
gullible))
instance
( G.Generic (gullible (ReaderT e m)),
G.Generic (gullible (DepT e_ m)),
G.Rep (gullible (ReaderT e m)) ~ G.D1 x (G.C1 y gullible_),
G.Rep (gullible (DepT e_ m)) ~ G.D1 x (G.C1 y deceived_),
GullibleProduct e e_ m gullible_ deceived_
) =>
GullibleRecord e e_ m gullible
where
_deceiveRecord :: (e_ (DepT e_ m) -> e)
-> gullible (ReaderT e m) -> gullible (DepT e_ m)
_deceiveRecord e_ (DepT e_ m) -> e
f gullible (ReaderT e m)
gullible =
let G.M1 (G.M1 gullible_ Any
gullible_) = forall a x. Generic a => a -> Rep a x
G.from gullible (ReaderT e m)
gullible
deceived_ :: deceived_ Any
deceived_ = forall k e (e_ :: (* -> *) -> *) (m :: * -> *)
(gullible_ :: k -> *) (deceived_ :: k -> *) (k :: k).
GullibleProduct e e_ m gullible_ deceived_ =>
(e_ (DepT e_ m) -> e) -> gullible_ k -> deceived_ k
_deceiveProduct @_ @e @e_ @m e_ (DepT e_ m) -> e
f gullible_ Any
gullible_
in forall a x. Generic a => Rep a x -> a
G.to (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 deceived_ Any
deceived_))
deceiveRecord ::
forall e e_ m gullible.
GullibleRecord e e_ m gullible =>
(e_ (DepT e_ m) -> e) ->
gullible (ReaderT e m) ->
gullible (DepT e_ m)
deceiveRecord :: forall e (e_ :: (* -> *) -> *) (m :: * -> *)
(gullible :: (* -> *) -> *).
GullibleRecord e e_ m gullible =>
(e_ (DepT e_ m) -> e)
-> gullible (ReaderT e m) -> gullible (DepT e_ m)
deceiveRecord = forall e (e_ :: (* -> *) -> *) (m :: * -> *)
(gullible :: (* -> *) -> *).
GullibleRecord e e_ m gullible =>
(e_ (DepT e_ m) -> e)
-> gullible (ReaderT e m) -> gullible (DepT e_ m)
_deceiveRecord @e @e_ @m @gullible
component
:: forall e_ m record . (Applicative m, DistributiveRecord e_ m record) =>
(e_ (DepT e_ m) -> record (DepT e_ m)) ->
record (DepT e_ m)
component :: forall (e_ :: (* -> *) -> *) (m :: * -> *)
(record :: (* -> *) -> *).
(Applicative m, DistributiveRecord e_ m record) =>
(e_ (DepT e_ m) -> record (DepT e_ m)) -> record (DepT e_ m)
component e_ (DepT e_ m) -> record (DepT e_ m)
f = forall (e_ :: (* -> *) -> *) (m :: * -> *)
(record :: (* -> *) -> *).
DistributiveRecord e_ m record =>
(e_ (DepT e_ m) -> m (record (DepT e_ m))) -> record (DepT e_ m)
_distribute @e_ @m (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. e_ (DepT e_ m) -> record (DepT e_ m)
f)
type DistributiveRecord :: ((Type -> Type) -> Type) -> (Type -> Type) -> ((Type -> Type) -> Type) -> Constraint
class DistributiveRecord e_ m record where
_distribute :: (e_ (DepT e_ m) -> m (record (DepT e_ m))) -> record (DepT e_ m)
type DistributiveProduct :: ((Type -> Type) -> Type) -> (Type -> Type) -> (k -> Type) -> Constraint
class DistributiveProduct e_ m product where
_distributeProduct :: (e_ (DepT e_ m) -> m (product k)) -> product k
instance
( G.Generic (advised (DepT e_ m)),
G.Rep (advised (DepT e_ m)) ~ G.D1 x (G.C1 y advised_),
DistributiveProduct e_ m advised_,
Functor m
) =>
DistributiveRecord e_ m advised
where
_distribute :: (e_ (DepT e_ m) -> m (advised (DepT e_ m))) -> advised (DepT e_ m)
_distribute e_ (DepT e_ m) -> m (advised (DepT e_ m))
f =
let advised_ :: advised_ Any
advised_ = forall k (e_ :: (* -> *) -> *) (m :: * -> *) (product :: k -> *)
(k :: k).
DistributiveProduct e_ m product =>
(e_ (DepT e_ m) -> m (product k)) -> product k
_distributeProduct @_ @e_ @m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
G.unM1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
G.unM1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
G.from)) e_ (DepT e_ m) -> m (advised (DepT e_ m))
f)
in forall a x. Generic a => Rep a x -> a
G.to (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 advised_ Any
advised_))
instance
( DistributiveProduct e_ m advised_left,
DistributiveProduct e_ m advised_right,
Functor m
) =>
DistributiveProduct e_ m (advised_left G.:*: advised_right)
where
_distributeProduct :: forall (k :: k).
(e_ (DepT e_ m) -> m ((:*:) advised_left advised_right k))
-> (:*:) advised_left advised_right k
_distributeProduct e_ (DepT e_ m) -> m ((:*:) advised_left advised_right k)
f =
forall k (e_ :: (* -> *) -> *) (m :: * -> *) (product :: k -> *)
(k :: k).
DistributiveProduct e_ m product =>
(e_ (DepT e_ m) -> m (product k)) -> product k
_distributeProduct @_ @e_ @m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(advised_left k
l G.:*: advised_right k
_) -> advised_left k
l)) e_ (DepT e_ m) -> m ((:*:) advised_left advised_right k)
f)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
G.:*:
forall k (e_ :: (* -> *) -> *) (m :: * -> *) (product :: k -> *)
(k :: k).
DistributiveProduct e_ m product =>
(e_ (DepT e_ m) -> m (product k)) -> product k
_distributeProduct @_ @e_ @m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(advised_left k
_ G.:*: advised_right k
r) -> advised_right k
r)) e_ (DepT e_ m) -> m ((:*:) advised_left advised_right k)
f)
instance
(
Functor m,
DistributiveSubcomponent (DiscriminateDistributiveSubcomponent advised) e_ m advised
) =>
DistributiveProduct e_ m (G.S1 ( 'G.MetaSel msymbol su ss ds) (G.Rec0 advised))
where
_distributeProduct :: forall (k :: k).
(e_ (DepT e_ m)
-> m (S1 ('MetaSel msymbol su ss ds) (Rec0 advised) k))
-> S1 ('MetaSel msymbol su ss ds) (Rec0 advised) k
_distributeProduct e_ (DepT e_ m)
-> m (S1 ('MetaSel msymbol su ss ds) (Rec0 advised) k)
f = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
G.K1 forall a b. (a -> b) -> a -> b
$ forall (component_type :: RecordComponent) (e_ :: (* -> *) -> *)
(m :: * -> *) sub.
DistributiveSubcomponent component_type e_ m sub =>
(e_ (DepT e_ m) -> m sub) -> sub
_distributeSubcomponent @(DiscriminateDistributiveSubcomponent advised) @e_ @m @advised (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i c (p :: k). K1 i c p -> c
G.unK1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
G.unM1)) e_ (DepT e_ m)
-> m (S1 ('MetaSel msymbol su ss ds) (Rec0 advised) k)
f)
type DistributiveSubcomponent :: RecordComponent -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Constraint
class DistributiveSubcomponent component_type e_ m sub where
_distributeSubcomponent :: (e_ (DepT e_ m) -> m sub) -> sub
instance
(
Functor m,
Multicurryable as e_ m r advised
) =>
DistributiveSubcomponent Terminal e_ m advised
where
_distributeSubcomponent :: (e_ (DepT e_ m) -> m advised) -> advised
_distributeSubcomponent e_ (DepT e_ m) -> m advised
f = forall (as :: [*]) (e_ :: (* -> *) -> *) (m :: * -> *) r curried.
Multicurryable as e_ m r curried =>
(e_ (DepT e_ m) -> m curried) -> curried
askFinalDepT @as @e_ @m @r e_ (DepT e_ m) -> m advised
f
instance
(
Functor m,
DistributiveSubcomponent (DiscriminateDistributiveSubcomponent advised) e_ m advised
) =>
DistributiveSubcomponent IWrapped e_ m (Identity advised)
where
_distributeSubcomponent :: (e_ (DepT e_ m) -> m (Identity advised)) -> Identity advised
_distributeSubcomponent e_ (DepT e_ m) -> m (Identity advised)
f = forall a. a -> Identity a
Identity (forall (component_type :: RecordComponent) (e_ :: (* -> *) -> *)
(m :: * -> *) sub.
DistributiveSubcomponent component_type e_ m sub =>
(e_ (DepT e_ m) -> m sub) -> sub
_distributeSubcomponent @(DiscriminateDistributiveSubcomponent advised) @e_ @m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity) e_ (DepT e_ m) -> m (Identity advised)
f))
instance
(
Functor m,
DistributiveSubcomponent (DiscriminateDistributiveSubcomponent advised) e_ m advised
) =>
DistributiveSubcomponent IWrapped e_ m (I advised)
where
_distributeSubcomponent :: (e_ (DepT e_ m) -> m (I advised)) -> I advised
_distributeSubcomponent e_ (DepT e_ m) -> m (I advised)
f = forall a. a -> I a
I (forall (component_type :: RecordComponent) (e_ :: (* -> *) -> *)
(m :: * -> *) sub.
DistributiveSubcomponent component_type e_ m sub =>
(e_ (DepT e_ m) -> m sub) -> sub
_distributeSubcomponent @(DiscriminateDistributiveSubcomponent advised) @e_ @m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. I a -> a
unI) e_ (DepT e_ m) -> m (I advised)
f))
instance
(DistributiveRecord e_ m subrecord)
=>
DistributiveSubcomponent Recurse e_ m (subrecord (DepT e_ m)) where
_distributeSubcomponent :: (e_ (DepT e_ m) -> m (subrecord (DepT e_ m)))
-> subrecord (DepT e_ m)
_distributeSubcomponent e_ (DepT e_ m) -> m (subrecord (DepT e_ m))
f = forall (e_ :: (* -> *) -> *) (m :: * -> *)
(record :: (* -> *) -> *).
DistributiveRecord e_ m record =>
(e_ (DepT e_ m) -> m (record (DepT e_ m))) -> record (DepT e_ m)
_distribute @e_ @m e_ (DepT e_ m) -> m (subrecord (DepT e_ m))
f
type DiscriminateDistributiveSubcomponent :: Type -> RecordComponent
type family DiscriminateDistributiveSubcomponent c where
DiscriminateDistributiveSubcomponent (a -> b) = Terminal
DiscriminateDistributiveSubcomponent (DepT e_ m x) = Terminal
DiscriminateDistributiveSubcomponent (Identity _) = IWrapped
DiscriminateDistributiveSubcomponent (I _) = IWrapped
DiscriminateDistributiveSubcomponent _ = Recurse
type AdvisedRecord :: (Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> (Type -> Constraint) -> ((Type -> Type) -> Type) -> Constraint
class AdvisedRecord ca e_ m cr advised where
_adviseRecord :: [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised (DepT e_ m) -> advised (DepT e_ m)
type AdvisedProduct :: (Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> (Type -> Constraint) -> (k -> Type) -> Constraint
class AdvisedProduct ca e_ m cr advised_ where
_adviseProduct :: TypeRep -> [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised_ k -> advised_ k
instance
( G.Generic (advised (DepT e_ m)),
G.Rep (advised (DepT e_ m)) ~ G.D1 x (G.C1 y advised_),
Typeable advised,
AdvisedProduct ca e_ m cr advised_
) =>
AdvisedRecord ca e_ m cr advised
where
_adviseRecord :: [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised (DepT e_ m)
-> advised (DepT e_ m)
_adviseRecord [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised (DepT e_ m)
unadvised =
let G.M1 (G.M1 advised_ Any
unadvised_) = forall a x. Generic a => a -> Rep a x
G.from advised (DepT e_ m)
unadvised
advised_ :: advised_ Any
advised_ = forall k (ca :: * -> Constraint) (e_ :: (* -> *) -> *)
(m :: * -> *) (cr :: * -> Constraint) (advised_ :: k -> *)
(k :: k).
AdvisedProduct ca e_ m cr advised_ =>
TypeRep
-> [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised_ k
-> advised_ k
_adviseProduct @_ @ca @e_ @m @cr (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @advised)) [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised_ Any
unadvised_
in forall a x. Generic a => Rep a x -> a
G.to (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 advised_ Any
advised_))
instance
( AdvisedProduct ca e_ m cr advised_left,
AdvisedProduct ca e_ m cr advised_right
) =>
AdvisedProduct ca e_ m cr (advised_left G.:*: advised_right)
where
_adviseProduct :: forall (k :: k).
TypeRep
-> [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> (:*:) advised_left advised_right k
-> (:*:) advised_left advised_right k
_adviseProduct TypeRep
tr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f (advised_left k
unadvised_left G.:*: advised_right k
unadvised_right) = forall k (ca :: * -> Constraint) (e_ :: (* -> *) -> *)
(m :: * -> *) (cr :: * -> Constraint) (advised_ :: k -> *)
(k :: k).
AdvisedProduct ca e_ m cr advised_ =>
TypeRep
-> [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised_ k
-> advised_ k
_adviseProduct @_ @ca @e_ @m @cr TypeRep
tr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised_left k
unadvised_left forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
G.:*: forall k (ca :: * -> Constraint) (e_ :: (* -> *) -> *)
(m :: * -> *) (cr :: * -> Constraint) (advised_ :: k -> *)
(k :: k).
AdvisedProduct ca e_ m cr advised_ =>
TypeRep
-> [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised_ k
-> advised_ k
_adviseProduct @_ @ca @e_ @m @cr TypeRep
tr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised_right k
unadvised_right
type DiscriminateAdvisedComponent :: Type -> RecordComponent
type family DiscriminateAdvisedComponent c where
DiscriminateAdvisedComponent (a -> b) = Terminal
DiscriminateAdvisedComponent (DepT e_ m x) = Terminal
DiscriminateAdvisedComponent (Identity _) = IWrapped
DiscriminateAdvisedComponent (I _) = IWrapped
DiscriminateAdvisedComponent _ = Recurse
type AdvisedComponent :: RecordComponent -> (Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> (Type -> Constraint) -> Type -> Constraint
class AdvisedComponent component_type ca e_ m cr advised where
_adviseComponent :: [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised -> advised
instance
( AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised,
KnownSymbol fieldName
) =>
AdvisedProduct ca e_ m cr (G.S1 ( 'G.MetaSel ( 'Just fieldName) su ss ds) (G.Rec0 advised))
where
_adviseProduct :: forall (k :: k).
TypeRep
-> [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> S1 ('MetaSel ('Just fieldName) su ss ds) (Rec0 advised) k
-> S1 ('MetaSel ('Just fieldName) su ss ds) (Rec0 advised) k
_adviseProduct TypeRep
tr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f (G.M1 (G.K1 advised
advised)) =
let acc' :: [(TypeRep, String)]
acc' = (TypeRep
tr, forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @fieldName)) forall a. a -> [a] -> [a]
: [(TypeRep, String)]
acc
in forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i c (p :: k). c -> K1 i c p
G.K1 (forall (component_type :: RecordComponent) (ca :: * -> Constraint)
(e_ :: (* -> *) -> *) (m :: * -> *) (cr :: * -> Constraint)
advised.
AdvisedComponent component_type ca e_ m cr advised =>
[(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised
-> advised
_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr [(TypeRep, String)]
acc' forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised
advised))
instance
(Multicurryable as e_ m r advised, All ca as, cr r, Monad m) =>
AdvisedComponent Terminal ca e_ m cr advised
where
_adviseComponent :: [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised
-> advised
_adviseComponent [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised
advised = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r (as :: [*]) advisee.
(Multicurryable as e_ m r advisee, All ca as, Monad m) =>
Advice ca e_ m r -> advisee -> advisee
advise @ca @e_ @m (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f (forall a. [a] -> NonEmpty a
N.fromList [(TypeRep, String)]
acc)) advised
advised
instance
AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
AdvisedComponent IWrapped ca e_ m cr (Identity advised)
where
_adviseComponent :: [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> Identity advised
-> Identity advised
_adviseComponent [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f (Identity advised
advised) = forall a. a -> Identity a
Identity (forall (component_type :: RecordComponent) (ca :: * -> Constraint)
(e_ :: (* -> *) -> *) (m :: * -> *) (cr :: * -> Constraint)
advised.
AdvisedComponent component_type ca e_ m cr advised =>
[(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised
-> advised
_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised
advised)
instance
AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
AdvisedComponent IWrapped ca e_ m cr (I advised)
where
_adviseComponent :: [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> I advised
-> I advised
_adviseComponent [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f (I advised
advised) = forall a. a -> I a
I (forall (component_type :: RecordComponent) (ca :: * -> Constraint)
(e_ :: (* -> *) -> *) (m :: * -> *) (cr :: * -> Constraint)
advised.
AdvisedComponent component_type ca e_ m cr advised =>
[(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised
-> advised
_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advised
advised)
instance
AdvisedRecord ca e_ m cr advisable =>
AdvisedComponent Recurse ca e_ m cr (advisable (DepT e_ m))
where
_adviseComponent :: [(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advisable (DepT e_ m)
-> advisable (DepT e_ m)
_adviseComponent [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advisable (DepT e_ m)
advised = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
(cr :: * -> Constraint) (advisable :: (* -> *) -> *).
AdvisedRecord ca e_ m cr advisable =>
[(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advisable (DepT e_ m)
-> advisable (DepT e_ m)
_adviseRecord @ca @e_ @m @cr [(TypeRep, String)]
acc forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r
f advisable (DepT e_ m)
advised
adviseRecord ::
forall ca cr e_ m advised.
AdvisedRecord ca e_ m cr advised =>
(forall r . cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) ->
advised (DepT e_ m) ->
advised (DepT e_ m)
adviseRecord :: forall (ca :: * -> Constraint) (cr :: * -> Constraint)
(e_ :: (* -> *) -> *) (m :: * -> *) (advised :: (* -> *) -> *).
AdvisedRecord ca e_ m cr advised =>
(forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advised (DepT e_ m) -> advised (DepT e_ m)
adviseRecord = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
(cr :: * -> Constraint) (advisable :: (* -> *) -> *).
AdvisedRecord ca e_ m cr advisable =>
[(TypeRep, String)]
-> (forall r.
cr r =>
NonEmpty (TypeRep, String) -> Advice ca e_ m r)
-> advisable (DepT e_ m)
-> advisable (DepT e_ m)
_adviseRecord @ca @e_ @m @cr []
toSimple :: Monad m => Advice ca NilEnv m r -> SA.Advice ca m r
toSimple :: forall (m :: * -> *) (ca :: * -> Constraint) r.
Monad m =>
Advice ca NilEnv m r -> Advice ca m r
toSimple (Advice forall (as :: [*]).
All ca as =>
NP I as
-> DepT NilEnv m (DepT NilEnv m r -> DepT NilEnv m r, NP I as)
f) = forall (ca :: * -> Constraint) (m :: * -> *) r.
(forall (as :: [*]).
All ca as =>
NP I as -> AspectT m (AspectT m r -> AspectT m r, NP I as))
-> Advice ca m r
SA.Advice \NP I as
args -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
(DepT NilEnv m r -> DepT NilEnv m r
withExecution, NP I as
args') <- forall (as :: [*]).
All ca as =>
NP I as
-> DepT NilEnv m (DepT NilEnv m r -> DepT NilEnv m r, NP I as)
f NP I as
args forall (e_ :: (* -> *) -> *) (m :: * -> *) r.
DepT e_ m r -> e_ (DepT e_ m) -> m r
`runDepT` forall (m :: * -> *). NilEnv m
NilEnv
let withExecution' :: AspectT m r -> AspectT m r
withExecution' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (e_ :: (* -> *) -> *) (m :: * -> *) r.
DepT e_ m r -> e_ (DepT e_ m) -> m r
runDepT forall (m :: * -> *). NilEnv m
NilEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. DepT NilEnv m r -> DepT NilEnv m r
withExecution forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. AspectT m r -> m r
SA.runAspectT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AspectT m r -> AspectT m r
withExecution', NP I as
args')
fromSimple :: forall ca e_ m r. Monad m => (e_ (DepT e_ m) -> SA.Advice ca (DepT e_ m) r) -> Advice ca e_ m r
fromSimple :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
(e_ (DepT e_ m) -> Advice ca (DepT e_ m) r) -> Advice ca e_ m r
fromSimple e_ (DepT e_ m) -> Advice ca (DepT e_ m) r
makeAdvice = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(forall (as :: [*]).
All ca as =>
NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as))
-> Advice ca e_ m r
Advice \NP I as
args -> do
e_ (DepT e_ m)
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
case e_ (DepT e_ m) -> Advice ca (DepT e_ m) r
makeAdvice e_ (DepT e_ m)
env of
SA.Advice forall (as :: [*]).
All ca as =>
NP I as
-> AspectT
(DepT e_ m)
(AspectT (DepT e_ m) r -> AspectT (DepT e_ m) r, NP I as)
f -> do
let SA.AspectT DepT e_ m (AspectT (DepT e_ m) r -> AspectT (DepT e_ m) r, NP I as)
argsAction = forall (as :: [*]).
All ca as =>
NP I as
-> AspectT
(DepT e_ m)
(AspectT (DepT e_ m) r -> AspectT (DepT e_ m) r, NP I as)
f NP I as
args
(AspectT (DepT e_ m) r -> AspectT (DepT e_ m) r
tweakExecution, NP I as
args') <- DepT e_ m (AspectT (DepT e_ m) r -> AspectT (DepT e_ m) r, NP I as)
argsAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (coerce :: forall a b. Coercible a b => a -> b
coerce AspectT (DepT e_ m) r -> AspectT (DepT e_ m) r
tweakExecution, NP I as
args')
fromSimple_ :: forall ca e_ m r. Monad m => SA.Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ Advice ca (DepT e_ m) r
advice = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
(e_ (DepT e_ m) -> Advice ca (DepT e_ m) r) -> Advice ca e_ m r
fromSimple \e_ (DepT e_ m)
_ -> Advice ca (DepT e_ m) r
advice