-- | 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
-- >   withLogger configLoggerSettings $ \appLogger ->
-- >     appSqlPool <- runWithLogger 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.Primitive (PrimMonad (..))
import Control.Monad.Reader
import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
import Freckle.App.Database
import Freckle.App.Http (MonadHttp (..))
import Freckle.App.OpenTelemetry
import Freckle.App.OpenTelemetry.Context
import Freckle.App.OpenTelemetry.Http
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)

runApp
  :: (forall b. (app -> IO b) -> IO b)
  -> AppT app IO a
  -> IO a
runApp :: forall app a.
(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 =>
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 (ResourceT m) a
unAppT :: ReaderT app (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
    , 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
    )
  deriving (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, HasLogger app) =>
Monad (AppT app m)
forall app (m :: * -> *) msg.
(MonadIO m, HasLogger app, 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, HasLogger app, 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, HasLogger app) =>
MonadLogger (AppT app m)
forall app (m :: * -> *).
(MonadIO m, HasLogger app) =>
MonadIO (AppT app m)
forall app (m :: * -> *).
(MonadIO m, HasLogger app) =>
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, HasLogger app) =>
AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO :: AppT app m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLoggerIO) via WithLogger app (ResourceT m)

instance MonadTrans (AppT app) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> AppT app m a
lift = ReaderT app (ResourceT m) a -> AppT app m a
forall app (m :: * -> *) a.
ReaderT app (ResourceT m) a -> AppT app m a
AppT (ReaderT app (ResourceT m) a -> AppT app m a)
-> (m a -> ReaderT app (ResourceT m) a) -> m a -> AppT app m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT m a -> ReaderT app (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 (ResourceT m a -> ReaderT app (ResourceT m) a)
-> (m a -> ResourceT m a) -> m a -> ReaderT app (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

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 = m a -> AppT app m a
forall (m :: * -> *) a. Monad m => m a -> AppT app m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AppT app m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> AppT app 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 (MonadUnliftIO m, HasTracer app) => MonadHttp (AppT app m) where
  httpLbs :: Request -> AppT app m (Response ByteString)
httpLbs Request
req = LogSource
-> SpanArguments
-> AppT app m (Response ByteString)
-> AppT app m (Response ByteString)
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadTracer m, HasCallStack) =>
LogSource -> SpanArguments -> m a -> m a
inSpan (Request -> LogSource
httpSpanName Request
req) (Request -> SpanArguments
httpSpanArguments Request
req) (AppT app m (Response ByteString)
 -> AppT app m (Response ByteString))
-> AppT app m (Response ByteString)
-> AppT app m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Response ByteString
resp <- 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 (Request -> AppT app m (Response ByteString))
-> AppT app m Request -> AppT app m (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Request -> AppT app m Request
forall (m :: * -> *) a.
(MonadIO m, MonadTracer m, HasHeaders a) =>
a -> m a
injectContext Request
req
    Response ByteString
resp Response ByteString
-> AppT app m () -> AppT app m (Response ByteString)
forall a b. a -> AppT app m b -> AppT app m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HashMap LogSource Attribute -> AppT app m ()
forall (m :: * -> *).
MonadIO m =>
HashMap LogSource Attribute -> m ()
addCurrentSpanAttributes (Response ByteString -> HashMap LogSource Attribute
forall body. Response body -> HashMap LogSource Attribute
httpResponseAttributes Response ByteString
resp)

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
  (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 => AppT app m a -> app -> m a
runAppT :: forall (m :: * -> *) app a.
MonadUnliftIO m =>
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
$ ReaderT app (ResourceT m) a -> app -> ResourceT m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AppT app m a -> ReaderT app (ResourceT m) a
forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (ResourceT m) a
unAppT AppT app m a
action) app
app