{-# 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
, openFDWarningTreshold
, runHandler
, ioLogger
, getRidleyOptions
, noUpdate
) where
import Control.Concurrent (ThreadId)
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Reader (MonadReader)
import Control.Monad.State.Strict
import Control.Monad.Trans.Reader
import Data.Time
import GHC.Stack
import Katip
import Lens.Micro.TH
import Network.Wai.Metrics (WaiMetrics)
import System.Metrics.Prometheus.Ridley.Types.Internal
import System.Remote.Monitoring.Prometheus
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified System.Metrics.Prometheus.MetricId as P
import qualified System.Metrics.Prometheus.RegistryT as P
type Port = Int
type PrometheusOptions = AdapterOptions
mkRidleyMetricHandler :: forall c. HasCallStack
=> T.Text
-> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler :: forall c.
HasCallStack =>
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 {
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
| Network
| Wai
| DiskUsage
| CustomMetric !T.Text
!(Maybe Int)
(Ridley RidleyMetricHandler)
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
_ Ridley 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
_ Ridley RidleyMetricHandler
_) (CustomMetric Text
n2 Maybe Int
_ Ridley 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
_ Ridley 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
_ Ridley 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
, RidleyOptions -> Int
_openFDWarningTreshold :: !Int
}
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 :: 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
, _openFDWarningTreshold :: Int
_openFDWarningTreshold = Int
100
}
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 { forall (t :: * -> *) a. RidleyT t a -> ReaderT RidleyOptions t a
_unRidley :: ReaderT RidleyOptions t a }
deriving ((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
$cfmap :: forall (t :: * -> *) a b.
Functor t =>
(a -> b) -> RidleyT t a -> RidleyT t b
fmap :: forall a b. (a -> b) -> RidleyT t a -> RidleyT t b
$c<$ :: forall (t :: * -> *) a b.
Functor t =>
a -> RidleyT t b -> RidleyT t a
<$ :: forall a b. a -> RidleyT t b -> RidleyT t a
Functor, Functor (RidleyT t)
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)
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
$cpure :: forall (t :: * -> *) a. Applicative t => a -> RidleyT t a
pure :: forall a. a -> RidleyT t a
$c<*> :: forall (t :: * -> *) a b.
Applicative t =>
RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
<*> :: forall a b. RidleyT t (a -> b) -> RidleyT t a -> RidleyT t b
$cliftA2 :: forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c
liftA2 :: forall a b c.
(a -> b -> c) -> RidleyT t a -> RidleyT t b -> RidleyT t c
$c*> :: forall (t :: * -> *) a b.
Applicative t =>
RidleyT t a -> RidleyT t b -> RidleyT t b
*> :: forall a b. RidleyT t a -> RidleyT t b -> RidleyT t b
$c<* :: forall (t :: * -> *) a b.
Applicative t =>
RidleyT t a -> RidleyT t b -> RidleyT t a
<* :: forall a b. RidleyT t a -> RidleyT t b -> RidleyT t a
Applicative, Applicative (RidleyT t)
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)
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
$c>>= :: forall (t :: * -> *) a b.
Monad t =>
RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b
>>= :: forall a b. RidleyT t a -> (a -> RidleyT t b) -> RidleyT t b
$c>> :: forall (t :: * -> *) a b.
Monad t =>
RidleyT t a -> RidleyT t b -> RidleyT t b
>> :: forall a b. RidleyT t a -> RidleyT t b -> RidleyT t b
$creturn :: forall (t :: * -> *) a. Monad t => a -> RidleyT t a
return :: forall a. a -> RidleyT t a
Monad, MonadReader RidleyOptions, Monad (RidleyT t)
Monad (RidleyT t) =>
(forall a. IO a -> RidleyT t a) -> MonadIO (RidleyT t)
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
$cliftIO :: forall (t :: * -> *) a. MonadIO t => IO a -> RidleyT t a
liftIO :: forall a. IO a -> RidleyT t a
MonadIO, (forall (t :: * -> *). Monad t => Monad (RidleyT t)) =>
(forall (m :: * -> *) a. Monad m => m a -> RidleyT m a)
-> MonadTrans RidleyT
forall (t :: * -> *). Monad t => Monad (RidleyT t)
forall (m :: * -> *) a. Monad m => m a -> RidleyT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> RidleyT m a
lift :: 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
}
instance MonadThrow Ridley where
throwM :: forall e a. (HasCallStack, Exception e) => e -> Ridley a
throwM e
e = ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) 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
_ -> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall (m :: * -> *) a. StateT Registry m a -> RegistryT m a
P.RegistryT (StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall a b. (a -> b) -> a -> b
$ (Registry -> KatipContextT IO (a, Registry))
-> StateT Registry (KatipContextT IO) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Registry -> KatipContextT IO (a, Registry))
-> StateT Registry (KatipContextT IO) a)
-> (Registry -> KatipContextT IO (a, Registry))
-> StateT Registry (KatipContextT IO) a
forall a b. (a -> b) -> a -> b
$ \Registry
_ -> e -> KatipContextT IO (a, Registry)
forall e a. (HasCallStack, Exception e) => e -> KatipContextT IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance MonadCatch Ridley where
catch :: forall e a.
(HasCallStack, Exception e) =>
Ridley a -> (e -> Ridley a) -> Ridley a
catch Ridley a
r e -> Ridley a
handler =
let unwrap :: RidleyOptions -> RidleyT (RegistryT m) a -> StateT Registry m a
unwrap RidleyOptions
opts = RegistryT m a -> StateT Registry m a
forall (m :: * -> *) a. RegistryT m a -> StateT Registry m a
P.unRegistryT (RegistryT m a -> StateT Registry m a)
-> (RidleyT (RegistryT m) a -> RegistryT m a)
-> RidleyT (RegistryT m) a
-> StateT Registry m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT RidleyOptions (RegistryT m) a
-> RidleyOptions -> RegistryT m a)
-> RidleyOptions
-> ReaderT RidleyOptions (RegistryT m) a
-> RegistryT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT RidleyOptions (RegistryT m) a
-> RidleyOptions -> RegistryT m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT RidleyOptions
opts (ReaderT RidleyOptions (RegistryT m) a -> RegistryT m a)
-> (RidleyT (RegistryT m) a
-> ReaderT RidleyOptions (RegistryT m) a)
-> RidleyT (RegistryT m) a
-> RegistryT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RidleyT (RegistryT m) a -> ReaderT RidleyOptions (RegistryT m) a
forall (t :: * -> *) a. RidleyT t a -> ReaderT RidleyOptions t a
_unRidley
in 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
opts -> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall (m :: * -> *) a. StateT Registry m a -> RegistryT m a
P.RegistryT (StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
-> RegistryT (KatipContextT IO) a
forall a b. (a -> b) -> a -> b
$ StateT Registry (KatipContextT IO) a
-> (e -> StateT Registry (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
forall e a.
(HasCallStack, Exception e) =>
StateT Registry (KatipContextT IO) a
-> (e -> StateT Registry (KatipContextT IO) a)
-> StateT Registry (KatipContextT IO) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (RidleyOptions -> Ridley a -> StateT Registry (KatipContextT IO) a
forall {m :: * -> *} {a}.
RidleyOptions -> RidleyT (RegistryT m) a -> StateT Registry m a
unwrap RidleyOptions
opts Ridley a
r) (RidleyOptions -> Ridley a -> StateT Registry (KatipContextT IO) a
forall {m :: * -> *} {a}.
RidleyOptions -> RidleyT (RegistryT m) a -> StateT Registry m a
unwrap RidleyOptions
opts (Ridley a -> StateT Registry (KatipContextT IO) a)
-> (e -> Ridley a) -> e -> StateT Registry (KatipContextT IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Ridley a
handler)
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 (m :: * -> *) a. Monad m => m a -> ReaderT RidleyOptions m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (KatipContextT IO LogEnv -> RegistryT (KatipContextT IO) LogEnv
forall (m :: * -> *) a. Monad m => m a -> RegistryT m a
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 :: forall a. (LogEnv -> LogEnv) -> Ridley a -> Ridley a
localLogEnv LogEnv -> LogEnv
f (Ridley (ReaderT RidleyOptions -> RegistryT (KatipContextT IO) a
m)) =
ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) 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 a.
(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 a. a -> RidleyT (RegistryT (KatipContextT IO)) a
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 (m :: * -> *) a. Monad m => m a -> ReaderT RidleyOptions m a
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 (m :: * -> *) a. Monad m => m a -> RegistryT m a
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 :: forall a. (LogContexts -> LogContexts) -> Ridley a -> Ridley a
localKatipContext LogContexts -> LogContexts
f (Ridley (ReaderT RidleyOptions -> RegistryT (KatipContextT IO) a
m)) =
ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) 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 a.
(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 :: forall a. (Namespace -> Namespace) -> Ridley a -> Ridley a
localKatipNamespace Namespace -> Namespace
f (Ridley (ReaderT RidleyOptions -> RegistryT (KatipContextT IO) a
m)) =
ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley (ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) a)
-> ReaderT RidleyOptions (RegistryT (KatipContextT IO)) a
-> RidleyT (RegistryT (KatipContextT IO)) 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 a.
(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 :: forall a. 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)
ioLogger :: Ridley Logger
ioLogger :: Ridley Logger
ioLogger = do
LogEnv
le <- Ridley LogEnv
forall (m :: * -> *). Katip m => m LogEnv
getLogEnv
LogContexts
ctx <- Ridley LogContexts
forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
Namespace
ns <- Ridley Namespace
forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
Logger -> Ridley Logger
forall a. a -> RidleyT (RegistryT (KatipContextT IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Logger -> Ridley Logger) -> Logger -> Ridley Logger
forall a b. (a -> b) -> a -> b
$ \Severity
sev Text
txt -> LogEnv -> LogContexts -> Namespace -> KatipContextT IO () -> IO ()
forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT LogEnv
le LogContexts
ctx Namespace
ns (KatipContextT IO () -> IO ()) -> KatipContextT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Severity -> LogStr -> KatipContextT IO ()
forall (m :: * -> *).
(Applicative m, KatipContext m, HasCallStack) =>
Severity -> LogStr -> m ()
logLocM Severity
sev (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls Text
txt)
getRidleyOptions :: Ridley RidleyOptions
getRidleyOptions :: Ridley RidleyOptions
getRidleyOptions = ReaderT RidleyOptions (RegistryT (KatipContextT IO)) RidleyOptions
-> Ridley RidleyOptions
forall (t :: * -> *) a. ReaderT RidleyOptions t a -> RidleyT t a
Ridley ReaderT RidleyOptions (RegistryT (KatipContextT IO)) RidleyOptions
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
noUpdate :: c -> Bool -> IO ()
noUpdate :: forall c. c -> Bool -> IO ()
noUpdate c
_ Bool
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
makeLenses ''RidleyCtx
makeLenses ''RidleyOptions