{-# LANGUAGE BangPatterns #-}
-- | This module defines a type for mutable, string-valued labels.
-- Labels are variable values and can be used to track e.g. the
-- command line arguments or other free-form values. All operations on
-- labels are thread-safe.
module System.Metrics.Label
    (
      Label
    , new
    , read
    , set
    , modify
    ) where

import Data.IORef (IORef, atomicModifyIORef', atomicWriteIORef, newIORef, readIORef)
import qualified Data.Text as T
import Prelude hiding (read)

-- | A mutable, text-valued label.
newtype Label = C { Label -> IORef Text
unC :: IORef T.Text }

-- | Create a new empty label.
new :: IO Label
new :: IO Label
new = IORef Text -> Label
C (IORef Text -> Label) -> IO (IORef Text) -> IO Label
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
T.empty

-- | Get the current value of the label.
read :: Label -> IO T.Text
read :: Label -> IO Text
read = IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef (IORef Text -> IO Text)
-> (Label -> IORef Text) -> Label -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> IORef Text
unC

-- | Set the label to the given value.
set :: Label -> T.Text -> IO ()
set :: Label -> Text -> IO ()
set (C IORef Text
ref) !Text
i = IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Text
ref Text
i

-- | Set the label to the result of applying the given function to the
-- value.
modify :: (T.Text -> T.Text) -> Label -> IO ()
modify :: (Text -> Text) -> Label -> IO ()
modify Text -> Text
f (C IORef Text
ref) = IORef Text -> (Text -> (Text, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Text
ref ((Text -> (Text, ())) -> IO ()) -> (Text -> (Text, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
i -> (Text -> Text
f Text
i, ())