{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Prometheus.MonadMonitor (
    MonadMonitor (..)
,   Monitor
,   runMonitor
,   MonitorT
,   runMonitorT
) where

import Control.Applicative (Applicative)
import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Class (MonadTrans)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Identity (IdentityT)
import Control.Monad.Trans.Maybe (MaybeT)
import qualified Control.Monad.Trans.RWS.Lazy as L
import qualified Control.Monad.Trans.RWS.Strict as S
import Control.Monad.Trans.Reader (ReaderT)
import qualified Control.Monad.Trans.State.Lazy as L
import qualified Control.Monad.Trans.State.Strict as S
import qualified Control.Monad.Trans.Writer.Lazy as L
import qualified Control.Monad.Trans.Writer.Strict as S
import Control.Monad.Writer.Strict (WriterT, runWriterT, tell)
import Data.Monoid (Monoid)


-- | MonadMonitor describes a class of Monads that are capable of performing
-- asynchronous IO operations.
class Monad m => MonadMonitor m where
    doIO :: IO () -> m ()
    default doIO :: (MonadTrans t, MonadMonitor n, m ~ t n) => IO () -> m ()
    doIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadMonitor m => IO () -> m ()
doIO

instance MonadMonitor IO where
    doIO :: IO () -> IO ()
doIO = forall a. a -> a
id

instance (MonadMonitor m) => MonadMonitor (ExceptT e m)
instance (MonadMonitor m) => MonadMonitor (IdentityT m)
instance (MonadMonitor m) => MonadMonitor (MaybeT m)
instance (MonadMonitor m, Monoid w) => MonadMonitor (L.RWST r w s m)
instance (MonadMonitor m, Monoid w) => MonadMonitor (S.RWST r w s m) 
instance (MonadMonitor m) => MonadMonitor (ReaderT r m)
instance (MonadMonitor m) => MonadMonitor (L.StateT s m)
instance (MonadMonitor m) => MonadMonitor (S.StateT s m) 
instance (MonadMonitor m, Monoid w) => MonadMonitor (L.WriterT w m)
instance (MonadMonitor m, Monoid w) => MonadMonitor (S.WriterT w m) 

-- | Monitor allows the use of Prometheus metrics in pure code. When using
-- Monitor, all of the metric operations will be collected and queued into
-- a single IO () value that can be run from impure code.
--
-- Because all of the operations are performed asynchronously use of this class
-- is not recommended for use with metrics that are time sensitive (e.g. for
-- measuring latency).
type Monitor a = MonitorT Identity a

-- | MonitorT is the monad transformer analog of Monitor and allows for
-- monitoring pure monad transformer stacks.
newtype MonitorT m a = MkMonitorT (WriterT [IO ()] m a)
    deriving (forall a. a -> MonitorT m a
forall a b. MonitorT m a -> MonitorT m b -> MonitorT m a
forall a b. MonitorT m a -> MonitorT m b -> MonitorT m b
forall a b. MonitorT m (a -> b) -> MonitorT m a -> MonitorT m b
forall a b c.
(a -> b -> c) -> MonitorT m a -> MonitorT m b -> MonitorT 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
forall {m :: * -> *}. Applicative m => Functor (MonitorT m)
forall (m :: * -> *) a. Applicative m => a -> MonitorT m a
forall (m :: * -> *) a b.
Applicative m =>
MonitorT m a -> MonitorT m b -> MonitorT m a
forall (m :: * -> *) a b.
Applicative m =>
MonitorT m a -> MonitorT m b -> MonitorT m b
forall (m :: * -> *) a b.
Applicative m =>
MonitorT m (a -> b) -> MonitorT m a -> MonitorT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MonitorT m a -> MonitorT m b -> MonitorT m c
<* :: forall a b. MonitorT m a -> MonitorT m b -> MonitorT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MonitorT m a -> MonitorT m b -> MonitorT m a
*> :: forall a b. MonitorT m a -> MonitorT m b -> MonitorT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MonitorT m a -> MonitorT m b -> MonitorT m b
liftA2 :: forall a b c.
(a -> b -> c) -> MonitorT m a -> MonitorT m b -> MonitorT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MonitorT m a -> MonitorT m b -> MonitorT m c
<*> :: forall a b. MonitorT m (a -> b) -> MonitorT m a -> MonitorT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MonitorT m (a -> b) -> MonitorT m a -> MonitorT m b
pure :: forall a. a -> MonitorT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MonitorT m a
Applicative, forall a b. a -> MonitorT m b -> MonitorT m a
forall a b. (a -> b) -> MonitorT m a -> MonitorT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MonitorT m b -> MonitorT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonitorT m a -> MonitorT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MonitorT m b -> MonitorT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MonitorT m b -> MonitorT m a
fmap :: forall a b. (a -> b) -> MonitorT m a -> MonitorT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonitorT m a -> MonitorT m b
Functor, forall a. a -> MonitorT m a
forall a b. MonitorT m a -> MonitorT m b -> MonitorT m b
forall a b. MonitorT m a -> (a -> MonitorT m b) -> MonitorT m b
forall {m :: * -> *}. Monad m => Applicative (MonitorT m)
forall (m :: * -> *) a. Monad m => a -> MonitorT m a
forall (m :: * -> *) a b.
Monad m =>
MonitorT m a -> MonitorT m b -> MonitorT m b
forall (m :: * -> *) a b.
Monad m =>
MonitorT m a -> (a -> MonitorT m b) -> MonitorT 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
return :: forall a. a -> MonitorT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MonitorT m a
>> :: forall a b. MonitorT m a -> MonitorT m b -> MonitorT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MonitorT m a -> MonitorT m b -> MonitorT m b
>>= :: forall a b. MonitorT m a -> (a -> MonitorT m b) -> MonitorT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MonitorT m a -> (a -> MonitorT m b) -> MonitorT m b
Monad, forall (m :: * -> *) a. Monad m => m a -> MonitorT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> MonitorT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> MonitorT m a
MonadTrans)

instance Monad m => MonadMonitor (MonitorT m) where
    doIO :: IO () -> MonitorT m ()
doIO IO ()
f = forall (m :: * -> *) a. WriterT [IO ()] m a -> MonitorT m a
MkMonitorT forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [IO ()
f]

-- | Extract a value and the corresponding monitor update value from the Monitor
-- monad. For an example use see 'Monitor'.
runMonitor :: Monitor a -> (a, IO ())
runMonitor :: forall a. Monitor a -> (a, IO ())
runMonitor Monitor a
a = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => MonitorT m a -> m (a, IO ())
runMonitorT Monitor a
a

-- | Extract a value and the corresponding monitor update value from the
-- MonitorT monad transformer.
runMonitorT :: Monad m => MonitorT m a -> m (a, IO ())
runMonitorT :: forall (m :: * -> *) a. Monad m => MonitorT m a -> m (a, IO ())
runMonitorT (MkMonitorT WriterT [IO ()] m a
writerT) = do
    (a
v, [IO ()]
operations) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT [IO ()] m a
writerT
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [IO ()]
operations)