{-# LANGUAGE TemplateHaskell #-}
module Navi.Event
(
Event (..),
AnyEvent (..),
runEvent,
EventSuccess (..),
EventError (..),
RepeatEvent (..),
ErrorNote (..),
blockRepeat,
blockErr,
updatePrevTrigger,
)
where
import Effects.LoggerNamespace (MonadLoggerNamespace (..), addNamespace)
import Navi.Effects (MonadSystemInfo (..))
import Navi.Event.Types
( AnyEvent (..),
ErrorNote (..),
Event (..),
EventError (..),
EventSuccess (..),
RepeatEvent (..),
)
import Navi.Prelude
runEvent ::
( HasCallStack,
MonadLoggerNamespace m,
MonadSTM m,
MonadSystemInfo m,
Show result
) =>
Event result ->
m (EventSuccess result)
runEvent :: forall (m :: Type -> Type) result.
(HasCallStack, MonadLoggerNamespace m, MonadSTM m,
MonadSystemInfo m, Show result) =>
Event result -> m (EventSuccess result)
runEvent Event result
event = forall (m :: Type -> Type) a.
MonadLoggerNamespace m =>
Text -> m a -> m a
addNamespace Text
"runEvent" forall a b. (a -> b) -> a -> b
$ do
result
result <- forall (m :: Type -> Type) result.
(MonadSystemInfo m, HasCallStack) =>
ServiceType result -> m result
query forall a b. (a -> b) -> a -> b
$ Event result
event forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "serviceType" a => a
#serviceType
$(logInfo) (Text
"Shell returned: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt result
result)
pure $
MkEventSuccess
{ result
$sel:result:MkEventSuccess :: result
result :: result
result,
$sel:repeatEvent:MkEventSuccess :: RepeatEvent result
repeatEvent = Event result
event forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "repeatEvent" a => a
#repeatEvent,
$sel:raiseAlert:MkEventSuccess :: result -> Maybe NaviNote
raiseAlert = Event result
event forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "raiseAlert" a => a
#raiseAlert
}
{-# INLINEABLE runEvent #-}
blockRepeat ::
( Eq a,
MonadLoggerNamespace m,
MonadIORef m,
Show a
) =>
RepeatEvent a ->
a ->
m Bool
blockRepeat :: forall a (m :: Type -> Type).
(Eq a, MonadLoggerNamespace m, MonadIORef m, Show a) =>
RepeatEvent a -> a -> m Bool
blockRepeat RepeatEvent a
repeatEvent a
newVal = forall (m :: Type -> Type) a.
MonadLoggerNamespace m =>
Text -> m a -> m a
addNamespace Text
"blockRepeat" forall a b. (a -> b) -> a -> b
$ do
case RepeatEvent a
repeatEvent of
RepeatEvent a
AllowRepeats -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False
NoRepeats IORef (Maybe a)
prevRef -> do
Maybe a
prevVal <- forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe a)
prevRef
$(logDebug) (Text
"Previous value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Maybe a
prevVal)
$(logDebug) (Text
"New value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
newVal)
if Maybe a
prevVal forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just a
newVal
then
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True
else
do
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe a)
prevRef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
newVal
pure Bool
False
{-# INLINEABLE blockRepeat #-}
blockErr ::
( MonadLoggerNamespace m,
MonadIORef m
) =>
ErrorNote ->
m Bool
blockErr :: forall (m :: Type -> Type).
(MonadLoggerNamespace m, MonadIORef m) =>
ErrorNote -> m Bool
blockErr ErrorNote
errorEvent = forall (m :: Type -> Type) a.
MonadLoggerNamespace m =>
Text -> m a -> m a
addNamespace Text
"blockErr" forall a b. (a -> b) -> a -> b
$ do
case ErrorNote
errorEvent of
ErrorNote
NoErrNote -> do
$(logDebug) Text
"Error notes are off"
pure Bool
True
AllowErrNote RepeatEvent ()
AllowRepeats -> do
$(logDebug) Text
"Error notes are on and repeats allowed"
pure Bool
False
AllowErrNote (NoRepeats IORef (Maybe ())
ref) -> do
Maybe ()
prevErr <- forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe ())
ref
case Maybe ()
prevErr of
Just () -> do
$(logDebug) Text
"Already sent error"
pure Bool
True
Maybe ()
Nothing -> do
$(logDebug) Text
"Send error"
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe ())
ref forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ()
pure Bool
False
{-# INLINEABLE blockErr #-}
updatePrevTrigger :: (Eq a, MonadIORef m) => RepeatEvent a -> a -> m ()
updatePrevTrigger :: forall a (m :: Type -> Type).
(Eq a, MonadIORef m) =>
RepeatEvent a -> a -> m ()
updatePrevTrigger RepeatEvent a
repeatEvent a
newVal =
case RepeatEvent a
repeatEvent of
NoRepeats IORef (Maybe a)
ref -> do
Maybe a
val <- forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe a)
ref
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe a
val forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just a
newVal) forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe a)
ref forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
newVal
RepeatEvent a
_ -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE updatePrevTrigger #-}