{-|
Module      : Control.Monad.Metrics.Internal
Description : An easy interface to recording metrics.
Copyright   : (c) Matt Parsons, 2017
                  Taylor Fausak, 2016
License     : MIT
Maintainer  : parsonsmatt@gmail.com
Stability   : experimental
Portability : POSIX

This is an internal module. Depend upon it at your own risk -- breaking
changes in here will /not/ be reflected in the major API version.

-}
module Control.Monad.Metrics.Internal where

import           Data.HashMap.Strict         (HashMap)
import           Data.IORef
import           Data.Text                   (Text)
import           Lens.Micro                  (Lens')
import           System.Clock                (TimeSpec (..))
import           System.Metrics              (Store)
import           System.Metrics.Counter      (Counter)
import           System.Metrics.Distribution (Distribution)
import           System.Metrics.Gauge        (Gauge)
import           System.Metrics.Label        (Label)

-- | A container for metrics used by the 'MonadMetrics' class.
--
-- * /Since v0.1.0.0/
data Metrics = Metrics
    { Metrics -> IORef (HashMap Text Counter)
_metricsCounters      :: IORef (HashMap Text Counter)
    , Metrics -> IORef (HashMap Text Gauge)
_metricsGauges        :: IORef (HashMap Text Gauge)
    , Metrics -> IORef (HashMap Text Distribution)
_metricsDistributions :: IORef (HashMap Text Distribution)
    , Metrics -> IORef (HashMap Text Label)
_metricsLabels        :: IORef (HashMap Text Label)
    , Metrics -> Store
_metricsStore         :: Store
    }

-- | A lens into the 'Counter's provided by the 'Metrics'.
--
-- * /Since v0.1.0.0/
metricsCounters :: Lens' Metrics (IORef (HashMap Text Counter))
metricsCounters :: Lens' Metrics (IORef (HashMap Text Counter))
metricsCounters IORef (HashMap Text Counter) -> f (IORef (HashMap Text Counter))
f (Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) = (IORef (HashMap Text Counter) -> Metrics)
-> f (IORef (HashMap Text Counter)) -> f Metrics
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IORef (HashMap Text Counter)
c' -> IORef (HashMap Text Counter)
-> IORef (HashMap Text Gauge)
-> IORef (HashMap Text Distribution)
-> IORef (HashMap Text Label)
-> Store
-> Metrics
Metrics IORef (HashMap Text Counter)
c' IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) (IORef (HashMap Text Counter) -> f (IORef (HashMap Text Counter))
f IORef (HashMap Text Counter)
c)

-- | A lens into the 'Gauge's provided by the 'Metrics'.
--
-- * /Since v0.1.0.0/
metricsGauges :: Lens' Metrics (IORef (HashMap Text Gauge))
metricsGauges :: Lens' Metrics (IORef (HashMap Text Gauge))
metricsGauges IORef (HashMap Text Gauge) -> f (IORef (HashMap Text Gauge))
f (Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) = (IORef (HashMap Text Gauge) -> Metrics)
-> f (IORef (HashMap Text Gauge)) -> f Metrics
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IORef (HashMap Text Gauge)
g' -> IORef (HashMap Text Counter)
-> IORef (HashMap Text Gauge)
-> IORef (HashMap Text Distribution)
-> IORef (HashMap Text Label)
-> Store
-> Metrics
Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g' IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) (IORef (HashMap Text Gauge) -> f (IORef (HashMap Text Gauge))
f IORef (HashMap Text Gauge)
g)

-- | A lens into the 'Distribution's provided by the 'Metrics'.
--
-- * /Since v0.1.0.0/
metricsDistributions :: Lens' Metrics (IORef (HashMap Text Distribution))
metricsDistributions :: Lens' Metrics (IORef (HashMap Text Distribution))
metricsDistributions IORef (HashMap Text Distribution)
-> f (IORef (HashMap Text Distribution))
f (Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) = (IORef (HashMap Text Distribution) -> Metrics)
-> f (IORef (HashMap Text Distribution)) -> f Metrics
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IORef (HashMap Text Distribution)
d' -> IORef (HashMap Text Counter)
-> IORef (HashMap Text Gauge)
-> IORef (HashMap Text Distribution)
-> IORef (HashMap Text Label)
-> Store
-> Metrics
Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d' IORef (HashMap Text Label)
l Store
s) (IORef (HashMap Text Distribution)
-> f (IORef (HashMap Text Distribution))
f IORef (HashMap Text Distribution)
d)

