-- | Utilities for timing various IO actions and grouping the times by -- dynamically generate labels. module System.Timer ( -- * Abstract Datatype Timer -- * Create a Timer , create -- * Time an action , time -- * Show results , result ) where import Control.Monad.IO.Class import Data.IORef import qualified Data.HashMap.Strict as M import Data.Time.Clock -- import System.CPUTime -- | A @Timer@ is a (reference to) a map from @Tag@ to a @Double@ -- representing the total time associated with that @Tag@. data Timer = Timer {tRef :: IORef (M.HashMap Tag Time) } type Tag = String type Time = NominalDiffTime -------------------------------------------------------------------------------- -- | Create a new timer -------------------------------------------------------------------------------- create :: (MonadIO m) => m Timer -------------------------------------------------------------------------------- create = liftIO $ Timer <$> newIORef M.empty -------------------------------------------------------------------------------- -- | Time a single action -------------------------------------------------------------------------------- time :: (MonadIO m) => Timer -> Tag -> m a -> m a -------------------------------------------------------------------------------- time timer tag act = do (x, t) <- timeAct act liftIO $ update timer tag t return x update :: Timer -> Tag -> Time -> IO () update timer tag n = modifyIORef (tRef timer) bumpTime where bumpTime m = M.insert tag (n + M.lookupDefault 0 tag m) m timeAct :: (MonadIO m) => m a -> m (a, Time) timeAct act = do begin <- liftIO getCurrentTime res <- act end <- liftIO getCurrentTime return (res, diffUTCTime end begin) -------------------------------------------------------------------------------- -- | Output current results -------------------------------------------------------------------------------- result :: (MonadIO m) => Timer -> m [(Tag, Time)] result timer = liftIO $ M.toList <$> readIORef (tRef timer)