{-# LANGUAGE UndecidableInstances #-}

module Mensam.Client.Application.Event where

import Mensam.Client.Application.Event.Class
import Mensam.Client.UI.Brick.Events

import Brick.BChan
import Control.Monad.Logger.CallStack
import Control.Monad.Trans
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Reader
import Data.Kind

type EventT :: (Type -> Type) -> Type -> Type
newtype EventT m a = MkEventT {forall (m :: * -> *) a.
EventT m a -> ReaderT (BChan ClientEvent) m a
unEventT :: ReaderT (BChan ClientEvent) m a}
  deriving newtype (Functor (EventT m)
Functor (EventT m) =>
(forall a. a -> EventT m a)
-> (forall a b. EventT m (a -> b) -> EventT m a -> EventT m b)
-> (forall a b c.
    (a -> b -> c) -> EventT m a -> EventT m b -> EventT m c)
-> (forall a b. EventT m a -> EventT m b -> EventT m b)
-> (forall a b. EventT m a -> EventT m b -> EventT m a)
-> Applicative (EventT m)
forall a. a -> EventT m a
forall a b. EventT m a -> EventT m b -> EventT m a
forall a b. EventT m a -> EventT m b -> EventT m b
forall a b. EventT m (a -> b) -> EventT m a -> EventT m b
forall a b c.
(a -> b -> c) -> EventT m a -> EventT m b -> EventT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (EventT m)
forall (m :: * -> *) a. Applicative m => a -> EventT m a
forall (m :: * -> *) a b.
Applicative m =>
EventT m a -> EventT m b -> EventT m a
forall (m :: * -> *) a b.
Applicative m =>
EventT m a -> EventT m b -> EventT m b
forall (m :: * -> *) a b.
Applicative m =>
EventT m (a -> b) -> EventT m a -> EventT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> EventT m a -> EventT m b -> EventT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> EventT m a
pure :: forall a. a -> EventT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
EventT m (a -> b) -> EventT m a -> EventT m b
<*> :: forall a b. EventT m (a -> b) -> EventT m a -> EventT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> EventT m a -> EventT m b -> EventT m c
liftA2 :: forall a b c.
(a -> b -> c) -> EventT m a -> EventT m b -> EventT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
EventT m a -> EventT m b -> EventT m b
*> :: forall a b. EventT m a -> EventT m b -> EventT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
EventT m a -> EventT m b -> EventT m a
<* :: forall a b. EventT m a -> EventT m b -> EventT m a
Applicative, (forall a b. (a -> b) -> EventT m a -> EventT m b)
-> (forall a b. a -> EventT m b -> EventT m a)
-> Functor (EventT m)
forall a b. a -> EventT m b -> EventT m a
forall a b. (a -> b) -> EventT m a -> EventT m b
forall (m :: * -> *) a b.
Functor m =>
a -> EventT m b -> EventT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EventT m a -> EventT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EventT m a -> EventT m b
fmap :: forall a b. (a -> b) -> EventT m a -> EventT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> EventT m b -> EventT m a
<$ :: forall a b. a -> EventT m b -> EventT m a
Functor, Applicative (EventT m)
Applicative (EventT m) =>
(forall a b. EventT m a -> (a -> EventT m b) -> EventT m b)
-> (forall a b. EventT m a -> EventT m b -> EventT m b)
-> (forall a. a -> EventT m a)
-> Monad (EventT m)
forall a. a -> EventT m a
forall a b. EventT m a -> EventT m b -> EventT m b
forall a b. EventT m a -> (a -> EventT m b) -> EventT m b
forall (m :: * -> *). Monad m => Applicative (EventT m)
forall (m :: * -> *) a. Monad m => a -> EventT m a
forall (m :: * -> *) a b.
Monad m =>
EventT m a -> EventT m b -> EventT m b
forall (m :: * -> *) a b.
Monad m =>
EventT m a -> (a -> EventT m b) -> EventT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
EventT m a -> (a -> EventT m b) -> EventT m b
>>= :: forall a b. EventT m a -> (a -> EventT m b) -> EventT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
EventT m a -> EventT m b -> EventT m b
>> :: forall a b. EventT m a -> EventT m b -> EventT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> EventT m a
return :: forall a. a -> EventT m a
Monad)
  deriving newtype ((forall (m :: * -> *). Monad m => Monad (EventT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> EventT m a)
-> MonadTrans EventT
forall (m :: * -> *). Monad m => Monad (EventT m)
forall (m :: * -> *) a. Monad m => m a -> EventT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> EventT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> EventT m a
MonadTrans, MonadTrans EventT
MonadTrans EventT =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run EventT -> m a) -> EventT m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT EventT a) -> EventT m a)
-> MonadTransControl EventT
forall (m :: * -> *) a. Monad m => m (StT EventT a) -> EventT m a
forall (m :: * -> *) a.
Monad m =>
(Run EventT -> m a) -> EventT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run EventT -> m a) -> EventT m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run EventT -> m a) -> EventT m a
$crestoreT :: forall (m :: * -> *) a. Monad m => m (StT EventT a) -> EventT m a
restoreT :: forall (m :: * -> *) a. Monad m => m (StT EventT a) -> EventT m a
MonadTransControl, MonadTransControl EventT
MonadTransControl EventT =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. EventT m x -> m x) -> m a) -> EventT m a)
-> MonadTransControlIdentity EventT
forall (m :: * -> *) a.
Monad m =>
((forall x. EventT m x -> m x) -> m a) -> EventT m a
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. t m x -> m x) -> m a) -> t m a)
-> MonadTransControlIdentity t
$cliftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. EventT m x -> m x) -> m a) -> EventT m a
liftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. EventT m x -> m x) -> m a) -> EventT m a
MonadTransControlIdentity)

