{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
module System.Metrics.Prometheus.Ridley.Types (
    RidleyT(Ridley)
  , Ridley
  , runRidley
  , RidleyCtx(RidleyCtx)
  , ridleyThreadId
  , ridleyWaiMetrics
  , Port
  , PrometheusOptions
  , RidleyMetric(..)
  , RidleyOptions
  , RidleyMetricHandler
  , metric
  , updateMetric
  , flush
  , label
  , mkRidleyMetricHandler
  , defaultMetrics
  , newOptions
  , prometheusOptions
  , ridleyMetrics
  , katipScribes
  , katipSeverity
  , dataRetentionPeriod
  , runHandler
  ) where

import           Control.Concurrent (ThreadId)
import           Control.Monad.IO.Class
import           Control.Monad.Reader (MonadReader)
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import qualified Data.Set as Set
import qualified Data.Text as T
import           Data.Time
import           GHC.Stack
import           Katip
import           Lens.Micro.TH
import           Network.Wai.Metrics (WaiMetrics)
import qualified System.Metrics.Prometheus.MetricId as P
import qualified System.Metrics.Prometheus.RegistryT as P
import           System.Remote.Monitoring.Prometheus
import           System.Metrics.Prometheus.Ridley.Types.Internal

--------------------------------------------------------------------------------
type Port = Int
type PrometheusOptions = AdapterOptions

mkRidleyMetricHandler :: forall c. HasCallStack
                      => T.Text
                      -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler :: Text -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler Text
lbl c
c c -> Bool -> IO ()
runC Bool
flsh = (HasCallStack => RidleyMetricHandler) -> RidleyMetricHandler
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => RidleyMetricHandler) -> RidleyMetricHandler)
-> (HasCallStack => RidleyMetricHandler) -> RidleyMetricHandler
forall a b. (a -> b) -> a -> b
$ RidleyMetricHandler :: forall c.
c
-> (c -> Bool -> IO ())
-> Bool
-> Text
-> CallStack
-> RidleyMetricHandler
RidleyMetricHandler {
    metric :: c
metric       = c
c
  , updateMetric :: c -> Bool -> IO ()
updateMetric = c -> Bool -> IO ()
runC
  , flush :: Bool
flush        = Bool
flsh
  , label :: Text
label        = Text
lbl
  , _cs :: CallStack
_cs          = CallStack -> CallStack
popCallStack CallStack
HasCallStack => CallStack
callStack
  }

--------------------------------------------------------------------------------
data RidleyMetric = ProcessMemory
                  | CPULoad
                  | GHCConc
                  -- ^ Tap into the metrics exposed by GHC.Conc
                  | Network
                  | Wai
                  | DiskUsage
                  -- ^ Gets stats about Disk usage (free space, etc)
                  | CustomMetric !T.Text
                                 -- ^ The name of the metric
                                 !(Maybe Int)
                                 -- ^ An optional timeout, in microseconds,
                                 -- that regulates how often the metric is
                                 -- actually updated. If Nothing, the metric
                                 -- will be updated using Ridley top-level setting,
                                 -- if 'Just' the underlying 'IO' action will be run
                                 -- only every @n@ seconds, or cached otherwise.
                                 (forall m. MonadIO m => RidleyOptions -> P.RegistryT m RidleyMetricHandler)
                                 -- ^ An action to generate the handler.
                  -- ^ A user-defined metric, identified by a name.

instance Show RidleyMetric where
  show :: RidleyMetric -> String
show RidleyMetric
ProcessMemory         = String
"ProcessMemory"
  show RidleyMetric
CPULoad               = String
"CPULoad"
  show RidleyMetric
GHCConc               = String
"GHCConc"
  show RidleyMetric
Network               = String
"Network"
  show RidleyMetric
Wai                   = String
"Wai"
  show RidleyMetric
