async-combinators 0.0.0 → 0.0.1
raw patch · 5 files changed
+35/−26 lines, 5 filesdep +textdep −universumdep ~asyncsetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: text
Dependencies removed: universum
Dependency ranges changed: async
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- Setup.hs +2/−0
- async-combinators.cabal +6/−9
- src/Async/Combinators.hs +10/−8
- test/Test/Async/Combinators.hs +11/−9
CHANGELOG.md view
@@ -4,6 +4,12 @@ async-combinators uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +0.0.1+=====++* [#3](https://github.com/serokell/async-combinators/issues/3):+ Remove `universum` from the dependencies.+ 0.0.0 =====
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
async-combinators.cabal view
@@ -1,5 +1,5 @@ name: async-combinators-version: 0.0.0+version: 0.0.1 synopsis: Async combinators description: Async combinators homepage: https://github.com/serokell/async-combinators@@ -14,7 +14,7 @@ extra-source-files: CHANGELOG.md , README.md -cabal-version: >=1.10+cabal-version: 2.0 tested-with: GHC == 8.0.2 GHC == 8.2.2 @@ -23,13 +23,12 @@ exposed-modules: Async.Combinators ghc-options: -Wall build-depends: base >= 4.7 && < 5- , async >= 2.1 && < 2.2+ , async >= 2.1 && < 2.3 , safe-exceptions >= 0.1.6 && < 0.2- , universum >= 1.1.0 && < 1.2+ , text , unliftio-core == 0.1.1.0 default-language: Haskell2010- default-extensions: NoImplicitPrelude- OverloadedStrings+ default-extensions: OverloadedStrings RecordWildCards ScopedTypeVariables @@ -41,7 +40,6 @@ other-modules: Test.Async.Combinators build-depends: base >= 4.7 && <5 , async-combinators- , universum , HUnit , hedgehog , safe-exceptions@@ -52,7 +50,6 @@ build-tool-depends: tasty-discover:tasty-discover ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010- default-extensions: NoImplicitPrelude- OverloadedStrings+ default-extensions: OverloadedStrings RecordWildCards ScopedTypeVariables
src/Async/Combinators.hs view
@@ -4,16 +4,17 @@ , withWorker ) where -import Universum- import Control.Concurrent (myThreadId) import Control.Concurrent.Async (withAsync)-import Control.Exception (asyncExceptionFromException, asyncExceptionToException)+import Control.Exception (SomeException (..), asyncExceptionFromException,+ asyncExceptionToException) import Control.Exception.Safe (Exception (..), finally, throwTo, tryAsync)+import Control.Monad (unless) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)--import qualified GHC.Show as Show (Show (show))+import Data.IORef (atomicWriteIORef, newIORef, readIORef)+import Data.Text (Text) +import qualified Data.Text as Text ----------------------- -- Running forever@@ -24,8 +25,8 @@ | WorkerFailed Text SomeException -- ^ Worker crashed instance Show WorkerExited where- show (WorkerExited n) = toString $ "Worker '" <> n <> "' returned"- show (WorkerFailed n e) = toString $ "Worker '" <> n <> "' failed: " <> show e+ show (WorkerExited n) = "Worker '" ++ Text.unpack n ++ "' returned"+ show (WorkerFailed n e) = "Worker '" ++ Text.unpack n ++ "' failed: " ++ show e instance Exception WorkerExited where toException = asyncExceptionToException@@ -44,7 +45,8 @@ mainDone <- newIORef False let worker' = do res <- tryAsync $ run worker- unlessM (readIORef mainDone) $ throwTo tid $+ isMainDone <- readIORef mainDone+ unless isMainDone $ throwTo tid $ case res of Right () -> WorkerExited name Left e -> WorkerFailed name e
test/Test/Async/Combinators.hs view
@@ -1,10 +1,12 @@ module Test.Async.Combinators where -import Universum--import Control.Concurrent (killThread, myThreadId, threadDelay)+import Control.Concurrent (killThread, myThreadId, newEmptyMVar, putMVar, takeMVar, threadDelay) import Control.Exception (AsyncException (ThreadKilled))-import Control.Exception.Safe (catchAny, handleAsync, isAsyncException, throw, throwTo, tryAsync)+import Control.Exception.Safe (Exception, catch, catchAny, handleAsync, isAsyncException, throw,+ throwTo, tryAsync)+import Control.Monad (forever)+import Data.Either (isRight)+import Data.IORef (newIORef, readIORef, writeIORef) import Test.HUnit (Assertion, assertEqual, assertFailure, (@?)) @@ -52,16 +54,16 @@ isAsyncException (WorkerExited "hi") @? "isAsync" me <- myThreadId- r <- tryAsync $ catchAny (throwTo me $ WorkerExited "hi") (const pass)+ r <- tryAsync $ catchAny (throwTo me $ WorkerExited "hi") (const $ pure ()) case r of Right _ -> assertFailure $ "caught by safe `catchAny`"- Left (_ :: WorkerExited) -> pass+ Left (_ :: WorkerExited) -> pure () unit_withWorker_exception_can_be_caught :: Assertion unit_withWorker_exception_can_be_caught = do me <- myThreadId- handleAsync (\(_ :: WorkerExited) -> pass) $ throwTo me (WorkerExited "bye")+ handleAsync (\(_ :: WorkerExited) -> pure ()) $ throwTo me (WorkerExited "bye") -------- -- Now actual tests.@@ -76,13 +78,13 @@ -- | Main crashes -> worker is killed. unit_withWorker_main_crash :: Assertion unit_withWorker_main_crash =- withWorker_test (forever $ threadDelay 100) (throw TestException `catch` \TestException -> putText "Hi") >>=+ withWorker_test (forever $ threadDelay 100) (throw TestException `catch` \TestException -> putStr "Hi") >>= assertWtr True False True -- | Worker exits -> main thread is killed. unit_withWorker_worker_exit :: Assertion unit_withWorker_worker_exit =- withWorker_test pass (threadDelay 100) >>=+ withWorker_test (pure ()) (threadDelay 100) >>= assertWtr False True False -- | Worker crashes -> main thread is killed.