{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Observe.Event.Crash
( withScheduleCrash,
ScheduleCrash,
DoCrash,
hoistScheduleCrash,
Crashing (..),
renderCrashing,
)
where
import Control.Monad.Catch
import Data.Void
import Observe.Event
import Observe.Event.BackendModification
import Observe.Event.Render.JSON
withScheduleCrash ::
(MonadMask m) =>
EventBackend m r Crashing ->
DoCrash m ->
(ScheduleCrash m r -> m a) ->
m a
withScheduleCrash :: forall (m :: * -> *) r a.
MonadMask m =>
EventBackend m r Crashing
-> DoCrash m -> (ScheduleCrash m r -> m a) -> m a
withScheduleCrash EventBackend m r Crashing
backend DoCrash m
crash ScheduleCrash m r -> m a
go =
ScheduleCrash m r -> m a
go forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
(forall r'. EventBackendModifiers r r' -> m ())
-> ScheduleCrash m r
ScheduleCrash \EventBackendModifiers r r'
mods ->
let backend' :: EventBackend m r' Crashing
backend' = forall (m :: * -> *) r r' (s :: * -> *).
Monad m =>
EventBackendModifiers r r'
-> EventBackend m r s -> EventBackend m r' s
modifyEventBackend EventBackendModifiers r r'
mods EventBackend m r Crashing
backend
in forall (m :: * -> *) r (s :: * -> *) a.
MonadMask m =>
EventBackend m r s
-> forall f. s f -> (Event m r s f -> m a) -> m a
withEvent EventBackend m r' Crashing
backend' Crashing Void
Crashing forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const DoCrash m
crash
newtype ScheduleCrash m r = ScheduleCrash {forall (m :: * -> *) r.
ScheduleCrash m r -> forall r'. EventBackendModifiers r r' -> m ()
schedule :: forall r'. EventBackendModifiers r r' -> m ()}
type DoCrash m = m ()
hoistScheduleCrash ::
(forall x. f x -> g x) ->
ScheduleCrash f r ->
ScheduleCrash g r
hoistScheduleCrash :: forall (f :: * -> *) (g :: * -> *) r.
(forall x. f x -> g x) -> ScheduleCrash f r -> ScheduleCrash g r
hoistScheduleCrash forall x. f x -> g x
nt (ScheduleCrash {forall r'. EventBackendModifiers r r' -> f ()
schedule :: forall r'. EventBackendModifiers r r' -> f ()
schedule :: forall (m :: * -> *) r.
ScheduleCrash m r -> forall r'. EventBackendModifiers r r' -> m ()
..}) = forall (m :: * -> *) r.
(forall r'. EventBackendModifiers r r' -> m ())
-> ScheduleCrash m r
ScheduleCrash forall a b. (a -> b) -> a -> b
$ forall x. f x -> g x
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r'. EventBackendModifiers r r' -> f ()
schedule
data Crashing f where
Crashing :: Crashing Void
renderCrashing :: RenderSelectorJSON Crashing
renderCrashing :: RenderSelectorJSON Crashing
renderCrashing Crashing f
Crashing = (Key
"crashing", forall a. Void -> a
absurd)