DiskUsage             = String
"DiskUsage"
  show (CustomMetric Text
name Maybe Int
_ forall (m :: * -> *).
MonadIO m =>
RidleyOptions -> RegistryT m RidleyMetricHandler
_) = String
"Custom@" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name

instance Eq RidleyMetric where
  == :: RidleyMetric -> RidleyMetric -> Bool
(==) RidleyMetric
ProcessMemory RidleyMetric
ProcessMemory             = Bool
True
  (==) RidleyMetric
CPULoad RidleyMetric
CPULoad                         = Bool
True
  (==) RidleyMetric
GHCConc RidleyMetric
GHCConc                         = Bool
True
  (==) RidleyMetric
Network RidleyMetric
Network                         = Bool
True
  (==) RidleyMetric
Wai     RidleyMetric
Wai                             = Bool
True
  (==) RidleyMetric
DiskUsage RidleyMetric
DiskUsage                     = Bool
True
  (==) (CustomMetric Text
n1 Maybe Int
_ forall (m :: * -> *).
MonadIO m =>
RidleyOptions -> RegistryT m RidleyMetricHandler
_) (CustomMetric Text
n2 Maybe Int
_ forall (m :: * -> *).
MonadIO m =>
RidleyOptions -> RegistryT m RidleyMetricHandler
_) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
n1 Text
n2
  (==) RidleyMetric
_ RidleyMetric
_                                     = Bool
False

instance Ord RidleyMetric where
  compare :: RidleyMetric -> RidleyMetric -> Ordering
compare RidleyMetric
ProcessMemory RidleyMetric
xs = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
EQ
    RidleyMetric
_                      -> Ordering
GT
  compare RidleyMetric
CPULoad RidleyMetric
xs       = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
LT
    RidleyMetric
CPULoad                -> Ordering
EQ
    RidleyMetric
_                      -> Ordering
GT
  compare RidleyMetric
GHCConc RidleyMetric
xs       = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
LT
    RidleyMetric
CPULoad                -> Ordering
LT
    RidleyMetric
GHCConc                -> Ordering
EQ
    RidleyMetric
_                      -> Ordering
GT
  compare RidleyMetric
Network RidleyMetric
xs       = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
LT
    RidleyMetric
CPULoad                -> Ordering
LT
    RidleyMetric
GHCConc                -> Ordering
LT
    RidleyMetric
Network                -> Ordering
EQ
    RidleyMetric
_                      -> Ordering
GT
  compare RidleyMetric
Wai     RidleyMetric
xs       = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
LT
    RidleyMetric
CPULoad                -> Ordering
LT
    RidleyMetric
GHCConc                -> Ordering
LT
    RidleyMetric
Network                -> Ordering
LT
    RidleyMetric
Wai                    -> Ordering
EQ
    RidleyMetric
_                      -> Ordering
GT
  compare RidleyMetric
DiskUsage RidleyMetric
xs     = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
LT
    RidleyMetric
CPULoad                -> Ordering
LT
    RidleyMetric
GHCConc                -> Ordering
LT
    RidleyMetric
Network                -> Ordering
LT
    RidleyMetric
Wai                    -> Ordering
LT
    RidleyMetric
DiskUsage              -> Ordering
EQ
    RidleyMetric
_                      -> Ordering
GT
  compare (CustomMetric Text
n1 Maybe Int
_ forall (m :: * -> *).
MonadIO m =>
RidleyOptions -> RegistryT m RidleyMetricHandler
_) RidleyMetric
xs = case RidleyMetric
xs of
    RidleyMetric
ProcessMemory          -> Ordering
LT
    RidleyMetric
CPULoad                -> Ordering
LT
    RidleyMetric
GHCConc                -> Ordering
LT
    RidleyMetric
Network                -> Ordering
LT
    RidleyMetric
Wai                    -> Ordering
LT
    RidleyMetric
