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.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.Http (MonadHttp (..))
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
IO ()
forall (m :: * -> *). MonadIO m => m ()
setLineBuffering
(app -> IO a) -> IO a
forall b. (app -> IO b) -> IO b
loadApp ((app -> IO a) -> IO a) -> (app -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ AppT app IO a -> app -> IO a
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 = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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 -> b) -> AppT app m a -> AppT app m b)
-> (forall a b. a -> AppT app m b -> AppT app m a)
-> Functor (AppT app m)
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
$cfmap :: forall app (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT app m a -> AppT app m b
fmap :: forall a b. (a -> b) -> AppT app m a -> AppT app m b
$c<$ :: forall app (m :: * -> *) a b.
Functor m =>
a -> AppT app m b -> AppT app m a
<$ :: forall a b. a -> AppT app m b -> AppT app m a
Functor
, Functor (AppT app m)
Functor (AppT app m) =>
(forall a. a -> AppT app m a)
-> (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 a b. AppT app m a -> AppT app m b -> AppT app m b)
-> (forall a b. AppT app m a -> AppT app m b -> AppT app m a)
-> Applicative (AppT app m)
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
$cpure :: forall app (m :: * -> *) a. Applicative m => a -> AppT app m a
pure :: forall a. a -> AppT app m a
$c<*> :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m (a -> b) -> AppT app m a -> AppT app m b
<*> :: forall a b. AppT app m (a -> b) -> AppT app m a -> AppT app m b
$cliftA2 :: forall app (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
liftA2 :: forall a b c.
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
$c*> :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m b
*> :: 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 a
<* :: forall a b. AppT app m a -> AppT app m b -> AppT app m a
Applicative
, Applicative (AppT app m)
Applicative (AppT app m) =>
(forall a b. AppT app m a -> (a -> AppT app m b) -> AppT app m b)
-> (forall a b. AppT app m a -> AppT app m b -> AppT app m b)
-> (forall a. a -> AppT app m a)
-> Monad (AppT app m)
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
$c>>= :: forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> (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 -> AppT app m b -> AppT app m b
>> :: forall a b. AppT app m a -> AppT app m b -> AppT app m b
$creturn :: forall app (m :: * -> *) a. Monad m => a -> AppT app m a
return :: forall a. a -> AppT app m a
Monad
, Monad (AppT app m)
Monad (AppT app m) =>
(forall a. IO a -> AppT app m a) -> MonadIO (AppT app m)
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
$cliftIO :: forall app (m :: * -> *) a. MonadIO m => IO a -> AppT app m a
liftIO :: forall a. IO a -> AppT app m a
MonadIO
, MonadIO (AppT app m)
MonadIO (AppT app m) =>
(forall b.
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b)
-> MonadUnliftIO (AppT app m)
forall b.
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
forall app (m :: * -> *). MonadUnliftIO m => MonadIO (AppT app m)
forall app (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall app (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
withRunInIO :: forall b.
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
MonadUnliftIO
, Monad (AppT app m)
Monad (AppT app m) =>
(forall e a. (HasCallStack, Exception e) => e -> AppT app m a)
-> MonadThrow (AppT app m)
forall e a. (HasCallStack, Exception e) => e -> AppT app m a
forall app (m :: * -> *). MonadThrow m => Monad (AppT app m)
forall app (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> AppT app m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall app (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> AppT app m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> AppT app m a
MonadThrow
, MonadThrow (AppT app m)
MonadThrow (AppT app m) =>
(forall e a.
(HasCallStack, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a)
-> MonadCatch (AppT app m)
forall e a.
(HasCallStack, 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, HasCallStack, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall app (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
catch :: forall e a.
(HasCallStack, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
MonadCatch
, MonadCatch (AppT app m)
MonadCatch (AppT app m) =>
(forall b.
HasCallStack =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b)
-> (forall b.
HasCallStack =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b)
-> (forall a b c.
HasCallStack =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c))
-> MonadMask (AppT app m)
forall b.
HasCallStack =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
forall a b c.
HasCallStack =>
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, HasCallStack) =>
((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, HasCallStack) =>
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. 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 app (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
mask :: forall b.
HasCallStack =>
((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, HasCallStack) =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
$cgeneralBracket :: forall app (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
MonadMask
, Monad (AppT app m)
Monad (AppT app m) =>
(forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ())
-> MonadLogger (AppT app m)
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
$cmonadLoggerLog :: forall app (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
MonadLogger
, MonadLogger (AppT app m)
MonadIO (AppT app m)
AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
(MonadLogger (AppT app m), MonadIO (AppT app m)) =>
AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> MonadLoggerIO (AppT app m)
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
$caskLoggerIO :: forall app (m :: * -> *).
MonadIO m =>
AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO :: AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLoggerIO
, MonadIO (AppT app m)
MonadIO (AppT app m) =>
(forall a. ResourceT IO a -> AppT app m a)
-> MonadResource (AppT app m)
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
$cliftResourceT :: forall app (m :: * -> *) a.
MonadIO m =>
ResourceT IO a -> AppT app m a
liftResourceT :: forall a. ResourceT IO a -> AppT app m a
MonadResource
, MonadReader app
)
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 = ReaderT app (LoggingT (ResourceT m)) a -> AppT app m a
forall app (m :: * -> *) a.
ReaderT app (LoggingT (ResourceT m)) a -> AppT app m a
AppT (ReaderT app (LoggingT (ResourceT m)) a -> AppT app m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #))
-> ReaderT app (LoggingT (ResourceT m)) a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> AppT app m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingT (ResourceT m) a -> ReaderT app (LoggingT (ResourceT m)) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT app m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT m) a
-> ReaderT app (LoggingT (ResourceT m)) a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #))
-> LoggingT (ResourceT m) a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> ReaderT app (LoggingT (ResourceT m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT m a -> LoggingT (ResourceT m) a
forall (m :: * -> *) a. Monad m => m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT m a -> LoggingT (ResourceT m) a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #))
-> ResourceT m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> LoggingT (ResourceT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ResourceT m a
forall (m :: * -> *) a. Monad m => m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ResourceT m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
{-# INLINE primitive #-}
instance MonadIO m => MonadHttp (AppT app m) where
httpLbs :: Request -> AppT app m (Response ByteString)
httpLbs = IO (Response ByteString) -> AppT app m (Response ByteString)
forall a. IO a -> AppT app m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> AppT app m (Response ByteString))
-> (Request -> IO (Response ByteString))
-> Request
-> AppT app m (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadHttp m =>
Request -> m (Response ByteString)
httpLbs
instance (Monad m, HasTracer app) => MonadTracer (AppT app m) where
getTracer :: AppT app m Tracer
getTracer = Getting Tracer app Tracer -> AppT app m Tracer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tracer app Tracer
forall s. HasTracer s => Lens' s Tracer
Lens' app Tracer
tracerL
instance Applicative m => XRay.MonadTracer (AppT app m) where
getVaultData :: AppT app m (Maybe XRayVaultData)
getVaultData = Maybe XRayVaultData -> AppT app m (Maybe XRayVaultData)
forall a. a -> AppT app m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe XRayVaultData
forall a. Maybe a
Nothing
instance
(MonadUnliftIO m, HasSqlPool app, HasStatsClient app, HasTracer app)
=> MonadSqlTx (ReaderT SqlBackend (AppT app m)) (AppT app m)
where
runSqlTx :: forall a.
HasCallStack =>
ReaderT SqlBackend (AppT app m) a -> AppT app m a
runSqlTx = SqlPersistT (AppT app m) a -> AppT app m a
forall (m :: * -> *) app a.
(MonadUnliftIO m, MonadTracer m, MonadReader app m, HasSqlPool app,
HasStatsClient app, HasCallStack) =>
SqlPersistT m a -> m a
runDB
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 =
ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT m a -> m a) -> ResourceT m a -> m a
forall a b. (a -> b) -> a -> b
$ app -> LoggingT (ResourceT m) a -> ResourceT m a
forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT app
app (LoggingT (ResourceT m) a -> ResourceT m a)
-> LoggingT (ResourceT m) a -> ResourceT m a
forall a b. (a -> b) -> a -> b
$ ReaderT app (LoggingT (ResourceT m)) a
-> app -> LoggingT (ResourceT m) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
unAppT AppT app m a
action) app
app