extra 1.4 → 1.4.1

raw patch · 8 files changed

+90/−26 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +3/−0
• extra.cabal +4/−3
• src/Control/Exception/Extra.hs +13/−6
• src/Extra.hs +1/−1
• src/System/IO/Extra.hs +24/−12
• test/Test.hs +4/−1
• test/TestCustom.hs +30/−0
• test/TestUtil.hs +11/−3

@@ -1,5 +1,8 @@ Changelog for Extra +1.4.1+    Make temp file functions workaround GHC bug #10731+    Add retryBool 1.4     Add stripInfix and stripInfixEnd 1.3.1

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               extra-version:            1.4+version:            1.4.1 license:            BSD3 license-file:       LICENSE category:           Development@@ -69,8 +69,9 @@     if !os(windows)         build-depends: unix     hs-source-dirs: test-    ghc-options: -main-is Test+    ghc-options: -main-is Test -threaded -with-rtsopts=-N4     main-is:        Test.hs     other-modules:-        TestUtil+        TestCustom         TestGen+        TestUtil

@@ -1,10 +1,11 @@+{-# LANGUAGE ScopedTypeVariables #-}  -- | Extra functions for "Control.Exception". --   These functions provide retrying, showing in the presence of exceptions, --   and functions to catch\/ignore exceptions, including monomorphic (no 'Exception' context) versions. module Control.Exception.Extra(     module Control.Exception,-    retry,+    retry, retryBool,     showException, stringException,     errorIO,     -- * Exception catching/ignoring@@ -64,12 +65,18 @@ -- > retry 1 (print "x")  == print "x" -- > retry 3 (fail "die") == fail "die" retry :: Int -> IO a -> IO a-retry i x | i <= 0 = error "retry count must be 1 or more"-retry 1 x = x-retry i x = do-    res <- try_ x+retry i x | i <= 0 = error "Control.Exception.Extra.retry: count must be 1 or more"+retry i x = retryBool (\(e :: SomeException) -> True) i x++-- | Retry an operation at most /n/ times (/n/ must be positive), while the exception value and type match a predicate.+--   If the operation fails the /n/th time it will throw that final exception.+retryBool :: Exception e => (e -> Bool) -> Int -> IO a -> IO a+retryBool p i x | i <= 0 = error "Control.Exception.Extra.retryBool: count must be 1 or more"+retryBool p 1 x = x+retryBool p i x = do+    res <- tryBool p x     case res of-        Left _ -> retry (i-1) x+        Left _ -> retryBool p (i-1) x         Right v -> return v  

@@ -8,7 +8,7 @@     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, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,+    retry, retryBool, showException, stringException, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,     -- * Control.Monad.Extra     -- | Extra functions available in @"Control.Monad.Extra"@.     whenJust, whenJustM, unit, loopM, whileM, partitionM, concatMapM, mapMaybeM, findM, firstJustM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,

@@ -24,9 +24,12 @@ import GHC.IO.Handle(hDuplicate,hDuplicateTo) import System.Directory.Extra import System.IO.Error+import System.IO.Unsafe import System.FilePath import Data.Char import Data.Time.Clock+import Data.Tuple.Extra+import Data.IORef   -- File reading@@ -131,8 +134,20 @@     hSetBuffering h m     act --- Temporary file +---------------------------------------------------------------------+-- TEMPORARY FILE++{-# NOINLINE tempRef #-}+tempRef :: IORef Int+tempRef = unsafePerformIO $ do+    rand :: Integer <- fmap (read . take 50 . filter isDigit . show . utctDayTime) getCurrentTime+    newIORef $ fromIntegral rand++tempUnique :: IO Int+tempUnique = atomicModifyIORef tempRef $ succ &&& succ++ -- | Provide a function to create a temporary file, and a way to delete a --   temporary file. Most users should use 'withTempFile' which --   combines these operations.@@ -144,7 +159,8 @@     where         create = do             tmpdir <- getTemporaryDirectory-            (file, h) <- openTempFile tmpdir "extra"+            val <- tempUnique+            (file, h) <- retryBool (\(_ :: IOError) -> True) 5 $ openTempFile tmpdir $ "extra-file-" ++ show val ++ "-"             hClose h             return file @@ -168,21 +184,17 @@ --   combines these operations. newTempDir :: IO (FilePath, IO ()) newTempDir = do-        dir <- create+        tmpdir <- getTemporaryDirectory+        dir <- retryBool (\(_ :: IOError) -> True) 5 $ create tmpdir         del <- once $ ignore $ removeDirectoryRecursive dir         return (dir, del)     where-        create = do-            tmpdir <- getTemporaryDirectory-            -- get the number of seconds during today (including floating point), and grab some interesting digits-            rand :: Integer <- fmap (read . take 20 . filter isDigit . show . utctDayTime) getCurrentTime-            find tmpdir rand--        find tmpdir x = do-            let dir = tmpdir </> "extra" ++ show x+        create tmpdir = do+            v <- tempUnique+            let dir = tmpdir </> "extra-dir-" ++ show v             catchBool isAlreadyExistsError                 (createDirectoryPrivate dir >> return dir) $-                \e -> find tmpdir (x+1)+                \e -> create tmpdir   -- | Create a temporary directory inside the system temporary directory.

@@ -3,6 +3,7 @@  import TestGen import TestUtil+import TestCustom  -- Check that we managed to export everything _unused1 x = whenJust@@ -14,4 +15,6 @@   main :: IO ()-main = runTests $ tests+main = runTests $ do+    tests+    testCustom

@@ -0,0 +1,30 @@++module TestCustom(testCustom) where++import Control.Concurrent.Extra+import Control.Monad+import System.IO.Extra+import Data.IORef+import TestUtil+++testCustom :: IO ()+testCustom = do+    testRaw "withTempFile" $ do+        xs <- replicateM 4 $ onceFork $ do+            replicateM_ 100 $ withTempFile (const $ return ())+            putChar '.'+        sequence_ xs+        putStrLn "done"++    testRaw "withTempDir" $ do+        xs <- replicateM 4 $ onceFork $ do+            replicateM_ 100 $ withTempDir (const $ return ())+            putChar '.'+        sequence_ xs+        putStrLn "done"++    testGen "retry" $ do+        ref <- newIORef 2+        retry 5 $ do modifyIORef ref pred; whenM ((/=) 0 <$> readIORef ref) $ fail "die"+        (==== 0) <$> readIORef ref

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, CPP #-} -module TestUtil(runTests, testGen, erroneous, (====), module X) where+module TestUtil(runTests, testGen, testRaw, erroneous, (====), module X) where  import Test.QuickCheck import Test.QuickCheck.Test@@ -32,10 +32,14 @@ testCount = unsafePerformIO $ newIORef 0  testGen :: Testable prop => String -> prop -> IO ()-testGen msg prop = do-    putStrLn msg+testGen msg prop = testRaw msg $ do     r <- quickCheckResult prop     unless (isSuccess r) $ error "Test failed"++testRaw :: String -> IO () -> IO ()+testRaw msg test = do+    putStrLn msg+    test     modifyIORef testCount (+1)  @@ -56,6 +60,10 @@     t     n <- readIORef testCount     putStrLn $ "Success (" ++ show n ++ " tests)"++instance Testable () where+    property = property . (`seq` True)+    exhaustive _ = True  instance Testable a => Testable (IO a) where     property = property . unsafePerformIO