DiskUsage              -> Ordering
LT
    (CustomMetric Text
n2 Maybe Int
_ forall (m :: * -> *).
MonadIO m =>
RidleyOptions -> RegistryT m RidleyMetricHandler
_)    -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
n1 Text
n2

--------------------------------------------------------------------------------
data RidleyOptions = RidleyOptions {
    RidleyOptions -> PrometheusOptions
_prometheusOptions :: PrometheusOptions
  , RidleyOptions -> Set RidleyMetric
_ridleyMetrics :: Set.Set RidleyMetric
  , RidleyOptions -> (Namespace, [(Text, Scribe)])
_katipScribes :: (Katip.Namespace, [(T.Text, Katip.Scribe)])
  , RidleyOptions -> Severity
_katipSeverity :: Katip.Severity
  , RidleyOptions -> Maybe NominalDiffTime
_dataRetentionPeriod :: Maybe NominalDiffTime
  -- ^ How much to retain the data, in seconds.
  -- Pass `Nothing` to not flush the metrics.
  }

makeLenses ''RidleyOptions

--------------------------------------------------------------------------------
defaultMetrics :: [RidleyMetric]
defaultMetrics :: [RidleyMetric]
defaultMetrics = [RidleyMetric
ProcessMemory, RidleyMetric
CPULoad, RidleyMetric
GHCConc, RidleyMetric
Network, RidleyMetric
Wai, RidleyMetric
DiskUsage]

--------------------------------------------------------------------------------
newOptions :: [(T.Text, T.Text)]
           -> [RidleyMetric]
           -> RidleyOptions
newOptions :: [(Text, Text)] -> [RidleyMetric] -> RidleyOptions
newOptions [(Text, Text)]
appLabels [RidleyMetric]
metrics = RidleyOptions :: PrometheusOptions
-> Set RidleyMetric
-> (Namespace, [(Text, Scribe)])
-> Severity
-> Maybe NominalDiffTime
-> RidleyOptions
RidleyOptions {
    _prometheusOptions :: PrometheusOptions
_prometheusOptions = Labels -> PrometheusOptions
defaultOptions ([(Text, Text)] -> Labels
P.fromList [(Text, Text)]
appLabels)
  , _ridleyMetrics :: Set RidleyMetric
_ridleyMetrics     = [RidleyMetric] -> Set RidleyMetric
forall a. Ord a => [a] -> Set a
Set.fromList [RidleyMetric]
metrics
  , _katipSeverity :: Severity
_katipSeverity     = Severity
InfoS
  , _katipScribes :: (Namespace, [(Text, Scribe)])
_katipScribes      = (Namespace, [(Text, Scribe)])
forall a. Monoid a => a
mempty
  , _dataRetentionPeriod :: Maybe NominalDiffTime
_dataRetentionPeriod = Maybe NominalDiffTime
forall a. Maybe a
Nothing
  }

--------------------------------------------------------------------------------
runHandler :: RidleyMetricHandler -> IO ()
runHandler :: RidleyMetricHandler -> IO ()
runHandler (RidleyMetricHandler c
m c -> Bool -> IO ()
u Bool
f Text
_ CallStack
_) = c -> Bool -> IO ()
u c
m Bool
f

