{-# LANGUAGE PolyKinds, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} module System.Metrics.Monad ( MonadMetrics(..) , MetricsT , runMetricsT , Metrics ) where import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Reader import System.Metrics.Monad.Class import System.Metrics.Store newtype MetricsT (m :: k -> *) (a :: k) = MetricsT { MetricsT m a -> MetricsStore -> m a runMetricsT :: MetricsStore -> m a } type Metrics = MetricsT IO instance Functor m => Functor (MetricsT m) where fmap :: (a -> b) -> MetricsT m a -> MetricsT m b fmap a -> b f (MetricsT MetricsStore -> m a m) = (MetricsStore -> m b) -> MetricsT m b forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m b) -> MetricsT m b) -> (MetricsStore -> m b) -> MetricsT m b forall a b. (a -> b) -> a -> b $ (a -> b) -> m a -> m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f (m a -> m b) -> (MetricsStore -> m a) -> MetricsStore -> m b forall b c a. (b -> c) -> (a -> b) -> a -> c . MetricsStore -> m a m instance Applicative m => Applicative (MetricsT m) where pure :: a -> MetricsT m a pure = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (a -> MetricsStore -> m a) -> a -> MetricsT m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m a -> MetricsStore -> m a forall a b. a -> b -> a const (m a -> MetricsStore -> m a) -> (a -> m a) -> a -> MetricsStore -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure (MetricsT MetricsStore -> m (a -> b) fun) <*> :: MetricsT m (a -> b) -> MetricsT m a -> MetricsT m b <*> (MetricsT MetricsStore -> m a val) = (MetricsStore -> m b) -> MetricsT m b forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m b) -> MetricsT m b) -> (MetricsStore -> m b) -> MetricsT m b forall a b. (a -> b) -> a -> b $ \MetricsStore store -> MetricsStore -> m (a -> b) fun MetricsStore store m (a -> b) -> m a -> m b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> MetricsStore -> m a val MetricsStore store instance Monad m => Monad (MetricsT m) where (MetricsT MetricsStore -> m a val) >>= :: MetricsT m a -> (a -> MetricsT m b) -> MetricsT m b >>= a -> MetricsT m b f = (MetricsStore -> m b) -> MetricsT m b forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m b) -> MetricsT m b) -> (MetricsStore -> m b) -> MetricsT m b forall a b. (a -> b) -> a -> b $ \MetricsStore store -> MetricsStore -> m a val MetricsStore store m a -> (a -> m b) -> m b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \a a -> MetricsT m b -> MetricsStore -> m b forall k (m :: k -> *) (a :: k). MetricsT m a -> MetricsStore -> m a runMetricsT (a -> MetricsT m b f a a) MetricsStore store instance MonadIO m => MonadMetrics (MetricsT m) where getTracker :: metric tracker name -> MetricsT m tracker getTracker metric tracker name metric = (MetricsStore -> m tracker) -> MetricsT m tracker forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m tracker) -> MetricsT m tracker) -> (MetricsStore -> m tracker) -> MetricsT m tracker forall a b. (a -> b) -> a -> b $ \MetricsStore store -> IO tracker -> m tracker forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO tracker -> m tracker) -> IO tracker -> m tracker forall a b. (a -> b) -> a -> b $ MetricsStore -> metric tracker name -> IO tracker forall tracker (name :: Symbol) (metric :: * -> Symbol -> *). (TrackerLike tracker, KnownSymbol name, Typeable metric, Ord (metric tracker name)) => MetricsStore -> metric tracker name -> IO tracker getMetricFromStore MetricsStore store metric tracker name metric instance MonadTrans MetricsT where lift :: m a -> MetricsT m a lift m a m = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (MetricsStore -> m a) -> MetricsT m a forall a b. (a -> b) -> a -> b $ m a -> MetricsStore -> m a forall a b. a -> b -> a const m a m instance MonadIO m => MonadIO (MetricsT m) where liftIO :: IO a -> MetricsT m a liftIO IO a act = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (MetricsStore -> m a) -> MetricsT m a forall a b. (a -> b) -> a -> b $ m a -> MetricsStore -> m a forall a b. a -> b -> a const (m a -> MetricsStore -> m a) -> m a -> MetricsStore -> m a forall a b. (a -> b) -> a -> b $ IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO a act instance MonadReader r m => MonadReader r (MetricsT m) where ask :: MetricsT m r ask = (MetricsStore -> m r) -> MetricsT m r forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m r) -> MetricsT m r) -> (MetricsStore -> m r) -> MetricsT m r forall a b. (a -> b) -> a -> b $ m r -> MetricsStore -> m r forall a b. a -> b -> a const m r forall r (m :: * -> *). MonadReader r m => m r ask reader :: (r -> a) -> MetricsT m a reader r -> a f = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (MetricsStore -> m a) -> MetricsT m a forall a b. (a -> b) -> a -> b $ m a -> MetricsStore -> m a forall a b. a -> b -> a const (m a -> MetricsStore -> m a) -> m a -> MetricsStore -> m a forall a b. (a -> b) -> a -> b $ (r -> a) -> m a forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a reader r -> a f local :: (r -> r) -> MetricsT m a -> MetricsT m a local r -> r m (MetricsT MetricsStore -> m a rFun) = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (MetricsStore -> m a) -> MetricsT m a forall a b. (a -> b) -> a -> b $ (r -> r) -> m a -> m a forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local r -> r m (m a -> m a) -> (MetricsStore -> m a) -> MetricsStore -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . MetricsStore -> m a rFun instance MonadThrow m => MonadThrow (MetricsT m) where throwM :: e -> MetricsT m a throwM e ex = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (MetricsStore -> m a) -> MetricsT m a forall a b. (a -> b) -> a -> b $ m a -> MetricsStore -> m a forall a b. a -> b -> a const (m a -> MetricsStore -> m a) -> m a -> MetricsStore -> m a forall a b. (a -> b) -> a -> b $ e -> m a forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a throwM e ex instance MonadCatch m => MonadCatch (MetricsT m) where catch :: MetricsT m a -> (e -> MetricsT m a) -> MetricsT m a catch (MetricsT MetricsStore -> m a act) e -> MetricsT m a handler = (MetricsStore -> m a) -> MetricsT m a forall k (m :: k -> *) (a :: k). (MetricsStore -> m a) -> MetricsT m a MetricsT ((MetricsStore -> m a) -> MetricsT m a) -> (MetricsStore -> m a) -> MetricsT m a forall a b. (a -> b) -> a -> b $ \MetricsStore store -> m a -> (e -> m a) -> m a forall (m :: * -> *) e a. (MonadCatch m, Exception e) => m a -> (e -> m a) -> m a catch (MetricsStore -> m a act MetricsStore store) ((e -> m a) -> m a) -> (e -> m a) -> m a forall a b. (a -> b) -> a -> b $ \e ex -> MetricsT m a -> MetricsStore -> m a forall k (m :: k -> *) (a :: k). MetricsT m a -> MetricsStore -> m a runMetricsT (e -> MetricsT m a handler e ex) MetricsStore store