module Freckle.App
( runApp
, setLineBuffering
, AppT (..)
, runAppT
, module Blammo.Logging
, module Control.Monad.Reader
) where
import Freckle.App.Prelude
import Blammo.Logging
import Control.Lens (view)
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.IO.Unlift (MonadUnliftIO (..))
import Control.Monad.Primitive (PrimMonad (..))
import Control.Monad.Reader
import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
import Freckle.App.Database
import qualified Freckle.App.Database.XRay as XRay
import Freckle.App.OpenTelemetry
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
runApp
:: HasLogger app
=> (forall b. (app -> IO b) -> IO b)
-> AppT app IO a
-> IO a
runApp :: forall app a.
HasLogger app =>
(forall b. (app -> IO b) -> IO b) -> AppT app IO a -> IO a
runApp forall b. (app -> IO b) -> IO b
loadApp AppT app IO a
action = do
forall (m :: * -> *). MonadIO m => m ()
setLineBuffering
forall b. (app -> IO b) -> IO b
loadApp forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) app a.
(MonadUnliftIO m, HasLogger app) =>
AppT app m a -> app -> m a
runAppT AppT app IO a
action
setLineBuffering :: MonadIO m => m ()
setLineBuffering :: forall (m :: * -> *). MonadIO m => m ()
setLineBuffering = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
LineBuffering
newtype AppT app m a = AppT
{ forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
unAppT :: ReaderT app (LoggingT (ResourceT m)) a
}
deriving newtype
( forall a b. a -> AppT app m b -> AppT app m a
forall a b. (a -> b) -> AppT app m a -> AppT app m b
forall app (m :: * -> *) a b.
Functor m =>
a -> AppT app m b -> AppT app m a
forall app (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT app m a -> AppT app m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AppT app m b -> AppT app m a
$c<$ :: forall app (m :: * -> *) a b.
Functor m =>
a -> AppT app m b -> AppT app m a
fmap :: forall a b. (a -> b) -> AppT app m a -> AppT app m b
$cfmap :: forall app (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT app m a -> AppT app m b
Functor
, forall a. a -> AppT app m a
forall a b. AppT app m a -> AppT app m b -> AppT app m a
forall a b. AppT app m a -> AppT app m b -> AppT app m b
forall a b. AppT app m (a -> b) -> AppT app m a -> AppT app m b
forall a b c.
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
forall {app} {m :: * -> *}. Applicative m => Functor (AppT app m)
forall app (m :: * -> *) a. Applicative m => a -> AppT app m a
forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m a
forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m b
forall app (m :: * -> *) a b.
Applicative m =>
AppT app m (a -> b) -> AppT app m a -> AppT app m b
forall app (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app 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 a b. AppT app m a -> AppT app m b -> AppT app m a
$c<* :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m a
*> :: forall a b. AppT app m a -> AppT app m b -> AppT app m b
$c*> :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m b
liftA2 :: forall a b c.
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
$cliftA2 :: forall app (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
<*> :: forall a b. AppT app m (a -> b) -> AppT app m a -> AppT app m b
$c<*> :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m (a -> b) -> AppT app m a -> AppT app m b
pure :: forall a. a -> AppT app m a
$cpure :: forall app (m :: * -> *) a. Applicative m => a -> AppT app m a
Applicative
, forall a. a -> AppT app m a
forall a b. AppT app m a -> AppT app m b -> AppT app m b
forall a b. AppT app m a -> (a -> AppT app m b) -> AppT app m b
forall {app} {m :: * -> *}. Monad m => Applicative (AppT app m)
forall app (m :: * -> *) a. Monad m => a -> AppT app m a
forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> AppT app m b -> AppT app m b
forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> (a -> AppT app m b) -> AppT app 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
return :: forall a. a -> AppT app m a
$creturn :: forall app (m :: * -> *) a. Monad m => a -> AppT app m a
>> :: forall a b. AppT app m a -> AppT app m b -> AppT app m b
$c>> :: forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> AppT app m b -> AppT app m b
>>= :: forall a b. AppT app m a -> (a -> AppT app m b) -> AppT app m b
$c>>= :: forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> (a -> AppT app m b) -> AppT app m b
Monad
, forall a. IO a -> AppT app m a
forall {app} {m :: * -> *}. MonadIO m => Monad (AppT app m)
forall app (m :: * -> *) a. MonadIO m => IO a -> AppT app m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> AppT app m a
$cliftIO :: forall app (m :: * -> *) a. MonadIO m => IO a -> AppT app m a
MonadIO
, forall e a. Exception e => e -> AppT app m a
forall {app} {m :: * -> *}. MonadThrow m => Monad (AppT app m)
forall app (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> AppT app m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> AppT app m a
$cthrowM :: forall app (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> AppT app m a
MonadThrow
, forall e a.
Exception e =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
forall {app} {m :: * -> *}. MonadCatch m => MonadThrow (AppT app m)
forall app (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
$ccatch :: forall app (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
MonadCatch
, forall b.
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
forall a b c.
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
forall {app} {m :: * -> *}. MonadMask m => MonadCatch (AppT app m)
forall app (m :: * -> *) b.
MonadMask m =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
forall app (m :: * -> *) a b c.
MonadMask m =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
$cgeneralBracket :: forall app (m :: * -> *) a b c.
MonadMask m =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
uninterruptibleMask :: forall b.
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
$cuninterruptibleMask :: forall app (m :: * -> *) b.
MonadMask m =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
mask :: forall b.
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
$cmask :: forall app (m :: * -> *) b.
MonadMask m =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
MonadMask
, forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
forall {app} {m :: * -> *}. MonadIO m => Monad (AppT app m)
forall app (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
$cmonadLoggerLog :: forall app (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
MonadLogger
, AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall app (m :: * -> *). MonadIO m => MonadLogger (AppT app m)
forall app (m :: * -> *). MonadIO m => MonadIO (AppT app m)
forall app (m :: * -> *).
MonadIO m =>
AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *).
MonadLogger m
-> MonadIO m
-> m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> MonadLoggerIO m
askLoggerIO :: AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
$caskLoggerIO :: forall app (m :: * -> *).
MonadIO m =>
AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLoggerIO
, forall a. ResourceT IO a -> AppT app m a
forall app (m :: * -> *). MonadIO m => MonadIO (AppT app m)
forall app (m :: * -> *) a.
MonadIO m =>
ResourceT IO a -> AppT app m a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
liftResourceT :: forall a. ResourceT IO a -> AppT app m a
$cliftResourceT :: forall app (m :: * -> *) a.
MonadIO m =>
ResourceT IO a -> AppT app m a
MonadResource
, MonadReader app
)
instance MonadUnliftIO m => MonadUnliftIO (AppT app m) where
withRunInIO :: forall b.
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
withRunInIO (forall a. AppT app m a -> IO a) -> IO b
inner = forall app (m :: * -> *) a.
ReaderT app (LoggingT (ResourceT m)) a -> AppT app m a
AppT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a
run -> (forall a. AppT app m a -> IO a) -> IO b
inner forall a b. (a -> b) -> a -> b
$ forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
unAppT
{-# INLINE withRunInIO #-}
instance PrimMonad m => PrimMonad (AppT app m) where
type PrimState (AppT app m) = PrimState m
primitive :: forall a.
(State# (PrimState (AppT app m))
-> (# State# (PrimState (AppT app m)), a #))
-> AppT app m a
primitive = forall app (m :: * -> *) a.
ReaderT app (LoggingT (ResourceT m)) a -> AppT app m a
AppT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
{-# INLINE primitive #-}
instance (Monad m, HasTracer app) => MonadTracer (AppT app m) where
getTracer :: AppT app m Tracer
getTracer = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasTracer s => Lens' s Tracer
tracerL
instance Applicative m => XRay.MonadTracer (AppT app m) where
getVaultData :: AppT app m (Maybe XRayVaultData)
getVaultData = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
runAppT :: (MonadUnliftIO m, HasLogger app) => AppT app m a -> app -> m a
runAppT :: forall (m :: * -> *) app a.
(MonadUnliftIO m, HasLogger app) =>
AppT app m a -> app -> m a
runAppT AppT app m a
action app
app =
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT app
app forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
unAppT AppT app m a
action) app
app