unliftio 0.2.2.0 → 0.2.4.0

raw patch · 12 files changed

+195/−81 lines, 12 filesdep ~unliftio-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: unliftio-core

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.md +6/−20
• cbits/time-osx.c +20/−0
• cbits/time-posix.c +16/−0
• cbits/time-windows.c +41/−0
• src/UnliftIO.hs +2/−0
• src/UnliftIO/Async.hs +15/−15
• src/UnliftIO/Concurrent.hs +3/−3
• src/UnliftIO/Exception.hs +22/−22
• src/UnliftIO/IO.hs +19/−0
• test/UnliftIO/IOSpec.hs +14/−0
• unliftio.cabal +32/−21

@@ -1,3 +1,8 @@+## 0.2.3.0++* Use more generalized `withRunInIO` in `unliftio-core-0.1.1.0`+* Add `getMonotonicTime` function+ ## 0.2.2.0  * Add `pureTry` and `pureTryDeep`

@@ -188,37 +188,23 @@ applying `run` as necessary. `withRunIO` takes care of invoking `unliftIO` for us. -However, if we want to use the run function with different types, we-must use `askUnliftIO`:--```haskell-race :: MonadUnliftIO m => m a -> m b -> m (Either a b)-race a b = do-  u <- askUnliftIO-  liftIO (A.race (unliftIO u a) (unliftIO u b))-```--or more idiomatically `withUnliftIO`:+We can also use the run function with different types due to+`withRunInIO` being higher-rank polymorphic:  ```haskell race :: MonadUnliftIO m => m a -> m b -> m (Either a b)-race a b = withUnliftIO $ \u -> A.race (unliftIO u a) (unliftIO u b)+race a b = withRunInIO $ \run -> A.race (run a) (run b) ``` -This works just like `withRunIO`, except we use `unliftIO u` instead-of `run`, which is polymorphic. You _could_ get away with multiple-`withRunInIO` calls here instead, but this approach is idiomatic and-may be more performant (depending on optimizations).- And finally, a more complex usage, when unlifting the `mask`-function. This function needs to unlift vaues to be passed into the+function. This function needs to unlift values to be passed into the `restore` function, and then `liftIO` the result of the `restore` function.  ```haskell mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b-mask f = withUnliftIO $ \u -> Control.Exception.mask $ \unmask ->-  unliftIO u $ f $ liftIO . unmask . unliftIO u+mask f = withRunInIO $ \run -> Control.Exception.mask $ \restore ->+  run $ f $ liftIO . restore . run ```  ## Limitations

@@ -0,0 +1,20 @@+/* From https://github.com/bos/criterion */++#include <mach/mach.h>+#include <mach/mach_time.h>++static mach_timebase_info_data_t timebase_info;+static double timebase_recip;++void unliftio_inittime(void)+{+    if (timebase_recip == 0) {+	mach_timebase_info(&timebase_info);+	timebase_recip = (timebase_info.denom / timebase_info.numer) / 1e9;+    }+}++double unliftio_gettime(void)+{+    return mach_absolute_time() * timebase_recip;+}

@@ -0,0 +1,16 @@+/* From https://github.com/bos/criterion */++#include <time.h>++void unliftio_inittime(void)+{+}++double unliftio_gettime(void)+{+    struct timespec ts;++    clock_gettime(CLOCK_MONOTONIC, &ts);++    return ts.tv_sec + ts.tv_nsec * 1e-9;+}

