timestats 0.1.4.1 → 0.2.0

raw patch · 4 files changed

+34/−66 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• src/Debug/TimeStats.hs +16/−8
• src/Debug/TimeStats/Unsafe.hs +13/−57
• timestats.cabal +1/−1

@@ -1,5 +1,9 @@ # Revision history for timestats +## 0.2.0 -- 2024-05-24++* Expose `Debug.TimeStats.measureMWithLiftIO`.+ ## 0.1.4.1 -- 2024-05-23  * Add `Debug.TimeStats.Unsafe.unsafeMeasureM` to measure in some more monads.

@@ -1,3 +1,4 @@+{-# LANGUAGE RankNTypes #-} -- | 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@@ -25,9 +26,10 @@     -- but they can be handy to implement other measuring primitives.     --   , TimeStatsRef+  , enabled   , lookupTimeStatsRef+  , measureMWithLiftIO   , updateTimeStatsRef-  , enabled   ) where  import Control.Exception (evaluate)@@ -71,13 +73,19 @@ -- {-# INLINE measureM #-} measureM :: MonadIO m => String -> m a -> m a-measureM label =+measureM label = measureMWithLiftIO label liftIO++-- | Like 'measureM' but allows to change the function to lift IO into the+-- monad.+{-# INLINE measureMWithLiftIO #-}+measureMWithLiftIO :: Monad m => String -> (forall b. IO b -> m b) -> m a -> m a+measureMWithLiftIO label lift =     -- See the documentation of 'enabled'     if enabled then do           -- @ref@ is the reference to the stats associated to the label.           -- See note [Looking up stats with unsafePerformIO]       let ref = unsafePerformIO $ lookupTimeStatsRef label-       in \action -> measureMWith ref action+       in \action -> measureMWithRef lift ref action     else       id @@ -232,12 +240,12 @@ newTimeStatsRef = liftIO $ 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 tref m = do-    t0 <- liftIO getMonotonicTimeNSec+-- the given reference to time stats, using the given IO lifting function.+measureMWithRef :: Monad m => (forall b. IO b -> m b) -> TimeStatsRef -> m a -> m a+measureMWithRef lift tref m = do+    t0 <- lift getMonotonicTimeNSec     a <- m-    liftIO $ do+    lift $ do       tf <- getMonotonicTimeNSec       updateTimeStatsRef tref $ \st ->         st

@@ -6,83 +6,39 @@ -- in this module. -- module Debug.TimeStats.Unsafe-  ( -- * Measuring-    unsafeMeasureM+  ( unsafeMeasureM   ) where  import Debug.TimeStats-         ( TimeStats(..)-         , TimeStatsRef-         , enabled-         , lookupTimeStatsRef-         , updateTimeStatsRef+         ( lookupTimeStatsRef+         , measureMWithLiftIO          ) import GHC.Clock (getMonotonicTimeNSec) import System.IO.Unsafe (unsafePerformIO) --- | Measure the time it takes to run the action.------ Add the time to the stats of the given label and increase its count by one.------ 'measureM' keeps the stats in a globally available store in order to minimize--- the changes necessary when instrumenting a program. Otherwise a reference to--- the store would need to be passed to every function that might invoke--- functions that need this reference.------ A time measure isn't collected if the given action fails with an exception.--- This is a deliberate choice to demand less of the monad in which measures are--- taken.------ Time measures aren't collected either if the environment variable--- @DEBUG_TIMESTATS_ENABLE@ isn't set the first time this function is--- evaluated.+-- | Like 'Debug.TimeStats.measureM' but can measure other monads. -- -- This function relies on a hack to perform IO in any monad, which does not--- always work. In particular, we can expect it to fail in monads where+-- always work. In particular, we can expect it to miss time in monads where ----- > (m >>= \_ -> undefined) == undefined -- for some computation m+-- > seq (m >>= \_ -> undefined) () == undefined -- for some computation m -- -- An example of such a monad is the list monad ----- > ([()] >>= \_ -> undefined) == undefined------ Another example is the @Control.Monad.Free.Free IO@.+-- > seq ([()] >>= \_ -> undefined) () == undefined ----- > (Control.Monad.Free.Pure () >>= \_ -> undefined) == undefined+-- Another example is the monad @Control.Monad.Free.Free f@. ----- But it seems to work on @IO@ or @ReaderT IO@.+-- > seq (return () >>= \_ -> undefined :: Free IO ()) () == undefined ----- > seq (print () >>= \_ -> undefined) () == ()+-- But it seems to work in monads with state like @IO@, @ReaderT IO@, and+-- @Control.Monad.State.State s@. ----- Also, monads that run the continuation of bind multiple times might only--- have accounted the time to run the first time only.+-- > seq (return () >>= \_ -> undefined :: YourMonadHere ()) () == () -- {-# INLINE unsafeMeasureM #-} unsafeMeasureM :: Monad m => String -> m a -> m a-unsafeMeasureM label =-    -- See the documentation of 'enabled'-    if enabled then do-          -- @ref@ is the reference to the stats associated to the label.-          -- See note [Looking up stats with unsafePerformIO]-      let ref = unsafePerformIO $ lookupTimeStatsRef label-       in \action -> measureMWith ref action-    else-      id---- | Measure the time it takes to run the given action and update with it--- the given reference to time stats.-measureMWith :: Monad m => TimeStatsRef -> m a -> m a-measureMWith tref m = do-    t0 <- intersperseIOinM getMonotonicTimeNSec-    a <- m-    intersperseIOinM $ do-      tf <- getMonotonicTimeNSec-      updateTimeStatsRef tref $ \st ->-        st-          { timeStat = (tf - t0) + timeStat st-          , countStat = 1 + countStat st-          }-    return a+unsafeMeasureM label = measureMWithLiftIO label intersperseIOinM  --------------------- -- intersperseIOinM

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