extra 0.4 → 0.5

raw patch · 19 files changed

+275/−98 lines, 19 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGES.txt +6/−0
• Generate.hs +6/−1
• extra.cabal +3/−1
• src/Control/Concurrent/Extra.hs +38/−12
• src/Control/Exception/Extra.hs +4/−2
• src/Control/Monad/Extra.hs +8/−7
• src/Data/IORef/Extra.hs +2/−2
• src/Data/List/Extra.hs +38/−11
• src/Data/Tuple/Extra.hs +3/−3
• src/Extra.hs +6/−6
• src/Numeric/Extra.hs +1/−0
• src/System/Directory/Extra.hs +49/−10
• src/System/Environment/Extra.hs +2/−0
• src/System/IO/Extra.hs +62/−9
• src/System/Info/Extra.hs +8/−30
• src/System/Process/Extra.hs +3/−1
• src/System/Time/Extra.hs +5/−0
• test/TestGen.hs +23/−1
• test/TestUtil.hs +8/−2

@@ -1,5 +1,11 @@ Changelog for Extra +0.5+    Use the sortOn from GHC 7.9 and above+    Remove getProcessorCount+    Remove getDirectoryContentsRecursive in favour of listFilesRecursive+    Change the signature for newTempFile/newTempDir+    Add a once function 0.4     Remove all but the extractors on triples     Remove groupSortOn

@@ -42,7 +42,12 @@         ,"default(Maybe Bool,Int,Double,Maybe (Maybe Bool),Maybe (Maybe Char))"         ,"tests :: IO ()"         ,"tests = do"] ++-        ["    testGen " ++ show t ++ " $ " ++ tweakTest t | (_,_,ts) <- ifaces, t <- ts]+        ["    " ++ if "let " `isPrefixOf` t then t else "testGen " ++ show t ++ " $ " ++ tweakTest t | (_,_,ts) <- ifaces, t <- rejoin ts]++rejoin :: [String] -> [String]+rejoin (x1:x2:xs) | " " `isPrefixOf` x2 = rejoin $ (x1 ++ x2) : xs+rejoin (x:xs) = x : rejoin xs+rejoin [] = []  writeFileBinaryChanged :: FilePath -> String -> IO () writeFileBinaryChanged file x = do

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               extra-version:            0.4+version:            0.5 license:            BSD3 license-file:       LICENSE category:           Development@@ -60,6 +60,8 @@     default-language: Haskell2010     build-depends:         base == 4.*,+        directory,+        filepath,         extra,         time,         QuickCheck

@@ -1,21 +1,21 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, TupleSections #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} --- | Extra functions for "Control.Concurrent". These fall into a few categories:+-- | Extra functions for "Control.Concurrent". ----- * Some functions manipulate the number of capabilities.+--   This module includes three new types of 'MVar', namely 'Lock' (no associated value),+--   'Var' (never empty) and 'Barrier' (filled at most once). See+--   <http://neilmitchell.blogspot.co.uk/2012/06/flavours-of-mvar_04.html this blog post>+--   for examples and justification. ----- * The 'forkFinally' function - if you need greater control of exceptions and threads+--   If you need greater control of exceptions and threads --   see the <http://hackage.haskell.org/package/slave-thread slave-thread> package.------ * Three new types of 'MVar', namely 'Lock' (no associated value), 'Var' (never empty)---   and 'Barrier' (filled at most once). See---   <http://neilmitchell.blogspot.co.uk/2012/06/flavours-of-mvar_04.html this blog post>---   for more examples.+--   If you need elaborate relationships between threads+--   see the <http://hackage.haskell.org/package/async async> package. module Control.Concurrent.Extra(     module Control.Concurrent,-    withNumCapabilities, setNumCapabilities,-    forkFinally,+    getNumCapabilities, setNumCapabilities, withNumCapabilities,+    forkFinally, once,     -- * Lock     Lock, newLock, withLock, withLockTry,     -- * Var@@ -25,7 +25,7 @@     ) where  import Control.Concurrent-import Control.Exception+import Control.Exception.Extra import Control.Monad.Extra  @@ -38,6 +38,12 @@         bracket_ (setNumCapabilities new) (setNumCapabilities old) act  +#if __GLASGOW_HASKELL__ < 702+-- | A version of 'getNumCapabilities' that works on all versions of GHC, but returns 1 before GHC 7.2.+getNumCapabilities :: IO Int+getNumCapabilities = return 1+#endif+ #if __GLASGOW_HASKELL__ < 706 -- | A version of 'setNumCapabilities' that works on all versions of GHC, but has no effect before GHC 7.6. setNumCapabilities :: Int -> IO ()@@ -63,6 +69,26 @@   mask $ \restore ->     forkIO $ try (restore action) >>= and_then #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.+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)+        OncePending -> do+            b <- newBarrier+            return $ (OnceRunning b,) $ do+                res <- try_ act+                modifyVar_ var $ \_ -> return $ OnceDone res+                run res   ---------------------------------------------------------------------

