module System.Metrics.Prometheus.Metric.Counter
       ( Counter
       , CounterSample (..)
       , new
       , add
       , inc
       , sample
       , addAndSample
       ) where


import           Control.Applicative  ((<$>))
import           Data.Atomics.Counter (AtomicCounter, incrCounter, newCounter)


newtype Counter = Counter { Counter -> AtomicCounter
unCounter :: AtomicCounter }
newtype CounterSample = CounterSample { CounterSample -> Int
unCounterSample :: Int }


new :: IO Counter
new :: IO Counter
new = AtomicCounter -> Counter
Counter (AtomicCounter -> Counter) -> IO AtomicCounter -> IO Counter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO AtomicCounter
newCounter Int
0


addAndSample :: Int -> Counter -> IO CounterSample
addAndSample :: Int -> Counter -> IO CounterSample
addAndSample Int
by | Int
by Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0   = (Int -> CounterSample) -> IO Int -> IO CounterSample
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CounterSample
CounterSample (IO Int -> IO CounterSample)
-> (Counter -> IO Int) -> Counter -> IO CounterSample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AtomicCounter -> IO Int
incrCounter Int
by (AtomicCounter -> IO Int)
-> (Counter -> AtomicCounter) -> Counter -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counter -> AtomicCounter
unCounter
                | Bool
otherwise = [Char] -> Counter -> IO CounterSample
forall a. HasCallStack => [Char] -> a
error [Char]
"must be >= 0"


add :: Int -> Counter -> IO ()
add :: Int -> Counter -> IO ()
add Int
by Counter
c = Int -> Counter -> IO CounterSample
addAndSample Int
by Counter
c IO CounterSample -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


inc :: Counter -> IO ()
inc :: Counter -> IO ()
inc = Int -> Counter -> IO ()
add Int
1


sample :: Counter -> IO CounterSample
sample :: Counter -> IO CounterSample
sample = Int -> Counter -> IO CounterSample
addAndSample Int
0