-- | This module defines a type for mutable, integer-valued gauges.
-- Gauges are variable values and can be used to track e.g. the
-- current number of concurrent connections. All operations on gauges
-- are thread-safe.
module System.Metrics.Gauge
    (
      Gauge
    , new
    , read
    , inc
    , dec
    , add
    , subtract
    , set
    ) where

import qualified Data.Atomic as Atomic
import Data.Int (Int64)
import Prelude hiding (subtract, read)

-- | A mutable, integer-valued gauge.
newtype Gauge = C { Gauge -> Atomic
unC :: Atomic.Atomic }

-- | Create a new, zero initialized, gauge.
new :: IO Gauge
new :: IO Gauge
new = Atomic -> Gauge
C (Atomic -> Gauge) -> IO Atomic -> IO Gauge
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int64 -> IO Atomic
Atomic.new Int64
0

-- | Get the current value of the gauge.
read :: Gauge -> IO Int64
read :: Gauge -> IO Int64
read = Atomic -> IO Int64
Atomic.read (Atomic -> IO Int64) -> (Gauge -> Atomic) -> Gauge -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gauge -> Atomic
unC

-- | Increase the gauge by one.
inc :: Gauge -> IO ()
inc :: Gauge -> IO ()
inc Gauge
gauge = Gauge -> Int64 -> IO ()
add Gauge
gauge Int64
1

-- | Decrease the gauge by one.
dec :: Gauge -> IO ()
dec :: Gauge -> IO ()
dec Gauge
gauge = Gauge -> Int64 -> IO ()
subtract Gauge
gauge Int64
1

-- | Increase the gauge by the given amount.
add :: Gauge -> Int64 -> IO ()
add :: Gauge -> Int64 -> IO ()
add Gauge
gauge = Atomic -> Int64 -> IO ()
Atomic.add (Gauge -> Atomic
unC Gauge
gauge)

-- | Decrease the gauge by the given amount.
subtract :: Gauge -> Int64 -> IO ()
subtract :: Gauge -> Int64 -> IO ()
subtract Gauge
gauge = Atomic -> Int64 -> IO ()
Atomic.subtract (Gauge -> Atomic
unC Gauge
gauge)

-- | Set the gauge to the given value.
set :: Gauge -> Int64 -> IO ()
set :: Gauge -> Int64 -> IO ()
set Gauge
gauge = Atomic -> Int64 -> IO ()
Atomic.write (Gauge -> Atomic
unC Gauge
gauge)