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

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


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


new :: IO Counter
new :: IO Counter
new = AtomicCounter -> Counter
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 forall a. Ord a => a -> a -> Bool
>= Int
0 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CounterSample
CounterSample forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AtomicCounter -> IO Int
incrCounter Int
by forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counter -> AtomicCounter
unCounter
    | Bool
otherwise = 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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


-- | Write @i@ to the counter, if @i@ is more than the current value. This is
-- useful for when the count is maintained by a separate system (e.g. GHC's GC
-- counter).
--
-- WARNING: For multiple writers, the most recent one wins, which may not
-- preserve the increasing property. If you have stronger requirements than this,
-- please check with the maintainers. 
-- See <https://github.com/bitnomial/prometheus/pull/44> for discussion.
set :: Int -> Counter -> IO ()
set :: Int -> Counter -> IO ()
set Int
i (Counter AtomicCounter
c) = AtomicCounter -> Int -> IO ()
writeCounter AtomicCounter
c Int
i