timestats 0.1.1 → 0.1.2

raw patch · 4 files changed

+44/−19 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• src/Debug/TimeStats.hs +36/−15
• tests/Main.hs +3/−3
• timestats.cabal +1/−1

@@ -1,5 +1,9 @@ # Revision history for timestats +## 0.1.2 -- 2024-05-17++* Change the type of `measureM` to work in any monad (not only MonadIO instances).+ ## 0.1.1 -- 2023-11-05  * Format counts with a thousand separator

@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ -- | A module to collect aggregates on how much time is spent in a computation -- -- Aggregates can be identified with a label that determines where the time of@@ -31,7 +33,6 @@  import Control.Exception (evaluate) import Control.Monad (forM, forM_, unless)-import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.IORef import Data.Map (Map) import Data.Maybe (isJust)@@ -66,7 +67,7 @@ -- evaluated. -- {-# INLINE measureM #-}-measureM :: MonadIO m => String -> m a -> m a+measureM :: Monad m => String -> m a -> m a measureM label =     -- See the documentation of 'enabled'     if enabled then do@@ -125,8 +126,8 @@ labelStatsMapRef = unsafePerformIO $ newIORef Map.empty  -- | Set all statistics to initial values.-reset :: MonadIO m => m ()-reset = liftIO $+reset :: Monad m => m ()+reset = intersperseIOinM $     if enabled then do       m <- readIORef labelStatsMapRef       forM_ (Map.elems m) $ \(TimeStatsRef ref) ->@@ -136,7 +137,7 @@  -- | Run an action by previously reseting all stats to initial values -- and printing them afterwards.-scope :: MonadIO m => m a -> m a+scope :: Monad m => m a -> m a scope =     if enabled then       \m -> do@@ -159,21 +160,21 @@         Just r -> (m, r)  -- | Yields the labels and the stats collected thus far.-collect :: MonadIO m => m [(String, TimeStats)]-collect = liftIO $ do+collect :: Monad m => m [(String, TimeStats)]+collect = intersperseIOinM $ do     m <- readIORef labelStatsMapRef     forM (Map.toList m) $ \(label, TimeStatsRef ref) ->       (,) label <$> readIORef ref  -- | Prints the time stats to the given handle.-hPrintTimeStats :: MonadIO m => Handle -> m ()-hPrintTimeStats h = liftIO $ do+hPrintTimeStats :: Monad m => Handle -> m ()+hPrintTimeStats h = intersperseIOinM $ do     xs <- collect     unless (null xs) $       Text.hPutStrLn h (asText xs)  -- | Prints the time stats to stderr.-printTimeStats :: MonadIO m => m ()+printTimeStats :: Monad m => m () printTimeStats = hPrintTimeStats stderr  -- | Renders the given time stats in a tabular format@@ -224,16 +225,16 @@ initialTimeStats = TimeStats 0 0  -- | Creates a reference to time stats with intial values-newTimeStatsRef :: MonadIO m => m TimeStatsRef-newTimeStatsRef = liftIO $ TimeStatsRef <$> newIORef initialTimeStats+newTimeStatsRef :: Monad m => m TimeStatsRef+newTimeStatsRef = intersperseIOinM $ TimeStatsRef <$> newIORef initialTimeStats  -- | Measure the time it takes to run the given action and update with it -- the given reference to time stats.-measureMWith :: MonadIO m => TimeStatsRef -> m a -> m a+measureMWith :: Monad m => TimeStatsRef -> m a -> m a measureMWith tref m = do-    t0 <- liftIO getMonotonicTimeNSec+    t0 <- intersperseIOinM getMonotonicTimeNSec     a <- m-    liftIO $ do+    intersperseIOinM $ do       tf <- getMonotonicTimeNSec       updateTimeStatsRef tref $ \st ->         st@@ -246,3 +247,23 @@ updateTimeStatsRef :: TimeStatsRef -> (TimeStats -> TimeStats) -> IO () updateTimeStatsRef (TimeStatsRef ref) f =     atomicModifyIORef' ref $ \st -> (f st, ())++---------------------+-- intersperseIOinM+---------------------++-- | Hack to intersperse IO actions into any monad+intersperseIOinM :: forall a m. Monad m => IO a -> m a+intersperseIOinM m = do+    -- The ficticious state is only used to force unsafePerformIO to run @m@+    -- every time @intersperseIOinM m@ is evaluated.+    s <- getStateM+    pure $! snd $ unsafePerformIO $ do+      r <- m+      pure (s, r)+  where+    -- We mark this function as NOINLINE to ensure the compiler cannot reason+    -- that two calls of @getStateM@ might yield the same value.+    {-# NOINLINE getStateM #-}+    getStateM :: m Int+    getStateM = pure 0

@@ -14,7 +14,7 @@ main :: IO () main = do     testMeasureM-    testFormatNatWithSeparator+    testFormatIntWithSeparator  testMeasureM :: IO () testMeasureM = do@@ -36,8 +36,8 @@     eqStat (lbl0, ts0) (lbl1, ts1) =       lbl0 == lbl1 && TimeStats.countStat ts0 == TimeStats.countStat ts1 -testFormatNatWithSeparator :: IO ()-testFormatNatWithSeparator = do+testFormatIntWithSeparator :: IO ()+testFormatIntWithSeparator = do     testCase   123456789   "123_456_789"     testCase    23456789    "23_456_789"     testCase     3456789     "3_456_789"

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               timestats-version:            0.1.1+version:            0.1.2  synopsis: A library for profiling time in Haskell applications