{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Navi.Env.Core
(
HasEvents (..),
HasLogEnv (..),
HasNoteQueue (..),
sendNoteQueue,
TopField (..),
CoreEnvField (..),
Env (..),
)
where
import Navi.Config.Phase (ConfigPhase (ConfigPhaseEnv))
import Navi.Config.Types (NoteSystem)
import Navi.Data.NaviLog (LogEnv)
import Navi.Data.NaviNote (NaviNote)
import Navi.Event.Types (AnyEvent)
import Navi.Prelude
data Env = MkEnv
{ Env -> NonEmpty AnyEvent
events :: NonEmpty AnyEvent,
Env -> Maybe LogEnv
logEnv :: Maybe LogEnv,
Env -> TBQueue NaviNote
noteQueue :: TBQueue NaviNote,
Env -> NoteSystem 'ConfigPhaseEnv
notifySystem :: NoteSystem ConfigPhaseEnv
}
makeFieldLabelsNoPrefix ''Env
deriving via (TopField Env) instance HasEvents Env
deriving via (TopField Env) instance HasLogEnv Env
deriving via (TopField Env) instance HasNoteQueue Env
type TopField :: Type -> Type
newtype TopField a = MkTopField a
type CoreEnvField :: Type -> Type
newtype CoreEnvField a = MkCoreEnvField a
class HasEvents env where
getEvents :: env -> NonEmpty AnyEvent
class HasLogEnv env where
getLogEnv :: env -> Maybe LogEnv
class HasNoteQueue env where
getNoteQueue :: env -> TBQueue NaviNote
instance
(Is k A_Getter, LabelOptic' "events" k a (NonEmpty AnyEvent)) =>
HasEvents (TopField a)
where
getEvents :: TopField a -> NonEmpty AnyEvent
getEvents (MkTopField a
x) = Optic' k NoIx a (NonEmpty AnyEvent) -> a -> NonEmpty AnyEvent
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx a (NonEmpty AnyEvent)
#events a
x
instance
(Is k A_Getter, LabelOptic' "coreEnv" k a Env) =>
HasEvents (CoreEnvField a)
where
getEvents :: CoreEnvField a -> NonEmpty AnyEvent
getEvents (MkCoreEnvField a
x) = Env -> NonEmpty AnyEvent
forall (env :: OpticKind).
HasEvents env =>
env -> NonEmpty AnyEvent
getEvents (Env -> NonEmpty AnyEvent) -> Env -> NonEmpty AnyEvent
forall a b. (a -> b) -> a -> b
$ Optic' k NoIx a Env -> a -> Env
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx a Env
#coreEnv a
x
instance
(Is k A_Getter, LabelOptic' "logEnv" k a (Maybe LogEnv)) =>
HasLogEnv (TopField a)
where
getLogEnv :: TopField a -> Maybe LogEnv
getLogEnv (MkTopField a
x) = Optic' k NoIx a (Maybe LogEnv) -> a -> Maybe LogEnv
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx a (Maybe LogEnv)
#logEnv a
x
instance
(Is k A_Getter, LabelOptic' "coreEnv" k a Env) =>
HasLogEnv (CoreEnvField a)
where
getLogEnv :: CoreEnvField a -> Maybe LogEnv
getLogEnv (MkCoreEnvField a
x) = Env -> Maybe LogEnv
forall (env :: OpticKind). HasLogEnv env => env -> Maybe LogEnv
getLogEnv (Env -> Maybe LogEnv) -> Env -> Maybe LogEnv
forall a b. (a -> b) -> a -> b
$ Optic' k NoIx a Env -> a -> Env
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx a Env
#coreEnv a
x
instance
(Is k A_Getter, LabelOptic' "noteQueue" k a (TBQueue NaviNote)) =>
HasNoteQueue (TopField a)
where
getNoteQueue :: TopField a -> TBQueue NaviNote
getNoteQueue (MkTopField a
x) = Optic' k NoIx a (TBQueue NaviNote) -> a -> TBQueue NaviNote
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx a (TBQueue NaviNote)
#noteQueue a
x
instance
(Is k A_Getter, LabelOptic' "coreEnv" k a Env) =>
HasNoteQueue (CoreEnvField a)
where
getNoteQueue :: CoreEnvField a -> TBQueue NaviNote
getNoteQueue (MkCoreEnvField a
x) = Env -> TBQueue NaviNote
forall (env :: OpticKind).
HasNoteQueue env =>
env -> TBQueue NaviNote
getNoteQueue (Env -> TBQueue NaviNote) -> Env -> TBQueue NaviNote
forall a b. (a -> b) -> a -> b
$ Optic' k NoIx a Env -> a -> Env
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx a Env
#coreEnv a
x
instance
( k ~ A_Lens,
x ~ Namespace,
y ~ Namespace
) =>
LabelOptic "namespace" k Env Env x y
where
labelOptic :: Optic k NoIx Env Env x y
labelOptic =
LensVL Env Env x y -> Lens Env Env x y
forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
LensVL s t a b -> Lens s t a b
lensVL (LensVL Env Env x y -> Lens Env Env x y)
-> LensVL Env Env x y -> Lens Env Env x y
forall a b. (a -> b) -> a -> b
$ \x -> f y
f (MkEnv NonEmpty AnyEvent
a1 Maybe LogEnv
a2 TBQueue NaviNote
a3 NoteSystem 'ConfigPhaseEnv
a4) ->
(y -> Env) -> f y -> f Env
forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> f a -> f b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap
(\y
b -> NonEmpty AnyEvent
-> Maybe LogEnv
-> TBQueue NaviNote
-> NoteSystem 'ConfigPhaseEnv
-> Env
MkEnv NonEmpty AnyEvent
a1 (Optic
An_AffineTraversal NoIx (Maybe LogEnv) (Maybe LogEnv) Namespace y
-> y -> Maybe LogEnv -> Maybe LogEnv
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set' (Prism (Maybe LogEnv) (Maybe LogEnv) LogEnv LogEnv
forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just Prism (Maybe LogEnv) (Maybe LogEnv) LogEnv LogEnv
-> Optic A_Lens NoIx LogEnv LogEnv Namespace y
-> Optic
An_AffineTraversal NoIx (Maybe LogEnv) (Maybe LogEnv) Namespace y
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx LogEnv LogEnv Namespace y
#logNamespace) y
b Maybe LogEnv
a2) TBQueue NaviNote
a3 NoteSystem 'ConfigPhaseEnv
a4)
(x -> f y
f (x -> f y) -> x -> f y
forall a b. (a -> b) -> a -> b
$ x -> Maybe x -> x
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe x
"" (Maybe LogEnv
a2 Maybe LogEnv
-> Optic' An_AffineTraversal NoIx (Maybe LogEnv) x -> Maybe x
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
(a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Prism (Maybe LogEnv) (Maybe LogEnv) LogEnv LogEnv
forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just Prism (Maybe LogEnv) (Maybe LogEnv) LogEnv LogEnv
-> Optic A_Lens NoIx LogEnv LogEnv x x
-> Optic' An_AffineTraversal NoIx (Maybe LogEnv) x
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx LogEnv LogEnv x x
#logNamespace))
{-# INLINE labelOptic #-}
sendNoteQueue ::
( HasCallStack,
HasNoteQueue env,
MonadReader env m,
MonadSTM m
) =>
NaviNote ->
m ()
sendNoteQueue :: forall (env :: OpticKind) (m :: OpticKind -> OpticKind).
(HasCallStack, HasNoteQueue env, MonadReader env m, MonadSTM m) =>
NaviNote -> m ()
sendNoteQueue NaviNote
naviNote =
(env -> TBQueue NaviNote) -> m (TBQueue NaviNote)
forall (r :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadReader r m =>
(r -> a) -> m a
asks env -> TBQueue NaviNote
forall (env :: OpticKind).
HasNoteQueue env =>
env -> TBQueue NaviNote
getNoteQueue m (TBQueue NaviNote) -> (TBQueue NaviNote -> m ()) -> m ()
forall (a :: OpticKind) (b :: OpticKind). m a -> (a -> m b) -> m b
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= (TBQueue NaviNote -> NaviNote -> m ()
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(HasCallStack, MonadSTM m) =>
TBQueue a -> a -> m ()
`writeTBQueueA` NaviNote
naviNote)
{-# INLINEABLE sendNoteQueue #-}