extra 1.1 → 1.2

raw patch · 8 files changed

+55/−12 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +5/−0
• Generate.hs +1/−0
• extra.cabal +2/−2
• src/Control/Concurrent/Extra.hs +26/−9
• src/Extra.hs +1/−1
• src/System/IO/Extra.hs +1/−0
• test/TestGen.hs +7/−0
• test/TestUtil.hs +12/−0

@@ -1,5 +1,10 @@ Changelog for Extra +1.2+    Add onceFork+    Make once async exception safe+    Fix a deadlock in once when two people request in parallel+    Fix a missing hClose in captureOutput 1.1     #7, add nubOrd, nubOrdOn, nubOrdBy     #6, add groupSortOn and groupSortBy

@@ -9,6 +9,7 @@ import System.Directory import Data.Char import Data.Maybe+import Prelude   main :: IO ()

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               extra-version:            1.1+version:            1.2 license:            BSD3 license-file:       LICENSE category:           Development@@ -15,7 +15,7 @@     The module "Extra" documents all functions provided by this library. Modules such as "Data.List.Extra" provide extra functions over "Data.List" and also reexport "Data.List". Users are recommended to replace "Data.List" imports with "Data.List.Extra" if they need the extra functionality. homepage:           https://github.com/ndmitchell/extra#readme bug-reports:        https://github.com/ndmitchell/extra/issues-tested-with:        GHC==7.10.1, GHC==7.8.3, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2+tested-with:        GHC==7.10.1, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2  extra-source-files:     CHANGES.txt

@@ -15,7 +15,7 @@ module Control.Concurrent.Extra(     module Control.Concurrent,     getNumCapabilities, setNumCapabilities, withNumCapabilities,-    forkFinally, once,+    forkFinally, once, onceFork,     -- * Lock     Lock, newLock, withLock, withLockTry,     -- * Var@@ -73,24 +73,41 @@ #endif  -data Once a = OncePending | OnceRunning (Barrier a) | OnceDone a-- -- | Given an action, produce a wrapped action that runs at most once. --   If the function raises an exception, the same exception will be reraised each time.+--+-- > let x ||| y = do t1 <- onceFork x; t2 <- onceFork y; t1; t2+-- > \(x :: IO Int) -> void (once x) == return ()+-- > \(x :: IO Int) -> join (once x) == x+-- > \(x :: IO Int) -> (do y <- once x; y; y) == x+-- > \(x :: IO Int) -> (do y <- once x; y ||| y) == x once :: IO a -> IO (IO a) once act = do     var <- newVar OncePending-    let run = either throw return-    return $ join $ modifyVar var $ \v -> case v of-        OnceDone x -> return (v, run x)-        OnceRunning x -> return (v, run =<< waitBarrier x)+    let run = either throwIO return+    return $ mask $ \unmask -> join $ modifyVar var $ \v -> case v of+        OnceDone x -> return (v, unmask $ run x)+        OnceRunning x -> return (v, unmask $ run =<< waitBarrier x)         OncePending -> do             b <- newBarrier             return $ (OnceRunning b,) $ do-                res <- try_ act+                res <- try_ $ unmask act+                signalBarrier b res                 modifyVar_ var $ \_ -> return $ OnceDone res                 run res++data Once a = OncePending | OnceRunning (Barrier a) | OnceDone a+++-- | Like 'once', but immediately starts running the computation on a background thread.+--+-- > \(x :: IO Int) -> join (onceFork x) == x+-- > \(x :: IO Int) -> (do a <- onceFork x; a; a) == x+onceFork :: IO a -> IO (IO a)+onceFork act = do+    bar <- newBarrier+    forkFinally act $ signalBarrier bar+    return $ either throwIO return =<< waitBarrier bar   ---------------------------------------------------------------------

@@ -5,7 +5,7 @@ module Extra(     -- * Control.Concurrent.Extra     -- | Extra functions available in @"Control.Concurrent.Extra"@.-    getNumCapabilities, setNumCapabilities, withNumCapabilities, forkFinally, once, Lock, newLock, withLock, withLockTry, Var, newVar, readVar, modifyVar, modifyVar_, withVar, Barrier, newBarrier, signalBarrier, waitBarrier, waitBarrierMaybe,+    getNumCapabilities, setNumCapabilities, withNumCapabilities, forkFinally, once, onceFork, Lock, newLock, withLock, withLockTry, Var, newVar, readVar, modifyVar, modifyVar_, withVar, Barrier, newBarrier, signalBarrier, waitBarrier, waitBarrierMaybe,     -- * Control.Exception.Extra     -- | Extra functions available in @"Control.Exception.Extra"@.     retry, showException, stringException, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,

@@ -120,6 +120,7 @@             hDuplicateTo h out             act `finally` do                 hDuplicateTo out2 out+                hClose out2                 hSetBuffering out buf  

@@ -4,6 +4,13 @@ default(Maybe Bool,Int,Double,Maybe (Maybe Bool),Maybe (Maybe Char)) tests :: IO () tests = do+    let x ||| y = do t1 <- onceFork x; t2 <- onceFork y; t1; t2+    testGen "\\(x :: IO Int) -> void (once x) == return ()" $ \(x :: IO Int) -> void (once x) == return ()+    testGen "\\(x :: IO Int) -> join (once x) == x" $ \(x :: IO Int) -> join (once x) == x+    testGen "\\(x :: IO Int) -> (do y <- once x; y; y) == x" $ \(x :: IO Int) -> (do y <- once x; y; y) == x+    testGen "\\(x :: IO Int) -> (do y <- once x; y ||| y) == x" $ \(x :: IO Int) -> (do y <- once x; y ||| y) == x+    testGen "\\(x :: IO Int) -> join (onceFork x) == x" $ \(x :: IO Int) -> join (onceFork x) == x+    testGen "\\(x :: IO Int) -> (do a <- onceFork x; a; a) == x" $ \(x :: IO Int) -> (do a <- onceFork x; a; a) == x     testGen "stringException \"test\"                           == return \"test\"" $ stringException "test"                           == return "test"     testGen "stringException (\"test\" ++ undefined)            == return \"test<Exception>\"" $ stringException ("test" ++ undefined)            == return "test<Exception>"     testGen "stringException (\"test\" ++ undefined ++ \"hello\") == return \"test<Exception>\"" $ stringException ("test" ++ undefined ++ "hello") == return "test<Exception>"

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-}  module TestUtil(runTests, testGen, erroneous, (====), module X) where @@ -59,6 +60,17 @@         a <- try_ $ captureOutput a         b <- try_ $ captureOutput b         return $ a == b++instance Show (IO a) where+    show _ = "<<IO>>"++instance Arbitrary a => Arbitrary (IO a) where+    arbitrary = do+        (prnt :: Maybe Int, thrw :: Maybe Int, res) <- arbitrary+        return $ do+            whenJust prnt print+            whenJust thrw (fail . show)+            return res  instance Eq SomeException where     a == b = show a == show b