{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Galley.Monad where
import Bilge.IO hiding (options)
import Bilge.RPC
import Cassandra
import Control.Lens
import Control.Monad.Catch
import Galley.Env
import Imports hiding (log)
import Polysemy
import Polysemy.Input
import Prometheus
import System.Logger
import System.Logger.Class qualified as LC
newtype App a = App {forall a. App a -> ReaderT Env IO a
unApp :: ReaderT Env IO a}
deriving
( (forall a b. (a -> b) -> App a -> App b)
-> (forall a b. a -> App b -> App a) -> Functor App
forall a b. a -> App b -> App a
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> App a -> App b
fmap :: forall a b. (a -> b) -> App a -> App b
$c<$ :: forall a b. a -> App b -> App a
<$ :: forall a b. a -> App b -> App a
Functor,
Functor App
Functor App =>
(forall a. a -> App a)
-> (forall a b. App (a -> b) -> App a -> App b)
-> (forall a b c. (a -> b -> c) -> App a -> App b -> App c)
-> (forall a b. App a -> App b -> App b)
-> (forall a b. App a -> App b -> App a)
-> Applicative App
forall a. a -> App a
forall a b. App a -> App b -> App a
forall a b. App a -> App b -> App b
forall a b. App (a -> b) -> App a -> App b
forall a b c. (a -> b -> c) -> App a -> App b -> App 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
$cpure :: forall a. a -> App a
pure :: forall a. a -> App a
$c<*> :: forall a b. App (a -> b) -> App a -> App b
<*> :: forall a b. App (a -> b) -> App a -> App b
$cliftA2 :: forall a b c. (a -> b -> c) -> App a -> App b -> App c
liftA2 :: forall a b c. (a -> b -> c) -> App a -> App b -> App c
$c*> :: forall a b. App a -> App b -> App b
*> :: forall a b. App a -> App b -> App b
$c<* :: forall a b. App a -> App b -> App a
<* :: forall a b. App a -> App b -> App a
Applicative,
Applicative App
Applicative App =>
(forall a b. App a -> (a -> App b) -> App b)
-> (forall a b. App a -> App b -> App b)
-> (forall a. a -> App a)
-> Monad App
forall a. a -> App a
forall a b. App a -> App b -> App b
forall a b. App a -> (a -> App b) -> App 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 a b. App a -> (a -> App b) -> App b
>>= :: forall a b. App a -> (a -> App b) -> App b
$c>> :: forall a b. App a -> App b -> App b
>> :: forall a b. App a -> App b -> App b
$creturn :: forall a. a -> App a
return :: forall a. a -> App a
Monad,
MonadThrow App
MonadThrow App =>
(forall e a.
(HasCallStack, Exception e) =>
App a -> (e -> App a) -> App a)
-> MonadCatch App
forall e a.
(HasCallStack, Exception e) =>
App a -> (e -> App a) -> App a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
App a -> (e -> App a) -> App a
catch :: forall e a.
(HasCallStack, Exception e) =>
App a -> (e -> App a) -> App a
MonadCatch,
Monad App
Monad App => (forall a. IO a -> App a) -> MonadIO App
forall a. IO a -> App a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> App a
liftIO :: forall a. IO a -> App a
MonadIO,
MonadCatch App
MonadCatch App =>
(forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b)
-> (forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b)
-> (forall a b c.
HasCallStack =>
App a -> (a -> ExitCase b -> App c) -> (a -> App b) -> App (b, c))
-> MonadMask App
forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b
forall a b c.
HasCallStack =>
App a -> (a -> ExitCase b -> App c) -> (a -> App b) -> App (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b
mask :: forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. App a -> App a) -> App b) -> App b
$cgeneralBracket :: forall a b c.
HasCallStack =>
App a -> (a -> ExitCase b -> App c) -> (a -> App b) -> App (b, c)
generalBracket :: forall a b c.
HasCallStack =>
App a -> (a -> ExitCase b -> App c) -> (a -> App b) -> App (b, c)
MonadMask,
MonadReader Env,
Monad App
Monad App =>
(forall e a. (HasCallStack, Exception e) => e -> App a)
-> MonadThrow App
forall e a. (HasCallStack, Exception e) => e -> App a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> App a
throwM :: forall e a. (HasCallStack, Exception e) => e -> App a
MonadThrow,
MonadIO App
MonadIO App =>
(forall b. ((forall a. App a -> IO a) -> IO b) -> App b)
-> MonadUnliftIO App
forall b. ((forall a. App a -> IO a) -> IO b) -> App b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. App a -> IO a) -> IO b) -> App b
withRunInIO :: forall b. ((forall a. App a -> IO a) -> IO b) -> App b
MonadUnliftIO,
Monad App
Monad App => (IO () -> App ()) -> MonadMonitor App
IO () -> App ()
forall (m :: * -> *). Monad m => (IO () -> m ()) -> MonadMonitor m
$cdoIO :: IO () -> App ()
doIO :: IO () -> App ()
MonadMonitor
)
runApp :: Env -> App a -> IO a
runApp :: forall a. Env -> App a -> IO a
runApp Env
env = (ReaderT Env IO a -> Env -> IO a)
-> Env -> ReaderT Env IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Env IO a -> Env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Env
env (ReaderT Env IO a -> IO a)
-> (App a -> ReaderT Env IO a) -> App a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App a -> ReaderT Env IO a
forall a. App a -> ReaderT Env IO a
unApp
instance HasRequestId App where
getRequestId :: App RequestId
getRequestId = ReaderT Env IO RequestId -> App RequestId
forall a. ReaderT Env IO a -> App a
App (ReaderT Env IO RequestId -> App RequestId)
-> ReaderT Env IO RequestId -> App RequestId
forall a b. (a -> b) -> a -> b
$ Getting RequestId Env RequestId -> ReaderT Env IO RequestId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting RequestId Env RequestId
Lens' Env RequestId
reqId
instance MonadHttp App where
handleRequestWithCont :: forall a. Request -> (Response BodyReader -> IO a) -> App a
handleRequestWithCont Request
req Response BodyReader -> IO a
h = do
Manager
m <- Getting Manager Env Manager -> App Manager
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Manager Env Manager
Lens' Env Manager
manager
IO a -> App a
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> App a) -> IO a -> App a
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> (Response BodyReader -> IO a) -> IO a
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
req Manager
m Response BodyReader -> IO a
h
instance MonadClient App where
liftClient :: forall a. Client a -> App a
liftClient Client a
m = do
ClientState
cs <- Getting ClientState Env ClientState -> App ClientState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ClientState Env ClientState
Lens' Env ClientState
cstate
IO a -> App a
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> App a) -> IO a -> App a
forall a b. (a -> b) -> a -> b
$ ClientState -> Client a -> IO a
forall (m :: * -> *) a. MonadIO m => ClientState -> Client a -> m a
runClient ClientState
cs Client a
m
localState :: forall a. (ClientState -> ClientState) -> App a -> App a
localState ClientState -> ClientState
f = ASetter Env Env ClientState ClientState
-> (ClientState -> ClientState) -> App a -> App a
forall s (m :: * -> *) a b r.
MonadReader s m =>
ASetter s s a b -> (a -> b) -> m r -> m r
locally ASetter Env Env ClientState ClientState
Lens' Env ClientState
cstate ClientState -> ClientState
f
instance LC.MonadLogger App where
log :: Level -> (Msg -> Msg) -> App ()
log Level
lvl Msg -> Msg
m = do
Env
env <- App Env
forall r (m :: * -> *). MonadReader r m => m r
ask
Logger -> Level -> (Msg -> Msg) -> App ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
log (Env
env Env -> Getting Logger Env Logger -> Logger
forall s a. s -> Getting a s a -> a
^. Getting Logger Env Logger
Lens' Env Logger
applog) Level
lvl (RequestId -> Msg -> Msg
reqIdMsg (Env
env Env -> Getting RequestId Env RequestId -> RequestId
forall s a. s -> Getting a s a -> a
^. Getting RequestId Env RequestId
Lens' Env RequestId
reqId) (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Msg
m)
embedApp ::
( Member (Embed IO) r,
Member (Input Env) r
) =>
App a ->
Sem r a
embedApp :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp App a
action = do
Env
env <- Sem r Env
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
IO a -> Sem r a
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO a -> Sem r a) -> IO a -> Sem r a
forall a b. (a -> b) -> a -> b
$ Env -> App a -> IO a
forall a. Env -> App a -> IO a
runApp Env
env App a
action