-- | A lens into the 'Label's provided by the 'Metrics'.
--
-- * /Since v0.1.0.0/
metricsLabels :: Lens' Metrics (IORef (HashMap Text Label))
metricsLabels :: Lens' Metrics (IORef (HashMap Text Label))
metricsLabels IORef (HashMap Text Label) -> f (IORef (HashMap Text Label))
f (Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) = (IORef (HashMap Text Label) -> Metrics)
-> f (IORef (HashMap Text Label)) -> f Metrics
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IORef (HashMap Text Label)
l' -> IORef (HashMap Text Counter)
-> IORef (HashMap Text Gauge)
-> IORef (HashMap Text Distribution)
-> IORef (HashMap Text Label)
-> Store
-> Metrics
Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l' Store
s) (IORef (HashMap Text Label) -> f (IORef (HashMap Text Label))
f IORef (HashMap Text Label)
l)

-- | A lens into the 'Store' provided by the 'Metrics'.
--
-- * /Since v0.1.0.0/
metricsStore :: Lens' Metrics Store
metricsStore :: Lens' Metrics Store
metricsStore Store -> f Store
f (Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l Store
s) = (Store -> Metrics) -> f Store -> f Metrics
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IORef (HashMap Text Counter)
-> IORef (HashMap Text Gauge)
-> IORef (HashMap Text Distribution)
-> IORef (HashMap Text Label)
-> Store
-> Metrics
Metrics IORef (HashMap Text Counter)
c IORef (HashMap Text Gauge)
g IORef (HashMap Text Distribution)
d IORef (HashMap Text Label)
l) (Store -> f Store
f Store
s)

-- | A type representing the resolution of time to use for the 'timed'
-- metric.
--
-- * /Since v0.1.0.0/
data Resolution
    = Nanoseconds
    | Microseconds
    | Milliseconds
    | Seconds
    | Minutes
    | Hours
    | Days
    deriving (Resolution -> Resolution -> Bool
(Resolution -> Resolution -> Bool)
-> (Resolution -> Resolution -> Bool) -> Eq Resolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Resolution -> Resolution -> Bool
== :: Resolution -> Resolution -> Bool
$c/= :: Resolution -> Resolution -> Bool
/= :: Resolution -> Resolution -> Bool
Eq, Int -> Resolution -> ShowS
[Resolution] -> ShowS
Resolution -> String
(Int -> Resolution -> ShowS)
-> (Resolution -> String)
-> ([Resolution] -> ShowS)
-> Show Resolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Resolution -> ShowS
showsPrec :: Int -> Resolution -> ShowS
$cshow :: Resolution -> String
show :: Resolution -> String
$cshowList :: [Resolution] -> ShowS
showList :: [Resolution] -> ShowS
Show, Eq Resolution
Eq Resolution =>
(Resolution -> Resolution -> Ordering)
-> (Resolution -> Resolution -> Bool)
-> (Resolution -> Resolution -> Bool)
-> (Resolution -> Resolution -> Bool)
-> (Resolution -> Resolution -> Bool)
-> (Resolution -> Resolution -> Resolution)
-> (Resolution -> Resolution -> Resolution)
-> Ord Resolution
Resolution -> Resolution -> Bool
Resolution -> Resolution -> Ordering
Resolution -> Resolution -> Resolution
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Resolution -> Resolution -> Ordering
compare :: Resolution -> Resolution -> Ordering
$c< :: Resolution -> Resolution -> Bool
< :: Resolution -> Resolution -> Bool
$c<= :: Resolution -> Resolution -> Bool
<= :: Resolution -> Resolution -> Bool
$c> :: Resolution -> Resolution -> Bool
> :: Resolution -> Resolution -> Bool
$c>= :: Resolution -> Resolution -> Bool
>= :: Resolution -> Resolution -> Bool
$cmax :: Resolution -> Resolution -> Resolution
max :: Resolution -> Resolution -> Resolution
$cmin :: Resolution -> Resolution -> Resolution
min :: Resolution -> Resolution -> Resolution
Ord, Int -> Resolution
Resolution -> Int
Resolution -> [Resolution]
Resolution -> Resolution
Resolution -> Resolution -> [Resolution]
Resolution -> Resolution -> Resolution -> [Resolution]
(Resolution -> Resolution)
-> (Resolution -> Resolution)
-> (Int -> Resolution)
-> (Resolution -> Int)
-> (Resolution -> [Resolution])
-> (Resolution -> Resolution -> [Resolution])
-> (Resolution -> Resolution -> [Resolution])
-> (Resolution -> Resolution -> Resolution -> [Resolution])
-> Enum Resolution
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Resolution -> Resolution
succ :: Resolution -> Resolution
$cpred :: Resolution -> Resolution
pred :: Resolution -> Resolution
$ctoEnum :: Int -> Resolution
toEnum :: Int -> Resolution
$cfromEnum :: Resolution -> Int
fromEnum :: Resolution -> Int
$cenumFrom :: Resolution -> [Resolution]
enumFrom :: Resolution -> [Resolution]
$cenumFromThen :: Resolution -> Resolution -> [Resolution]
enumFromThen :: Resolution -> Resolution -> [Resolution]
$cenumFromTo :: Resolution -> Resolution -> [Resolution]
enumFromTo :: Resolution -> Resolution -> [Resolution]
$cenumFromThenTo :: Resolution -> Resolution -> Resolution -> [Resolution]
enumFromThenTo :: Resolution -> Resolution -> Resolution -> [Resolution]
Enum)