--------------------------------------------------------------------------------
newtype RidleyT t a = Ridley { RidleyT t a -> ReaderT RidleyOptions t a
_unRidley :: ReaderT RidleyOptions t a }
  deriving (a -> RidleyT t b -> RidleyT t a
(a -> b) -> RidleyT t a -> RidleyT t b
(forall a b. (a -> b) -> RidleyT t a -> RidleyT t b)
-> (forall a b. a -> RidleyT t b -> RidleyT t a)
-> Functor (RidleyT t)
forall a b. a -> RidleyT t b -> RidleyT t a
forall a b. (a -> b) -> RidleyT t a -> RidleyT t b
forall (t :: * -> *) a b.
Functor t =>
a -> RidleyT t b -> RidleyT t a
forall (t :: * -> *) a b.
Functor t =>
(a -> b) -> RidleyT t a -> RidleyT t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RidleyT t b -> RidleyT t a
$c<$ :: forall (t :: * -> *) a b.
Functor t =>
a -> RidleyT t b -> RidleyT t a
fmap :: (a -> b) -> RidleyT t a -> RidleyT t b
$cfmap :: forall (t :: * -> *) a b.
Functor t =>
(a -> b) -> RidleyT t a -> RidleyT t b
Functor, Functor (RidleyT t)
a -> RidleyT t a
Functor (RidleyT t)
-> (forall a. a -> RidleyT t a)
-> (forall a b. RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b)
-> (forall a b c.
    (a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c)
-> (forall a b. RidleyT t a -> RidleyT t b -> RidleyT t b)
-> (forall a b. RidleyT t a -> RidleyT t b -> RidleyT t a)
-> Applicative (RidleyT t)
RidleyT t a -> RidleyT t b -> RidleyT t b
RidleyT t a -> RidleyT t b -> RidleyT t a
RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
(a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c
forall a. a -> RidleyT t a
forall a b. RidleyT t a -> RidleyT t b -> RidleyT t a
forall a b. RidleyT t a -> RidleyT t b -> RidleyT t b
forall a b. RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
forall a b c.
(a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t 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 (t :: * -> *). Applicative t => Functor (RidleyT t)
forall (t :: * -> *) a. Applicative t => a -> RidleyT t a
forall (t :: * -> *) a b.
Applicative t =>
RidleyT t a -> RidleyT t b -> RidleyT t a
forall (t :: * -> *) a b.
Applicative t =>
RidleyT t a -> RidleyT t b -> RidleyT t b
forall (t :: * -> *) a b.
Applicative t =>
RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c
<* :: RidleyT t a -> RidleyT t b -> RidleyT t a
$c<* :: forall (t :: * -> *) a b.
Applicative t =>
RidleyT t a -> RidleyT t b -> RidleyT t a
*> :: RidleyT t a -> RidleyT t b -> RidleyT t b
$c*> :: forall (t :: * -> *) a b.
Applicative t =>
RidleyT t a -> RidleyT t b -> RidleyT t b
liftA2 :: (a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c
$cliftA2 :: forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c
<*> :: RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
$c<*> :: forall (t :: * -> *) a b.
Applicative t =>
RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
pure :: a -> RidleyT t a
$cpure :: forall (t :: * -> *) a. Applicative t => a -> RidleyT t a
$cp1Applicative :: forall (t :: * -> *). Applicative t => Functor (RidleyT t)
Applicative, Applicative (RidleyT t)
a -> RidleyT t a
Applicative (RidleyT t)
-> (forall a b. RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b)
-> (forall a b. RidleyT t a -> RidleyT t b -> RidleyT t b)
-> (forall a. a -> RidleyT t a)
-> Monad (RidleyT t)
RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b
RidleyT t a -> RidleyT t b -> RidleyT t b
forall a. a -> RidleyT t a
forall a b. RidleyT t a -> RidleyT t b -> RidleyT t b
forall a b. RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b
forall (t :: * -> *). Monad t => Applicative (RidleyT t)
forall (t :: * -> *) a. Monad t => a -> RidleyT t a
forall (t :: * -> *) a b.
Monad t =>
RidleyT t a -> RidleyT t b -> RidleyT t b
forall (t :: * -> *) a b.
Monad t =>
RidleyT t a -> (a -> RidleyT t b) -> RidleyT t 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 :: a -> RidleyT t a
$creturn :: forall (t :: * -> *) a. Monad t => a -> RidleyT t a
>> :: RidleyT t a -> RidleyT t b -> RidleyT t b
$c>> :: forall (t :: * -> *) a b.
Monad t =>
RidleyT t a -> RidleyT t b -> RidleyT t b
>>= :: RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b
$c>>= :: forall (t :: * -> *) a b.
Monad t =>
RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b
$cp1Monad :: forall (t :: * -> *). Monad t => Applicative (RidleyT t)
Monad, MonadReader RidleyOptions, Monad (RidleyT t)
Monad (RidleyT t)
-> (forall a. IO a -> RidleyT t a) -> MonadIO (RidleyT t)
IO a -> RidleyT t a
forall a. IO a -> RidleyT t a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (t :: * -> *). MonadIO t => Monad (RidleyT t)
forall (t :: * -> *) a. MonadIO t => IO a -> RidleyT t a
liftIO :: IO a -> RidleyT t a
$cliftIO :: forall (t :: * -> *) a. MonadIO t => IO a -> RidleyT t a
$cp1MonadIO :: forall (t :: * -> *). MonadIO t => Monad (RidleyT t)
MonadIO, m a -> RidleyT m a
(forall (m :: * -> *) a. Monad m => m a -> RidleyT m a)
-> MonadTrans RidleyT
forall (m :: * -> *) a. Monad m => m a -> RidleyT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> RidleyT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> RidleyT m a
MonadTrans)

type Ridley = RidleyT (P.RegistryT (KatipContextT IO))

data RidleyCtx = RidleyCtx {
    RidleyCtx -> ThreadId
_ridleyThreadId   :: ThreadId
  , RidleyCtx -> Maybe WaiMetrics
_ridleyWaiMetrics :: Maybe WaiMetrics
  }

makeLenses ''RidleyCtx

instance Katip Ridley where
  getLogEnv :: Ridley LogEnv
getLogEnv = ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
-> Ridley LogEnv
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
 -> Ridley LogEnv)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
-> Ridley LogEnv
forall a b. (a -> b) -> a -> b
$ RegistryT (KatipContextT IO) LogEnv
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (KatipContextT IO LogEnv -> RegistryT (KatipContextT IO) LogEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift KatipContextT IO LogEnv
forall (m :: * -> *). Katip m => m LogEnv
getLogEnv)
  localLogEnv :: (LogEnv -> LogEnv) -> Ridley a -> Ridley a
localLogEnv LogEnv -> LogEnv
f (Ridley (ReaderT RidleyOptions -> RegistryT (KatipContextT IO) a
m)) =
    ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a -> Ridley a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
 -> Ridley a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> Ridley a
forall a b. (a -> b) -> a -> b
$ (RidleyOptions -> RegistryT (KatipContextT IO) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((RidleyOptions -> RegistryT (KatipContextT IO) a)
 -> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a)
-> (RidleyOptions -> RegistryT (KatipContextT IO) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
forall a b. (a -> b) -> a -> b
$ \RidleyOptions
env -> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall (m :: * -> *) a. StateT Registry m a -> RegistryT m a
P.RegistryT ((LogEnv -> LogEnv)
-> StateT Registry (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) a. Katip m => (LogEnv -> LogEnv) -> m a -> m a
localLogEnv LogEnv -> LogEnv
f (StateT Registry (KatipContextT IO) a
 -> StateT Registry (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall a b. (a -> b) -> a -> b
$ RegistryT (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) a. RegistryT m a -> StateT Registry m a
P.unRegistryT (RidleyOptions -> RegistryT (KatipContextT IO) a
m RidleyOptions
env))

instance KatipContext Ridley where
  getKatipContext :: Ridley LogContexts
getKatipContext   = LogContexts -> Ridley LogContexts
forall (m :: * -> *) a. Monad m => a -> m a
return LogContexts
forall a. Monoid a => a
mempty
  getKatipNamespace :: Ridley Namespace
getKatipNamespace = LogEnv -> Namespace
_logEnvApp (LogEnv -> Namespace) -> Ridley LogEnv -> Ridley Namespace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
-> Ridley LogEnv
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (RegistryT (KatipContextT IO) LogEnv
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RegistryT (KatipContextT IO) LogEnv
 -> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv)
-> RegistryT (KatipContextT IO) LogEnv
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) LogEnv
forall a b. (a -> b) -> a -> b
$ KatipContextT IO LogEnv -> RegistryT (KatipContextT IO) LogEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (KatipContextT IO LogEnv
forall (m :: * -> *). Katip m => m LogEnv
getLogEnv))
  localKatipContext :: (LogContexts -> LogContexts) -> Ridley a -> Ridley a
localKatipContext LogContexts -> LogContexts
f (Ridley (ReaderT RidleyOptions -> RegistryT (KatipContextT IO) a
m)) =
    ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a -> Ridley a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
 -> Ridley a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> Ridley a
forall a b. (a -> b) -> a -> b
$ (RidleyOptions -> RegistryT (KatipContextT IO) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((RidleyOptions -> RegistryT (KatipContextT IO) a)
 -> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a)
-> (RidleyOptions -> RegistryT (KatipContextT IO) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
forall a b. (a -> b) -> a -> b
$ \RidleyOptions
env -> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall (m :: * -> *) a. StateT Registry m a -> RegistryT m a
P.RegistryT ((LogContexts -> LogContexts)
-> StateT Registry (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext LogContexts -> LogContexts
f (StateT Registry (KatipContextT IO) a
 -> StateT Registry (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall a b. (a -> b) -> a -> b
$ RegistryT (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) a. RegistryT m a -> StateT Registry m a
P.unRegistryT (RidleyOptions -> RegistryT (KatipContextT IO) a
m RidleyOptions
env))
  localKatipNamespace :: (Namespace -> Namespace) -> Ridley a -> Ridley a
localKatipNamespace Namespace -> Namespace
f (Ridley (ReaderT RidleyOptions -> RegistryT (KatipContextT IO) a
m)) =
    ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a -> Ridley a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
 -> Ridley a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> Ridley a
forall a b. (a -> b) -> a -> b
$ (RidleyOptions -> RegistryT (KatipContextT IO) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((RidleyOptions -> RegistryT (KatipContextT IO) a)
 -> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a)
-> (RidleyOptions -> RegistryT (KatipContextT IO) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
forall a b. (a -> b) -> a -> b
$ \RidleyOptions
env -> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall (m :: * -> *) a. StateT Registry m a -> RegistryT m a
P.RegistryT ((Namespace -> Namespace)
-> StateT Registry (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace Namespace -> Namespace
f (StateT Registry (KatipContextT IO) a
 -> StateT Registry (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall a b. (a -> b) -> a -> b
$ RegistryT (KatipContextT IO) a
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) a. RegistryT m a -> StateT Registry m a
P.unRegistryT (RidleyOptions -> RegistryT (KatipContextT IO) a
m RidleyOptions
env))

--------------------------------------------------------------------------------
runRidley :: RidleyOptions -> LogEnv -> Ridley a -> IO a
runRidley :: RidleyOptions -> LogEnv -> Ridley a -> IO a
runRidley RidleyOptions
opts LogEnv
le (Ridley ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
ridley) =
  (LogEnv
-> SimpleLogPayload -> Namespace -> KatipContextT IO a -> IO a
forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT LogEnv
le (SimpleLogPayload
forall a. Monoid a => a
mempty :: SimpleLogPayload) Namespace
forall a. Monoid a => a
mempty (KatipContextT IO a -> IO a) -> KatipContextT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ RegistryT (KatipContextT IO) a -> KatipContextT IO a
forall (m :: * -> *) a. Monad m => RegistryT m a -> m a
P.evalRegistryT (RegistryT (KatipContextT IO) a -> KatipContextT IO a)
-> RegistryT (KatipContextT IO) a -> KatipContextT IO a
forall a b. (a -> b) -> a -> b
$ (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyOptions -> RegistryT (KatipContextT IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
ridley) RidleyOptions
opts)