@@ -20,9 +20,10 @@  -- | Fully evaluate an input String. If the String contains embedded exceptions it will produce @\<Exception\>@. --+-- > stringException "test"                           == return "test" -- > stringException ("test" ++ undefined)            == return "test<Exception>" -- > stringException ("test" ++ undefined ++ "hello") == return "test<Exception>"--- > stringException "test"                           == return "test"+-- > stringException ['t','e','s','t',undefined]      == return "test<Exception>" stringException :: String -> IO String stringException x = do     r <- try_ $ evaluate $ list [] (\x xs -> x `seq` x:xs) x@@ -48,7 +49,8 @@ ignore = void . try_  --- | Retry an operation at most N times (N must be positive).+-- | Retry an operation at most /n/ times (/n/ must be positive).+--   If the operation fails the /n/th time it will throw that final exception. -- -- > retry 1 (print "x")  == print "x" -- > retry 3 (fail "die") == fail "die"

@@ -1,17 +1,18 @@ --- | Extra functions for "Control.Exception".+-- | Extra functions for "Control.Monad". --   These functions provide looping, list operations and booleans. -- If you need a wider selection of monad loops and list generalisations,--- see <http://hackage.haskell.org/package/monad-loops>+-- see <http://hackage.haskell.org/package/monad-loops monad-loops>. module Control.Monad.Extra(     module Control.Monad,     whenJust,     unit,-    partitionM, concatMapM, mapMaybeM,+    -- * Loops     loopM, whileM,-    whenM, unlessM,-    ifM, notM, (||^), (&&^), orM, andM, anyM, allM,-    findM, firstJustM+    -- * Lists+    partitionM, concatMapM, mapMaybeM, findM, firstJustM,+    -- * Booleans+    whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,     ) where  import Control.Monad@@ -27,7 +28,7 @@ whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () whenJust mg f = maybe (pure ()) f mg --- | The identity function which requires the inner argument to be '()'. Useful for functions+-- | The identity function which requires the inner argument to be @()@. Useful for functions --   with overloaded return times. -- -- > \(x :: Maybe ()) -> unit x == x

@@ -10,13 +10,13 @@ import Control.Exception  --- | Evaluates the value before calling 'writeIORef'+-- | Evaluates the value before calling 'writeIORef'. writeIORef' :: IORef a -> a -> IO () writeIORef' ref x = do     evaluate x     writeIORef ref x --- | Evaluates the value before calling 'atomicWriteIORef'+-- | Evaluates the value before calling 'atomicWriteIORef'. atomicWriteIORef' :: IORef a -> a -> IO () atomicWriteIORef' ref x = do     evaluate x