diffTime :: Resolution -> TimeSpec -> TimeSpec -> Double
diffTime :: Resolution -> TimeSpec -> TimeSpec -> Double
diffTime Resolution
res (TimeSpec Int64
seca Int64
nseca) (TimeSpec Int64
secb Int64
nsecb) =
    let sec' :: Int64
sec' = Int64
seca Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
secb
        nsec' :: Int64
nsec' = Int64
nseca Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
nsecb
     in Resolution -> TimeSpec -> Double
convertTimeSpecTo Resolution
res (Int64 -> Int64 -> TimeSpec
TimeSpec Int64
sec' Int64
nsec')

convertTimeSpecTo :: Resolution -> TimeSpec -> Double
convertTimeSpecTo :: Resolution -> TimeSpec -> Double
convertTimeSpecTo Resolution
res (TimeSpec Int64
secs' Int64
nsecs') =
    case Resolution
res of
        Resolution
Nanoseconds  -> Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
sToNs Double
secs
        Resolution
Microseconds -> Double -> Double
nsToUs Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
sToUs Double
secs
        Resolution
Milliseconds -> Double -> Double
nsToMs Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
sToMs Double
secs
        Resolution
Seconds      -> Double -> Double
nsToS Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
secs
        Resolution
Minutes      -> Double -> Double
sToMin (Double -> Double
nsToS Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
secs)
        Resolution
Hours        -> Double -> Double
sToHour (Double -> Double
nsToS Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
secs)
        Resolution
Days         -> Double -> Double
sToDay (Double -> Double
nsToS Double
nsecs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
secs)
  where
    nsecs :: Double
nsecs = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nsecs'
    secs :: Double
secs = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
secs'

nsToUs, nsToMs, nsToS, sToMin, sToHour, sToDay, sToNs, sToUs, sToMs :: Double -> Double
nsToUs :: Double -> Double
nsToUs = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3 :: Int))
nsToMs :: Double -> Double
nsToMs = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int))
nsToS :: Double -> Double
nsToS = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int))
sToMin :: Double -> Double
sToMin = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60)
sToHour :: Double -> Double
sToHour = Double -> Double
sToMin (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
sToMin
sToDay :: Double -> Double
sToDay = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
24) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
sToHour
sToNs :: Double -> Double
sToNs = (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int))
sToUs :: Double -> Double
sToUs = (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int))
sToMs :: Double -> Double
sToMs = (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3 :: Int))