instance MonadIO m => MonadEvent (EventT m) where
  sendEvent :: ClientEvent -> EventT m ()
sendEvent ClientEvent
event = ReaderT (BChan ClientEvent) m () -> EventT m ()
forall (m :: * -> *) a.
ReaderT (BChan ClientEvent) m a -> EventT m a
MkEventT (ReaderT (BChan ClientEvent) m () -> EventT m ())
-> ReaderT (BChan ClientEvent) m () -> EventT m ()
forall a b. (a -> b) -> a -> b
$ do
    BChan ClientEvent
chan <- ReaderT (BChan ClientEvent) m (BChan ClientEvent)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    IO () -> ReaderT (BChan ClientEvent) m ()
forall a. IO a -> ReaderT (BChan ClientEvent) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (BChan ClientEvent) m ())
-> IO () -> ReaderT (BChan ClientEvent) m ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent -> ClientEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan ClientEvent
chan ClientEvent
event
  eventChannel :: EventT m (BChan ClientEvent)
eventChannel = ReaderT (BChan ClientEvent) m (BChan ClientEvent)
-> EventT m (BChan ClientEvent)
forall (m :: * -> *) a.
ReaderT (BChan ClientEvent) m a -> EventT m a
MkEventT ReaderT (BChan ClientEvent) m (BChan ClientEvent)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

deriving via
  EventT ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
    MonadIO (t2 m) => MonadEvent (ComposeT EventT t2 m)

runEventT :: EventT m a -> BChan ClientEvent -> m a
runEventT :: forall (m :: * -> *) a. EventT m a -> BChan ClientEvent -> m a
runEventT = ReaderT (BChan ClientEvent) m a -> BChan ClientEvent -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT (BChan ClientEvent) m a -> BChan ClientEvent -> m a)
-> (EventT m a -> ReaderT (BChan ClientEvent) m a)
-> EventT m a
-> BChan ClientEvent
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventT m a -> ReaderT (BChan ClientEvent) m a
forall (m :: * -> *) a.
EventT m a -> ReaderT (BChan ClientEvent) m a
unEventT

runAppEventT ::
  (MonadIO m, MonadLogger m) =>
  EventT m a ->
  m a
runAppEventT :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m) =>
EventT m a -> m a
runAppEventT EventT m a
tma = do
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Creating new event channel."
  BChan ClientEvent
chan <- IO (BChan ClientEvent) -> m (BChan ClientEvent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (BChan ClientEvent) -> m (BChan ClientEvent))
-> IO (BChan ClientEvent) -> m (BChan ClientEvent)
forall a b. (a -> b) -> a -> b
$ Int -> IO (BChan ClientEvent)
forall a. Int -> IO (BChan a)
newBChan Int
10
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created new event channel."
  EventT m a -> BChan ClientEvent -> m a
forall (m :: * -> *) a. EventT m a -> BChan ClientEvent -> m a
runEventT EventT m a
tma BChan ClientEvent
chan