@@ -3,18 +3,25 @@  -- | This module extends "Data.List" with extra functions of a similar nature. --   The package also exports the existing "Data.List" functions.---   Some of the names and semantics were inspired by the @text@ package.+--   Some of the names and semantics were inspired by the+--   <http://hackage.haskell.org/package/text text> package. module Data.List.Extra(     module Data.List,-    lower, upper, trim, trimStart, trimEnd, word1, drop1,-    list, uncons, unsnoc, cons, snoc,+    -- * String operations+    lower, upper, trim, trimStart, trimEnd, word1,+    -- * Splitting    +    dropEnd, takeEnd, breakEnd, spanEnd,+    dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix,+    wordsBy, linesBy,+    breakOn, breakOnEnd, splitOn, split, chunksOf,+    -- * Basics+    list, uncons, unsnoc, cons, snoc, drop1,+    -- * List operations     groupSort, nubOn, groupOn, sortOn,-    repeatedly, for,     disjoint, allSame, anySame,-    dropEnd, takeEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix,+    repeatedly, for, firstJust,     concatUnzip, concatUnzip3,-    merge, mergeBy, replace, wordsBy, linesBy, firstJust,-    breakOn, breakOnEnd, splitOn, split, chunksOf+    replace, merge, mergeBy,     ) where  import Data.List@@ -197,23 +204,43 @@ upper = map toUpper  +-- | Split the first word off a string. Useful for when starting to parse the beginning+--   of a string, but you want to accurately perserve whitespace in the rest of the string.+--+-- > word1 "" == ("", "")+-- > word1 "keyword rest of string" == ("keyword","rest of string")+-- > word1 "  keyword\n  rest of string" == ("keyword","rest of string")+-- > \s -> fst (word1 s) == concat (take 1 $ words s)+-- > \s -> words (snd $ word1 s) == drop 1 (words s) word1 :: String -> (String, String) word1 x = second (dropWhile isSpace) $ break isSpace $ dropWhile isSpace x  --- | A version of 'sort' where the comparison is done on some extracted value.+#if __GLASGOW_HASKELL__ < 709+-- | Sort a list by comparing the results of a key function applied to each+-- element.  @sortOn f@ is equivalent to @sortBy (comparing f)@, but has the+-- performance advantage of only evaluating @f@ once for each element in the+-- input list.  This is called the decorate-sort-undecorate paradigm, or+-- Schwartzian transform. -- -- > sortOn fst [(3,"z"),(1,""),(3,"a")] == [(1,""),(3,"z"),(3,"a")] sortOn :: Ord b => (a -> b) -> [a] -> [a]-sortOn f = sortBy (compare `on` f)+sortOn f = map snd . sortBy (compare `on` fst) . map (\x -> let y = f x in y `seq` (y, x))+#endif  -- | A version of 'group' where the equality is done on some extracted value. groupOn :: Eq b => (a -> b) -> [a] -> [[a]]-groupOn f = groupBy ((==) `on` f)+groupOn f = groupBy ((==) `on2` f)+    -- redefine on so we avoid duplicate computation for most values.+    where (.*.) `on2` f = \x -> let fx = f x in \y -> fx .*. f y + -- | A version of 'nub' where the equality is done on some extracted value.+--   @nubOn f@ is equivalent to @nubBy ((==) `on` f)@, but has the+--   performance advantage of only evaluating @f@ once for each element in the+--   input list. nubOn :: Eq b => (a -> b) -> [a] -> [a]-nubOn f = nubBy ((==) `on` f)+nubOn f = map snd . nubBy ((==) `on` fst) . map (\x -> let y = f x in y `seq` (y, x))  -- | A combination of 'group' and 'sort'. --

