{-# 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