@@ -0,0 +1,41 @@+/* From https://github.com/bos/criterion */++/*+ * Windows has the most amazingly cretinous time measurement APIs you+ * can possibly imagine.+ *+ * Our first possibility is GetSystemTimeAsFileTime, which updates at+ * roughly 60Hz, and is hence worthless - we'd have to run a+ * computation for tens or hundreds of seconds to get a trustworthy+ * number.+ *+ * Alternatively, we can use QueryPerformanceCounter, which has+ * undefined behaviour under almost all interesting circumstances+ * (e.g. multicore systems, CPU frequency changes). But at least it+ * increments reasonably often.+ */++#include <windows.h>++static double freq_recip;+static LARGE_INTEGER firstClock;++void unliftio_inittime(void)+{+    LARGE_INTEGER freq;++    if (freq_recip == 0) {+	QueryPerformanceFrequency(&freq);+	QueryPerformanceCounter(&firstClock);+	freq_recip = 1.0 / freq.QuadPart;+    }+}++double unliftio_gettime(void)+{+    LARGE_INTEGER li;++    QueryPerformanceCounter(&li);++    return ((double) (li.QuadPart - firstClock.QuadPart)) * freq_recip;+}

@@ -1,3 +1,5 @@+-- | Please see the README.md file for information on using this+-- package at <https://www.stackage.org/package/unliftio>. module UnliftIO   ( module Control.Monad.IO.Unlift   , module UnliftIO.Async

@@ -85,32 +85,32 @@ -- @since 0.1.0.0 asyncWithUnmask :: MonadUnliftIO m => ((forall b. m b -> m b) -> m a) -> m (Async a) asyncWithUnmask m =-  withUnliftIO $ \u -> A.asyncWithUnmask $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u+  withRunInIO $ \run -> A.asyncWithUnmask $ \unmask -> run $ m $ liftIO . unmask . run  -- | Unlifted 'A.asyncOnWithUnmask'. -- -- @since 0.1.0.0 asyncOnWithUnmask :: MonadUnliftIO m => Int -> ((forall b. m b -> m b) -> m a) -> m (Async a) asyncOnWithUnmask i m =-  withUnliftIO $ \u -> A.asyncOnWithUnmask i $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u+  withRunInIO $ \run -> A.asyncOnWithUnmask i $ \unmask -> run $ m $ liftIO . unmask . run  -- | Unlifted 'A.withAsync'. -- -- @since 0.1.0.0 withAsync :: MonadUnliftIO m => m a -> (Async a -> m b) -> m b-withAsync a b = withUnliftIO $ \u -> A.withAsync (unliftIO u a) (unliftIO u . b)+withAsync a b = withRunInIO $ \run -> A.withAsync (run a) (run . b)  -- | Unlifted 'A.withAsyncBound'. -- -- @since 0.1.0.0 withAsyncBound :: MonadUnliftIO m => m a -> (Async a -> m b) -> m b-withAsyncBound a b = withUnliftIO $ \u -> A.withAsyncBound (unliftIO u a) (unliftIO u . b)+withAsyncBound a b = withRunInIO $ \run -> A.withAsyncBound (run a) (run . b)  -- | Unlifted 'A.withAsyncOn'. -- -- @since 0.1.0.0 withAsyncOn :: MonadUnliftIO m => Int -> m a -> (Async a -> m b) -> m b-withAsyncOn i a b = withUnliftIO $ \u -> A.withAsyncOn i (unliftIO u a) (unliftIO u . b)+withAsyncOn i a b = withRunInIO $ \run -> A.withAsyncOn i (run a) (run . b)  -- | Unlifted 'A.withAsyncWithUnmask'. --@@ -121,9 +121,9 @@   -> (Async a -> m b)   -> m b withAsyncWithUnmask a b =-  withUnliftIO $ \u -> A.withAsyncWithUnmask-    (\unmask -> unliftIO u $ a $ liftIO . unmask . unliftIO u)-    (unliftIO u . b)+  withRunInIO $ \run -> A.withAsyncWithUnmask+    (\unmask -> run $ a $ liftIO . unmask . run)+    (run . b)  -- | Unlifted 'A.withAsyncOnWithMask'. --@@ -135,9 +135,9 @@   -> (Async a -> m b)   -> m b withAsyncOnWithUnmask i a b =-  withUnliftIO $ \u -> A.withAsyncOnWithUnmask i-    (\unmask -> unliftIO u $ a $ liftIO . unmask . unliftIO u)-    (unliftIO u . b)+  withRunInIO $ \run -> A.withAsyncOnWithUnmask i+    (\unmask -> run $ a $ liftIO . unmask . run)+    (run . b)  -- | Lifted 'A.wait'. --@@ -252,25 +252,25 @@ -- -- @since 0.1.0.0 race :: MonadUnliftIO m => m a -> m b -> m (Either a b)-race a b = withUnliftIO $ \u -> A.race (unliftIO u a) (unliftIO u b)+race a b = withRunInIO $ \run -> A.race (run a) (run b)  -- | Unlifted 'A.race_'. -- -- @since 0.1.0.0 race_ :: MonadUnliftIO m => m a -> m b -> m ()-race_ a b = withUnliftIO $ \u -> A.race_ (unliftIO u a) (unliftIO u b)+race_ a b = withRunInIO $ \run -> A.race_ (run a) (run b)  -- | Unlifted 'A.concurrently'. -- -- @since 0.1.0.0 concurrently :: MonadUnliftIO m => m a -> m b -> m (a, b)-concurrently a b = withUnliftIO $ \u -> A.concurrently (unliftIO u a) (unliftIO u b)+concurrently a b = withRunInIO $ \run -> A.concurrently (run a) (run b)  -- | Unlifted 'A.concurrently_'. -- -- @since 0.1.0.0 concurrently_ :: MonadUnliftIO m => m a -> m b -> m ()-concurrently_ a b = withUnliftIO $ \u -> A.concurrently_ (unliftIO u a) (unliftIO u b)+concurrently_ a b = withRunInIO $ \run -> A.concurrently_ (run a) (run b)  -- | Unlifted 'A.mapConcurrently'. --