@@ -1,7 +1,7 @@ --- | Extra functions for working with tuples.+-- | Extra functions for working with pairs and triples. --   Some of these functions are available in the "Control.Arrow" module,---   but here are available specialised to pairs.+--   but here are available specialised to pairs. Some operations work on triples. module Data.Tuple.Extra(     module Data.Tuple,     -- * Specialised 'Arrow' functions@@ -49,7 +49,7 @@ dupe :: a -> (a,a) dupe x = (x,x) --- | Apply a single function to both componenets of a pair.+-- | Apply a single function to both components of a pair. -- -- > both succ (1,2) == (2,3) both :: (a -> b) -> (a, a) -> (b, b)

@@ -5,13 +5,13 @@ module Extra(     -- * Control.Concurrent.Extra     -- | Extra functions available in @"Control.Concurrent.Extra"@.-    withNumCapabilities, setNumCapabilities, forkFinally, Lock, newLock, withLock, withLockTry, Var, newVar, readVar, modifyVar, modifyVar_, withVar, Barrier, newBarrier, signalBarrier, waitBarrier, waitBarrierMaybe,+    getNumCapabilities, setNumCapabilities, withNumCapabilities, forkFinally, once, 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,     -- * Control.Monad.Extra     -- | Extra functions available in @"Control.Monad.Extra"@.-    whenJust, unit, partitionM, concatMapM, mapMaybeM, loopM, whileM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, findM, firstJustM,+    whenJust, unit, loopM, whileM, partitionM, concatMapM, mapMaybeM, findM, firstJustM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,     -- * Data.Either.Extra     -- | Extra functions available in @"Data.Either.Extra"@.     isLeft, isRight, fromLeft, fromRight, fromEither,@@ -20,7 +20,7 @@     modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef',     -- * Data.List.Extra     -- | Extra functions available in @"Data.List.Extra"@.-    lower, upper, trim, trimStart, trimEnd, word1, drop1, list, uncons, unsnoc, cons, snoc, groupSort, nubOn, groupOn, sortOn, repeatedly, for, disjoint, allSame, anySame, dropEnd, takeEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix, concatUnzip, concatUnzip3, merge, mergeBy, replace, wordsBy, linesBy, firstJust, breakOn, breakOnEnd, splitOn, split, chunksOf,+    lower, upper, trim, trimStart, trimEnd, word1, dropEnd, takeEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, list, uncons, unsnoc, cons, snoc, drop1, groupSort, nubOn, groupOn, sortOn, disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip, concatUnzip3, replace, merge, mergeBy,     -- * Data.Tuple.Extra     -- | Extra functions available in @"Data.Tuple.Extra"@.     first, second, (***), (&&&), dupe, both, fst3, snd3, thd3,@@ -29,16 +29,16 @@     showDP, intToDouble, intToFloat, floatToDouble, doubleToFloat,     -- * System.Directory.Extra     -- | Extra functions available in @"System.Directory.Extra"@.-    withCurrentDirectory, getDirectoryContentsRecursive, createDirectoryPrivate,+    withCurrentDirectory, createDirectoryPrivate, listContents, listFiles, listFilesInside, listFilesRecursive,     -- * System.Environment.Extra     -- | Extra functions available in @"System.Environment.Extra"@.     getExecutablePath, lookupEnv,     -- * System.Info.Extra     -- | Extra functions available in @"System.Info.Extra"@.-    isWindows, getProcessorCount,+    isWindows,     -- * System.IO.Extra     -- | Extra functions available in @"System.IO.Extra"@.-    readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, newTempFile, newTempDir, captureOutput, withBuffering,+    captureOutput, withBuffering, readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, newTempFile, newTempDir,     -- * System.Process.Extra     -- | Extra functions available in @"System.Process.Extra"@.     system_, systemOutput, systemOutput_,

@@ -1,4 +1,5 @@ +-- | Extra numeric functions - formatting and specialised conversions. module Numeric.Extra(     module Numeric,     showDP,

@@ -1,8 +1,11 @@ {-# LANGUAGE CPP #-} +-- | Extra directory functions. Most of these functions provide cleaned up and generalised versions+--   of 'getDirectoryContents', see 'listContents' for the differences. module System.Directory.Extra(     module System.Directory,-    withCurrentDirectory, getDirectoryContentsRecursive, createDirectoryPrivate+    withCurrentDirectory, createDirectoryPrivate,+    listContents, listFiles, listFilesInside, listFilesRecursive     ) where  import System.Directory@@ -16,21 +19,57 @@ #endif  --- | Remember that the current directory is a global variable, so calling this function---   multithreaded is almost certain to go wrong. Avoid changing the dir if you can.+-- | Set the current directory, perform an operation, then change back.+--   Remember that the current directory is a global variable, so calling this function+--   multithreaded is almost certain to go wrong. Avoid changing the current directory if you can.+--+-- > withTempDir $ \dir -> do writeFile (dir </> "foo.txt") ""; withCurrentDirectory dir $ doesFileExist "foo.txt" withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory dir act =     bracket getCurrentDirectory setCurrentDirectory $ const $ do         setCurrentDirectory dir; act --- | Find all the files within a directory, including recursively.---   Looks through all folders, including those beginning with @.@.-getDirectoryContentsRecursive :: FilePath -> IO [FilePath]-getDirectoryContentsRecursive dir = do++-- | List the files and directories directly within a directory.+--   Each result will be prefixed by the query directory, and the special directories @.@ and @..@ will be ignored.+--   Intended as a cleaned up version of 'getDirectoryContents'.+--+-- > withTempDir $ \dir -> do writeFile (dir </> "test.txt") ""; (== [dir </> "test.txt"]) <$> listContents dir+-- > let touch = mapM_ $ \x -> createDirectoryIfMissing True (takeDirectory x) >> writeFile x ""+-- > let listTest op as bs = withTempDir $ \dir -> do touch $ map (dir </>) as; res <- op dir; return $ map (drop (length dir + 1)) res == bs+-- > listTest listContents ["bar.txt","foo/baz.txt","zoo"] ["bar.txt","foo","zoo"]+listContents :: FilePath -> IO [FilePath]+listContents dir = do     xs <- getDirectoryContents dir-    (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ all (== '.') x]-    rest <- concatMapM getDirectoryContentsRecursive $ sort dirs-    return $ sort files ++ rest+    return $ sort [dir </> x | x <- xs, not $ all (== '.') x]++-- | Like 'listContents', but only returns the files in a directory, not other directories.+--   Each file will be prefixed by the query directory.+--+-- > listTest listFiles ["bar.txt","foo/baz.txt","zoo"] ["bar.txt","zoo"]+listFiles :: FilePath -> IO [FilePath]+listFiles dir = filterM doesFileExist =<< listContents dir+++-- | Like 'listFiles', but goes recursively through all subdirectories.+--+-- > listTest listFilesRecursive ["bar.txt","zoo","foo" </> "baz.txt"] ["bar.txt","zoo","foo" </> "baz.txt"]+listFilesRecursive :: FilePath -> IO [FilePath]+listFilesRecursive = listFilesInside (const $ return True)+++-- | Like 'listFilesRecursive', but with a predicate to decide where to recurse into.+--   Typically directories starting with @.@ would be ignored. The initial argument directory+--   will have the test applied to it.+--+-- > listTest (listFilesInside $ return . not . isPrefixOf "." . takeFileName)+-- >     ["bar.txt","foo" </> "baz.txt",".foo" </> "baz2.txt", "zoo"] ["bar.txt","zoo","foo" </> "baz.txt"]+-- > listTest (listFilesInside $ const $ return False) ["bar.txt"] []+listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]+listFilesInside test dir = ifM (notM $ test dir) (return []) $ do+    (dirs,files) <- partitionM doesDirectoryExist =<< listContents dir+    rest <- concatMapM (listFilesInside test) dirs+    return $ files ++ rest   -- | Create a directory with permissions so that only the current user can view it.

@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} +-- | Extra functions for "System.Environment". All these functions are available in later GHC versions,+--   but this code works all the way back to GHC 7.2. module System.Environment.Extra(     module System.Environment,     getExecutablePath, lookupEnv

@@ -1,17 +1,25 @@ {-# LANGUAGE ScopedTypeVariables #-} --- | More advanced temporary file manipulation functions can be found in the @exceptions@ package.+-- | More IO functions. The functions include ones for reading files with specific encodings,+--   strictly reading files, and writing files with encodings. There are also some simple+--   temporary file functions, more advanced alternatives can be found in+--   the <http://hackage.haskell.org/package/exceptions exceptions> package. module System.IO.Extra(     module System.IO,+    captureOutput,+    withBuffering,+    -- * Read encoding     readFileEncoding, readFileUTF8, readFileBinary,+    -- * Strict reading     readFile', readFileEncoding', readFileUTF8', readFileBinary',+    -- * Write with encoding     writeFileEncoding, writeFileUTF8, writeFileBinary,+    -- * Temporary files     withTempFile, withTempDir, newTempFile, newTempDir,-    captureOutput,-    withBuffering,     ) where  import System.IO+import Control.Concurrent.Extra import Control.Exception.Extra as E import GHC.IO.Handle(hDuplicate,hDuplicateTo) import System.Directory.Extra@@ -23,15 +31,18 @@  -- File reading +-- | Like 'readFile', but setting an encoding. readFileEncoding :: TextEncoding -> FilePath -> IO String readFileEncoding enc file = do     h <- openFile file ReadMode     hSetEncoding h enc     hGetContents h +-- | Like 'readFile', but with the encoding 'utf8'. readFileUTF8 :: FilePath -> IO String readFileUTF8 = readFileEncoding utf8 +-- | Like 'readFile', but for binary files. readFileBinary :: FilePath -> IO String readFileBinary file = do     h <- openBinaryFile file ReadMode@@ -39,12 +50,16 @@  -- Strict file reading +-- | A strict version of 'readFile'. When the string is produced, the entire+--   file will have been read into memory and the file handle will have been closed.+--   Closing the file handle does not rely on the garbage collector. readFile' :: FilePath -> IO String readFile' file = withFile file ReadMode $ \h -> do     s <- hGetContents h     evaluate $ length s     return s +-- | A strict version of 'readFileEncoding', see 'readFile'' for details. readFileEncoding' :: TextEncoding -> FilePath -> IO String readFileEncoding' e file = withFile file ReadMode $ \h -> do     hSetEncoding h e@@ -52,9 +67,11 @@     evaluate $ length s     return s +-- | A strict version of 'readFileUTF8', see 'readFile'' for details. readFileUTF8' :: FilePath -> IO String readFileUTF8' = readFileEncoding' utf8 +-- | A strict version of 'readFileBinary', see 'readFile'' for details. readFileBinary' :: FilePath -> IO String readFileBinary' file = withBinaryFile file ReadMode $ \h -> do     s <- hGetContents h@@ -63,14 +80,17 @@  -- File writing +-- | Write a file with a particular encoding. writeFileEncoding :: TextEncoding -> FilePath -> String -> IO () writeFileEncoding enc file x = withFile x WriteMode $ \h -> do     hSetEncoding h enc     hPutStr h x +-- | Write a file with the 'utf8' encoding. writeFileUTF8 :: FilePath -> String -> IO () writeFileUTF8 = writeFileEncoding utf8 +-- | Write a binary file. writeFileBinary :: FilePath -> String -> IO () writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x @@ -97,6 +117,8 @@                 hSetBuffering out buf  +-- | Execute an action with a custom 'BufferMode', a warpper around+--   'hSetBuffering'. withBuffering :: Handle -> BufferMode -> IO a -> IO a withBuffering h m act = bracket (hGetBuffering h) (hSetBuffering h) $ const $ do     hSetBuffering h m@@ -104,8 +126,14 @@  -- Temporary file -newTempFile :: (IO FilePath, FilePath -> IO ())-newTempFile = (create, ignore . removeFile)+-- | 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.+newTempFile :: IO (FilePath, IO ())+newTempFile = do+        file <- create+        del <- once $ ignore $ removeFile file+        return (file, del)     where         create = do             tmpdir <- getTemporaryDirectory@@ -114,11 +142,28 @@             return file  +-- | Create a temporary file in the temporary directory. The file will be deleted+--   after the action completes (provided the file is not still open).+--   The 'FilePath' will not have any file extension, will exist, and will be zero bytes long.+--   If you require a file with a specific name, use 'withTempDir'.+--+-- > withTempFile doesFileExist == return True+-- > (doesFileExist =<< withTempFile return) == return False+-- > withTempFile readFile' == return "" withTempFile :: (FilePath -> IO a) -> IO a-withTempFile = uncurry bracket newTempFile+withTempFile act = do+    (file, del) <- newTempFile+    act file `finally` del -newTempDir :: (IO FilePath, FilePath -> IO ())-newTempDir = (create, ignore . removeDirectoryRecursive)++-- | Provide a function to create a temporary directory, and a way to delete a+--   temporary directory. Most users should use 'withTempDir' which+--   combines these operations.+newTempDir :: IO (FilePath, IO ())+newTempDir = do+        dir <- create+        del <- once $ ignore $ removeDirectoryRecursive dir+        return (dir, del)     where         create = do             tmpdir <- getTemporaryDirectory@@ -133,5 +178,13 @@                 \e -> find tmpdir (x+1)  +-- | Create a temporary directory inside the system temporary directory.+--   The directory will be deleted after the action completes.+--+-- > withTempDir doesDirectoryExist == return True+-- > (doesDirectoryExist =<< withTempDir return) == return False+-- > withTempDir listFiles == return [] withTempDir :: (FilePath -> IO a) -> IO a-withTempDir = uncurry bracket newTempDir+withTempDir act = do+    (dir,del) <- newTempDir+    act dir `finally` del

@@ -1,47 +1,25 @@ {-# LANGUAGE CPP #-} +-- | Extra functions for the current system info. module System.Info.Extra(     module System.Info,-    isWindows, getProcessorCount+    isWindows     ) where  import System.Info-import System.IO.Unsafe-import Control.Exception.Extra-import System.Environment.Extra-import Foreign.C.Types-import Control.Concurrent-import Data.List  --------------------------------------------------------------------- -- System.Info +-- | Return 'True' on Windows and 'False' otherwise. A runtime version of @#ifdef minw32_HOST_OS@.+--   Equivalent to @os == \"mingw32\"@, but: more efficient; doesn't require typing an easily+--   mistypeable string; actually asks about your OS not a library; doesn't bake in+--   32bit assumptions that are already false. \<\/rant\>+--+-- > isWindows == (os == "mingw32") isWindows :: Bool #if defined(mingw32_HOST_OS) isWindows = True #else isWindows = False #endif----- Use the underlying GHC function-foreign import ccall getNumberOfProcessors :: IO CInt---{-# NOINLINE getProcessorCount #-}-getProcessorCount :: IO Int--- unsafePefromIO so we cache the result and only compute it once-getProcessorCount = let res = unsafePerformIO act in return res-    where-        act =-            if rtsSupportsBoundThreads then-                fmap fromIntegral getNumberOfProcessors-            else-                handle_ (const $ return 1) $ do-                    env <- lookupEnv "NUMBER_OF_PROCESSORS"-                    case env of-                        Just s | [(i,"")] <- reads s -> return i-                        _ -> do-                            src <- readFile "/proc/cpuinfo"-                            return $ length [() | x <- lines src, "processor" `isPrefixOf` x]-

@@ -1,5 +1,7 @@ {-# LANGUAGE TupleSections #-} +-- | Extra functions for creating processes. Specifically variants that automatically check+--   the 'ExitCode' and capture the 'stdout'\/'stderr' handles. module System.Process.Extra(     module System.Process,     system_, systemOutput, systemOutput_@@ -12,7 +14,7 @@   -- | A version of 'system' that also captures the output, both 'stdout' and 'stderr'.---   Returns a pair of the exit code and the output.+--   Returns a pair of the 'ExitCode' and the output. systemOutput :: String -> IO (ExitCode, String) systemOutput x = withTempFile $ \file -> do     exit <- withFile file WriteMode $ \h -> do

@@ -1,4 +1,9 @@ +-- | Extra functions for working with times. Unlike the other modules in this package, there is no+--   corresponding @System.Time@ module. This module enhances the functionality+--   from "Data.Time.Clock", but in quite different ways.+--+--   Throughout, time is measured in 'Seconds', which is a type alias for 'Double'. module System.Time.Extra(     Seconds,     sleep,

@@ -4,9 +4,10 @@ default(Maybe Bool,Int,Double,Maybe (Maybe Bool),Maybe (Maybe Char)) tests :: IO () tests = do+    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>"-    testGen "stringException \"test\"                           == return \"test\"" $ stringException "test"                           == return "test"+    testGen "stringException ['t','e','s','t',undefined]      == return \"test<Exception>\"" $ stringException ['t','e','s','t',undefined]      == return "test<Exception>"     testGen "ignore (print 1)    == print 1" $ ignore (print 1)    == print 1     testGen "ignore (fail \"die\") == return ()" $ ignore (fail "die") == return ()     testGen "retry 1 (print \"x\")  == print \"x\"" $ retry 1 (print "x")  == print "x"@@ -94,6 +95,11 @@     testGen "lower \"\" == \"\"" $ lower "" == ""     testGen "upper \"This is A TEST\" == \"THIS IS A TEST\"" $ upper "This is A TEST" == "THIS IS A TEST"     testGen "upper \"\" == \"\"" $ upper "" == ""+    testGen "word1 \"\" == (\"\", \"\")" $ word1 "" == ("", "")+    testGen "word1 \"keyword rest of string\" == (\"keyword\",\"rest of string\")" $ word1 "keyword rest of string" == ("keyword","rest of string")+    testGen "word1 \"  keyword\\n  rest of string\" == (\"keyword\",\"rest of string\")" $ word1 "  keyword\n  rest of string" == ("keyword","rest of string")+    testGen "\\s -> fst (word1 s) == concat (take 1 $ words s)" $ \s -> fst (word1 s) == concat (take 1 $ words s)+    testGen "\\s -> words (snd $ word1 s) == drop 1 (words s)" $ \s -> words (snd $ word1 s) == drop 1 (words s)     testGen "sortOn fst [(3,\"z\"),(1,\"\"),(3,\"a\")] == [(1,\"\"),(3,\"z\"),(3,\"a\")]" $ sortOn fst [(3,"z"),(1,""),(3,"a")] == [(1,""),(3,"z"),(3,"a")]     testGen "groupSort [(1,'t'),(3,'t'),(2,'e'),(2,'s')] == [(1,\"t\"),(2,\"es\"),(3,\"t\")]" $ groupSort [(1,'t'),(3,'t'),(2,'e'),(2,'s')] == [(1,"t"),(2,"es"),(3,"t")]     testGen "\\xs -> map fst (groupSort xs) == sort (nub (map fst xs))" $ \xs -> map fst (groupSort xs) == sort (nub (map fst xs))@@ -156,7 +162,23 @@     testGen "showDP 4 pi == \"3.1416\"" $ showDP 4 pi == "3.1416"     testGen "showDP 0 pi == \"3\"" $ showDP 0 pi == "3"     testGen "showDP 2 3  == \"3.00\"" $ showDP 2 3  == "3.00"+    testGen "withTempDir $ \\dir -> do writeFile (dir </> \"foo.txt\") \"\"; withCurrentDirectory dir $ doesFileExist \"foo.txt\"" $ withTempDir $ \dir -> do writeFile (dir </> "foo.txt") ""; withCurrentDirectory dir $ doesFileExist "foo.txt"+    testGen "withTempDir $ \\dir -> do writeFile (dir </> \"test.txt\") \"\"; (== [dir </> \"test.txt\"]) <$> listContents dir" $ withTempDir $ \dir -> do writeFile (dir </> "test.txt") ""; (== [dir </> "test.txt"]) <$> listContents dir+    let touch = mapM_ $ \x -> createDirectoryIfMissing True (takeDirectory x) >> writeFile x ""+    let listTest op as bs = withTempDir $ \dir -> do touch $ map (dir </>) as; res <- op dir; return $ map (drop (length dir + 1)) res == bs+    testGen "listTest listContents [\"bar.txt\",\"foo/baz.txt\",\"zoo\"] [\"bar.txt\",\"foo\",\"zoo\"]" $ listTest listContents ["bar.txt","foo/baz.txt","zoo"] ["bar.txt","foo","zoo"]+    testGen "listTest listFiles [\"bar.txt\",\"foo/baz.txt\",\"zoo\"] [\"bar.txt\",\"zoo\"]" $ listTest listFiles ["bar.txt","foo/baz.txt","zoo"] ["bar.txt","zoo"]+    testGen "listTest listFilesRecursive [\"bar.txt\",\"zoo\",\"foo\" </> \"baz.txt\"] [\"bar.txt\",\"zoo\",\"foo\" </> \"baz.txt\"]" $ listTest listFilesRecursive ["bar.txt","zoo","foo" </> "baz.txt"] ["bar.txt","zoo","foo" </> "baz.txt"]+    testGen "listTest (listFilesInside $ return . not . isPrefixOf \".\" . takeFileName)    [\"bar.txt\",\"foo\" </> \"baz.txt\",\".foo\" </> \"baz2.txt\", \"zoo\"] [\"bar.txt\",\"zoo\",\"foo\" </> \"baz.txt\"]" $ listTest (listFilesInside $ return . not . isPrefixOf "." . takeFileName)    ["bar.txt","foo" </> "baz.txt",".foo" </> "baz2.txt", "zoo"] ["bar.txt","zoo","foo" </> "baz.txt"]+    testGen "listTest (listFilesInside $ const $ return False) [\"bar.txt\"] []" $ listTest (listFilesInside $ const $ return False) ["bar.txt"] []+    testGen "isWindows == (os == \"mingw32\")" $ isWindows == (os == "mingw32")     testGen "captureOutput (print 1) == return (\"1\\n\",())" $ captureOutput (print 1) == return ("1\n",())+    testGen "withTempFile doesFileExist == return True" $ withTempFile doesFileExist == return True+    testGen "(doesFileExist =<< withTempFile return) == return False" $ (doesFileExist =<< withTempFile return) == return False+    testGen "withTempFile readFile' == return \"\"" $ withTempFile readFile' == return ""+    testGen "withTempDir doesDirectoryExist == return True" $ withTempDir doesDirectoryExist == return True+    testGen "(doesDirectoryExist =<< withTempDir return) == return False" $ (doesDirectoryExist =<< withTempDir return) == return False+    testGen "withTempDir listFiles == return []" $ withTempDir listFiles == return []     testGen "fmap (round . fst) (duration $ sleep 1) == return 1" $ fmap (round . fst) (duration $ sleep 1) == return 1     testGen "\\a b -> a > b ==> subtractTime a b > 0" $ \a b -> a > b ==> subtractTime a b > 0     testGen "showDuration 3.435   == \"3.44s\"" $ showDuration 3.435   == "3.44s"

@@ -1,5 +1,5 @@ -module TestUtil(runTests, testGen, erroneous, module X) where+module TestUtil(runTests, testGen, erroneous, (====), module X) where  import Test.QuickCheck import Test.QuickCheck.Test@@ -13,11 +13,15 @@ import Text.Show.Functions()  import Extra as X+import Control.Applicative as X import Control.Monad as X import Data.List as X import Data.Char as X import Data.Tuple as X-import Test.QuickCheck as X+import System.Directory as X+import System.FilePath as X+import System.Info as X+import Test.QuickCheck as X((==>))   {-# NOINLINE testCount #-}@@ -35,6 +39,8 @@ erroneous :: a -> Bool erroneous x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate x +(====) :: (Show a, Eq a) => a -> a -> Bool+a ==== b = if a == b then True else error $ "Not equal!\n" ++ show a ++ "\n" ++ show b  runTests :: IO () -> IO () runTests t = do