-- | Micro-framework for building a non-web application
--
-- This is a version of the /ReaderT Design Pattern/.
--
-- <https://www.fpcomplete.com/blog/2017/06/readert-design-pattern>
--
-- == Basic Usage
--
-- Start by defining a type to hold your global application state:
--
-- > data App = App
-- >   { appDryRun :: Bool
-- >   , appLogger :: Logger
-- >   }
--
-- This type can be as complex or simple as you want. It might hold a separate
-- @Config@ attribute or may keep everything as one level of properties. It
-- could even hold an @'IORef'@ if you need mutable application state.
--
-- The only requirements are 'HasLogger':
--
-- > instance HasLogger App where
-- >   loggerL = lens appLogger $ \x y -> x { appLogger = y }
--
-- and a bracketed function for building and using a value:
--
-- > loadApp :: (App -> m a) -> m a
-- > loadApp f = do
-- >   app <- -- ...
-- >   f app
--
-- It's likely you'll want to use @"Freckle.App.Env"@ to load your @App@:
--
-- > import qualified Blammo.Logger.LogSettings.Env as LoggerEnv
-- > import qualified Freckle.App.Env as Env
-- >
-- > loadApp f = do
-- >   app <- Env.parse id $ App
-- >     <$> Env.switch "DRY_RUN" mempty
-- >     <*> LoggerEnv.parser
--
-- Now you have application-specific actions that can do IO, log, and access
-- your state:
--
-- > myAppAction :: (MonadIO m, MonadLogger m, MonadReader App env) => m ()
-- > myAppAction = do
-- >   isDryRun <- asks appDryRun
-- >
-- >   if isDryRun
-- >     then logWarn "Skipping due to dry-run"
-- >     else liftIO $ fireTheMissles
--
-- These actions can be (composed of course, or) invoked by a @main@ that
-- handles the reader context and evaluating the logging action.
--
-- > main :: IO ()
-- > main = do
-- >   runApp loadApp $ do
-- >     myAppAction
-- >     myOtherAppAction
--
-- == 'AppT'
--
-- Functions like @myAppAction@ will be run in the concrete stack 'AppT', but
-- you should prefer using using constraints (e.g. @'MonadReader' app@). See its
-- docs for all the constraints it satisfies.
--
-- == Database
--
-- @
-- import "Freckle.App.Database"
-- import "Freckle.App.OpenTelemetry"
-- @
--
-- Adding Database access requires a few more instances on your @App@ type:
--
-- - @'HasSqlPool'@: so we can, you know, talk to a DB
-- - @'HasTracer'@: to satisfy @'MonadTracer'@ so we can trace @'runDB'@
-- - @'HasStatsClient'@: so we can manage connection count metrics
--
-- Most often, this will be easiest if you indeed separate a @Config@ attribute:
--
-- > data Config = Config
-- >   { configDbPoolSize :: Int
-- >   , configLogSettings :: LogSettings
-- >   , configStatsSettings :: StatsSettings
-- >   }
--
-- So you can isolate Env-related concerns
--
-- > loadConfig :: IO Config
-- > loadConfig = Env.parse id $ Config
-- >   <$> Env.var Env.auto "PGPOOLSIZE" (Env.def 1)
-- >   <*> LoggerEnv.parser
-- >   <*> envParseStatsSettings
--
-- from the runtime application state:
--
-- > data App = App
-- >   { appConfig :: Config
-- >   , appLogger :: Logger
-- >   , appSqlPool :: SqlPool
-- >   , appTracer :: Tracer
-- >   , appStatsClient :: StatsClient
-- >   }
-- >
-- > instance HasLogger App where
-- >   loggerL = appLogger $ \x y -> x { appLogger = y }
-- >
-- > instance HasSqlPool App where
-- >   getSqlPool = appSqlPool
-- >
-- > instance HasTracer App where
-- >   tracerL = lens appTracer $ \x y -> x { appTracer = y }
-- >
-- > instance HasStatsClient App where
-- >   statsClientL = lens appStatsClient $ \x y -> x { appStatsClient = y }
--
-- The @"Freckle.App.Database"@ module provides @'makePostgresPool'@ for
-- building a Pool given this (limited) config data:
--
-- > loadApp :: (App -> IO a) -> IO a
-- > loadApp f = do
-- >   appConfig{..} <- loadConfig
-- >   appLogger <- newLogger configLoggerSettings
-- >   appSqlPool <- runLoggerLoggingT appLogger $ makePostgresPool configDbPoolSize
-- >   withTracerProvider $ \tracerProvider -> do
-- >     withStatsClient configStatsSettings $ \appStatsClient -> do
-- >       let appTracer = makeTracer tracerProvider "my-app" tracerOptions
-- >       f App{..}
--
-- This unlocks @'runDB'@ for your application:
--
-- > myAppAction
-- >   :: ( MonadUnliftIO m
-- >      , MonadTracer m
-- >      , MonadReader env m
-- >      , HasSqlPool env
-- >      , HasStatsClient env
-- >      )
-- >   => SqlPersistT m [Entity Something]
-- > myAppAction = runDB $ selectList [] []
--
-- == Testing
--
-- @"Freckle.App.Test"@ exposes an @'AppExample'@ type for examples in a
-- @'SpecWith' App@ spec. The can be run by giving your @loadApp@ function to
-- Hspec's @'aroundAll'@.
--
-- Using MTL-style constraints (i.e. 'MonadReader') means you can use your
-- actions directly in expectations, but you may need some type annotations:
--
-- > spec :: Spec
-- > spec = aroundAll loadApp $ do
-- >   describe "myAppAction" $ do
-- >     it "works" $ do
-- >       result <- myAppAction :: AppExample App Text
-- >       result `shouldBe` "as expected"
--
-- If your @App@ type has the required instances, you can use 'runDB' in your
-- specs too:
--
-- > spec :: Spec
-- > spec = aroundAll loadApp $ do
-- >   describe "myQuery" $ do
-- >     it "works" $ do
-- >       result <- runDB myQuery :: AppExample App Text
-- >       result `shouldBe` "as expected"
module Freckle.App
  ( runApp
  , setLineBuffering

    -- * Concrete transformer stack
  , AppT (..)
  , runAppT

    -- * Re-exports
  , 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
  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

-- | Ensure output is streamed if in a Docker container
--
-- 'runApp' calls this for you, but it may be useful if you're running the app
-- some other way.
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
    , Monad (AppT app m)
Monad (AppT app m)
-> (forall e a. Exception e => e -> AppT app m a)
-> MonadThrow (AppT app m)
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
$cthrowM :: forall app (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> AppT app m a
throwM :: forall e a. Exception e => e -> AppT app m a
MonadThrow
    , MonadThrow (AppT app m)
MonadThrow (AppT app m)
-> (forall e a.
    Exception e =>
    AppT app m a -> (e -> AppT app m a) -> AppT app m a)
-> MonadCatch (AppT app m)
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
$ccatch :: forall app (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
catch :: forall e a.
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.
    ((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
    -> AppT app m b)
-> (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))
-> MonadMask (AppT app m)
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
$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
mask :: 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
uninterruptibleMask :: forall b.
((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 =>
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.
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
    )

-- Just copies ReaderT's definition. This can be newtype-derived in GHC 8.10+,
-- but we do it by hand while we want to support older.
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 = ReaderT app (LoggingT (ResourceT m)) b -> AppT app m b
forall app (m :: * -> *) a.
ReaderT app (LoggingT (ResourceT m)) a -> AppT app m a
AppT (ReaderT app (LoggingT (ResourceT m)) b -> AppT app m b)
-> ReaderT app (LoggingT (ResourceT m)) b -> AppT app m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a)
 -> IO b)
-> ReaderT app (LoggingT (ResourceT m)) b
forall b.
((forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a)
 -> IO b)
-> ReaderT app (LoggingT (ResourceT m)) b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a)
  -> IO b)
 -> ReaderT app (LoggingT (ResourceT m)) b)
-> ((forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a)
    -> IO b)
-> ReaderT app (LoggingT (ResourceT m)) b
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. AppT app m a -> IO a) -> IO b)
-> (forall a. AppT app m a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ ReaderT app (LoggingT (ResourceT m)) a -> IO a
forall a. ReaderT app (LoggingT (ResourceT m)) a -> IO a
run (ReaderT app (LoggingT (ResourceT m)) a -> IO a)
-> (AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a)
-> AppT app m a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  {-# INLINE withRunInIO #-}

instance PrimMonad m => PrimMonad (AppT app m) where
  type PrimState (AppT app m) = PrimState m

  -- This should really just be `lift . primitive`, but:
  --
  -- - We'd need `MonadTrans (AppT app)`, which meh
  -- - We'd need an orphan `Primitive LoggingT`, which no thanks
  --
  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 (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