@@ -63,14 +63,14 @@ -- @since 0.1.1.0 forkWithUnmask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m ()) -> m ThreadId forkWithUnmask m =-  withUnliftIO $ \u -> C.forkIOWithUnmask $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u+  withRunInIO $ \run -> C.forkIOWithUnmask $ \unmask -> run $ m $ liftIO . unmask . run {-# INLINABLE forkWithUnmask #-}  -- | Unlifted version of 'C.forkFinally'. -- -- @since 0.1.1.0 forkFinally :: MonadUnliftIO m => m a -> (Either SomeException a -> m ()) -> m ThreadId-forkFinally m1 m2 = withUnliftIO $ \u -> C.forkFinally (unliftIO u m1) $ unliftIO u . m2+forkFinally m1 m2 = withRunInIO $ \run -> C.forkFinally (run m1) $ run . m2 {-# INLINABLE forkFinally #-}  -- | Lifted version of 'C.killThread'.@@ -92,7 +92,7 @@ -- @since 0.1.1.0 forkOnWithUnmask :: MonadUnliftIO m => Int -> ((forall a. m a -> m a) -> m ()) -> m ThreadId forkOnWithUnmask i m =-  withUnliftIO $ \u -> C.forkOnWithUnmask i $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u+  withRunInIO $ \run -> C.forkOnWithUnmask i $ \unmask -> run $ m $ liftIO . unmask . run {-# INLINABLE forkOnWithUnmask #-}  -- | Lifted version of 'C.getNumCapabilities'.

@@ -101,9 +101,9 @@ -- -- @since 0.1.0.0 catch :: (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a-catch f g = withUnliftIO $ \u -> unliftIO u f `EUnsafe.catch` \e ->+catch f g = withRunInIO $ \run -> run f `EUnsafe.catch` \e ->   if isSyncException e-    then unliftIO u (g e)+    then run (g e)     -- intentionally rethrowing an async exception synchronously,     -- since we want to preserve async behavior     else EUnsafe.throwIO e@@ -274,9 +274,9 @@ -- -- @since 0.1.0.0 bracket :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c-bracket before after thing = withUnliftIO $ \u -> EUnsafe.mask $ \restore -> do-  x <- unliftIO u before-  res1 <- EUnsafe.try $ restore $ unliftIO u $ thing x+bracket before after thing = withRunInIO $ \run -> EUnsafe.mask $ \restore -> do+  x <- run before+  res1 <- EUnsafe.try $ restore $ run $ thing x   case res1 of     Left (e1 :: SomeException) -> do       -- explicitly ignore exceptions from after. We know that@@ -285,10 +285,10 @@       --       -- https://github.com/fpco/safe-exceptions/issues/2       _ :: Either SomeException b <--          EUnsafe.try $ EUnsafe.uninterruptibleMask_ $ unliftIO u $ after x+          EUnsafe.try $ EUnsafe.uninterruptibleMask_ $ run $ after x       EUnsafe.throwIO e1     Right y -> do-      _ <- EUnsafe.uninterruptibleMask_ $ unliftIO u $ after x+      _ <- EUnsafe.uninterruptibleMask_ $ run $ after x       return y  -- | Async safe version of 'EUnsafe.bracket_'.@@ -301,14 +301,14 @@ -- -- @since 0.1.0.0 bracketOnError :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c-bracketOnError before after thing = withUnliftIO $ \u -> EUnsafe.mask $ \restore -> do-  x <- unliftIO u before-  res1 <- EUnsafe.try $ restore $ unliftIO u $ thing x+bracketOnError before after thing = withRunInIO $ \run -> EUnsafe.mask $ \restore -> do+  x <- run before+  res1 <- EUnsafe.try $ restore $ run $ thing x   case res1 of     Left (e1 :: SomeException) -> do       -- ignore the exception, see bracket for explanation       _ :: Either SomeException b <--        EUnsafe.try $ EUnsafe.uninterruptibleMask_ $ unliftIO u $ after x+        EUnsafe.try $ EUnsafe.uninterruptibleMask_ $ run $ after x       EUnsafe.throwIO e1     Right y -> return y @@ -323,15 +323,15 @@ -- -- @since 0.1.0.0 finally :: MonadUnliftIO m => m a -> m b -> m a-finally thing after = withUnliftIO $ \u -> EUnsafe.uninterruptibleMask $ \restore -> do-  res1 <- EUnsafe.try $ restore $ unliftIO u thing+finally thing after = withRunInIO $ \run -> EUnsafe.uninterruptibleMask $ \restore -> do+  res1 <- EUnsafe.try $ restore $ run thing   case res1 of     Left (e1 :: SomeException) -> do       -- see bracket for explanation-      _ :: Either SomeException b <- EUnsafe.try $ unliftIO u after+      _ :: Either SomeException b <- EUnsafe.try $ run after       EUnsafe.throwIO e1     Right x -> do-      _ <- unliftIO u after+      _ <- run after       return x  -- | Like 'onException', but provides the handler the thrown@@ -340,12 +340,12 @@ -- @since 0.1.0.0 withException :: (MonadUnliftIO m, Exception e)               => m a -> (e -> m b) -> m a-withException thing after = withUnliftIO $ \u -> EUnsafe.uninterruptibleMask $ \restore -> do-    res1 <- EUnsafe.try $ restore $ unliftIO u thing+withException thing after = withRunInIO $ \run -> EUnsafe.uninterruptibleMask $ \restore -> do+    res1 <- EUnsafe.try $ restore $ run thing     case res1 of         Left e1 -> do             -- see explanation in bracket-            _ :: Either SomeException b <- EUnsafe.try $ unliftIO u $ after e1+            _ :: Either SomeException b <- EUnsafe.try $ run $ after e1             EUnsafe.throwIO e1         Right x -> return x @@ -462,15 +462,15 @@ -- -- @since 0.1.0.0 mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b-mask f = withUnliftIO $ \u -> EUnsafe.mask $ \unmask ->-  unliftIO u $ f $ liftIO . unmask . unliftIO u+mask f = withRunInIO $ \run -> EUnsafe.mask $ \unmask ->+  run $ f $ liftIO . unmask . run  -- | Unlifted version of 'EUnsafe.uninterruptibleMask'. -- -- @since 0.1.0.0 uninterruptibleMask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b-uninterruptibleMask f = withUnliftIO $ \u -> EUnsafe.uninterruptibleMask $ \unmask ->-  unliftIO u $ f $ liftIO . unmask . unliftIO u+uninterruptibleMask f = withRunInIO $ \run -> EUnsafe.uninterruptibleMask $ \unmask ->+  run $ f $ liftIO . unmask . run  -- | Unlifted version of 'EUnsafe.mask_'. --

@@ -30,12 +30,15 @@   , hGetEcho   , hWaitForInput   , hReady+  , getMonotonicTime   ) where  import qualified System.IO as IO import System.IO (Handle, IOMode (..)) import Control.Monad.IO.Unlift +import System.IO.Unsafe (unsafePerformIO)+ -- | Unlifted version of 'IO.withFile'. -- -- @since 0.1.0.0@@ -161,3 +164,19 @@ -- @since 0.2.1.0 hReady :: MonadIO m => Handle -> m Bool hReady = liftIO . IO.hReady++-- | Get the number of seconds which have passed since an arbitrary starting+-- time, useful for calculating runtime in a program.+--+-- @since 0.2.3.0+getMonotonicTime :: MonadIO m => m Double+getMonotonicTime = liftIO $ initted `seq` getMonotonicTime'++-- | Set up time measurement.+foreign import ccall unsafe "unliftio_inittime" initializeTime :: IO ()++initted :: ()+initted = unsafePerformIO initializeTime+{-# NOINLINE initted #-}++foreign import ccall unsafe "unliftio_gettime" getMonotonicTime' :: IO Double

@@ -0,0 +1,14 @@+module UnliftIO.IOSpec (spec) where++import Test.Hspec+import UnliftIO.IO+import Control.Concurrent (threadDelay)++spec :: Spec+spec = do+  describe "getMonotonicTime" $ do+    it "increases" $ do+      x <- getMonotonicTime+      threadDelay 5000+      y <- getMonotonicTime+      y - x `shouldSatisfy` (>= 5e-3)

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.21.2. -- -- see: https://github.com/sol/hpack ----- hash: 5a724f566f49e39a6208566cbc3e42117113cd8c19867e2f53151c8022d9919b+-- hash: 1bad09ed70712d36c4a392da05c02952b932befd883b7013501c876023f34cf2  name:           unliftio-version:        0.2.2.0+version:        0.2.4.0 synopsis:       The MonadUnliftIO typeclass for unlifting monads to IO (batteries included) description:    Please see the documentation and README at <https://www.stackage.org/package/unliftio> category:       Control@@ -23,20 +23,6 @@     README.md  library-  hs-source-dirs:-      src-  build-depends:-      async >2.1.1-    , base >=4.7 && <5-    , deepseq-    , directory-    , filepath-    , stm >=2.4.3-    , transformers-    , unliftio-core-  if !os(Windows)-    build-depends:-        unix   exposed-modules:       UnliftIO       UnliftIO.Async@@ -51,11 +37,39 @@       UnliftIO.Timeout   other-modules:       Paths_unliftio+  hs-source-dirs:+      src+  build-depends:+      async >2.1.1+    , base >=4.7 && <5+    , deepseq+    , directory+    , filepath+    , stm >=2.4.3+    , transformers+    , unliftio-core >=0.1.1.0+  if !os(Windows)+    build-depends:+        unix+  if os(darwin)+    c-sources:+        cbits/time-osx.c+  else+    if os(windows)+      c-sources:+          cbits/time-windows.c+    else+      c-sources:+          cbits/time-posix.c   default-language: Haskell2010  test-suite unliftio-spec   type: exitcode-stdio-1.0   main-is: Spec.hs+  other-modules:+      UnliftIO.ExceptionSpec+      UnliftIO.IOSpec+      Paths_unliftio   hs-source-dirs:       test   build-depends:@@ -68,11 +82,8 @@     , stm >=2.4.3     , transformers     , unliftio-    , unliftio-core+    , unliftio-core >=0.1.1.0   if !os(Windows)     build-depends:         unix-  other-modules:-      UnliftIO.ExceptionSpec-      Paths_unliftio   default-language: Haskell2010