extra 0.2 → 0.3

raw patch · 21 files changed

+627/−191 lines, 21 filesdep +extradep +processdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: extra, process

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGES.txt +13/−0
• README.md +17/−1
• extra.cabal +9/−6
• src/Control/Concurrent/Extra.hs +93/−8
• src/Control/Exception/Extra.hs +49/−14
• src/Control/Monad/Extra.hs +31/−1
• src/Data/Either/Extra.hs +11/−0
• src/Data/IORef/Extra.hs +3/−5
• src/Data/List/Extra.hs +63/−28
• src/Data/Tuple/Extra.hs +47/−9
• src/Extra.hs +29/−8
• src/Numeric/Extra.hs +13/−4
• src/System/Directory/Extra.hs +21/−4
• src/System/IO/Extra.hs +48/−53
• src/System/Process/Extra.hs +33/−0
• src/System/Time/Extra.hs +21/−12
• src/Test.hs +0/−27
• src/TestUtil.hs +0/−11
• test/Test.hs +18/−0
• test/TestGen.hs +63/−0
• test/TestUtil.hs +45/−0

@@ -1,5 +1,18 @@ Changelog for Extra +0.3+    Rename showTime to showDuration+    Add stringException+    Eliminate rep/reps, use replace instead+    Switch distinct for allSame/anySame+    Optimise the numeric conversions+    Rename chop to repeatedly+    Add whenM/unlessM+    Redo the Tuple module, additions and deletions+    Add newTempFile, newTempDir+    Add createDirectoryPrivate+    Rename strip* to trim*+    Generalise showException 0.2     Redo the cons/uncons functions     Add withTempDir

@@ -1,3 +1,19 @@ # Extra [![Hackage version](https://img.shields.io/hackage/v/extra.svg?style=flat)](http://hackage.haskell.org/package/extra) [![Build Status](http://img.shields.io/travis/ndmitchell/extra.svg?style=flat)](https://travis-ci.org/ndmitchell/extra) -A library of extra functions for the standard Haskell libraries. Most functions are new, and add missing functionality. Some are available in later versions of GHC, but this package ports them back to GHC 7.2.+A library of extra functions for the standard Haskell libraries. Most functions are simple additions, filling out missing functionality. A few functions are available in later versions of GHC, but this package makes them available back to GHC 7.2. A few examples:++* `Control.Monad.Extra.concatMapM` provides a monadic version of `concatMap`, in the same way that `mapM` is a monadic version of `map`.+* `Data.Tuple.Extra.fst3` provides a function to get the first element of a triple.+* `Control.Exception.Extra.retry` provides a function that retries an `IO` action a number of times.+* `System.Environment.Extra.lookupEnv` is a functional available in GHC 7.6 and above. On GHC 7.6 and above this package reexports the version from `System.Environment` while on GHC 7.4 and below it defines an equivalent version.++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.++## Which functions?++When producing a library of extra functions I have been guided by a few principles. I encourage others with small useful utility functions contribute them here, perhaps as a temporary stop before proposing they join the standard libraries.++* I have been using most of these functions in my packages - they have proved useful enough to be worth copying/pasting into each project.+* The functions follow the spirit of the original Prelude/base libraries. I am happy to provide partial functions (e.g. `fromRight`), and functions which are specialisations of more generic functions (`whenJust`).+* Most of the functions have trivial implementations. If a beginner couldn't write the function, it probably doesn't belong here.+* I have defined only a few new data types or type aliases. It's a package for defining new utilities on existing types, not new types or concepts.

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               extra-version:            0.2+version:            0.3 license:            BSD3 license-file:       LICENSE category:           Development@@ -10,7 +10,9 @@ copyright:          Neil Mitchell 2014 synopsis:           Extra functions I use. description:-    A library of extra functions for the standard Haskell libraries. Most functions are new, and add missing functionality. Some are available in later versions of GHC, but this package ports them back to GHC 7.2.+    A library of extra functions for the standard Haskell libraries. Most functions are simple additions, filling out missing functionality. A few functions are available in later versions of GHC, but this package makes them available back to GHC 7.2.+    .+    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.8.2, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2@@ -30,6 +32,7 @@         base == 4.*,         directory,         filepath,+        process,         time     if !os(windows)         build-depends: unix@@ -48,6 +51,7 @@         System.Environment.Extra         System.Info.Extra         System.IO.Extra+        System.Process.Extra         System.Time.Extra  test-suite extra-test@@ -55,14 +59,13 @@     default-language: Haskell2010     build-depends:         base == 4.*,-        directory,-        filepath,-        time,+        extra,         QuickCheck     if !os(windows)         build-depends: unix-    hs-source-dirs: src+    hs-source-dirs: test     ghc-options: -main-is Test.main     main-is:        Test.hs     other-modules:         TestUtil+        TestGen

@@ -1,16 +1,20 @@ {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} +-- | Extra functions for "Control.Concurrent".+--   These functions manipulate the number of capabilities and new types of lock. module Control.Concurrent.Extra(     module Control.Concurrent,-    withNumCapabilities, setNumCapabilities+    withNumCapabilities, setNumCapabilities,+    forkFinally,+    Lock, newLock, withLock, withLockTry,+    Var, newVar, readVar, modifyVar, modifyVar_, withVar,+    Barrier, newBarrier, signalBarrier, waitBarrier, waitBarrierMaybe,     ) where  import Control.Concurrent-#if __GLASGOW_HASKELL__ >= 706-    hiding (setNumCapabilities)-import qualified Control.Concurrent-#endif import Control.Exception+import Control.Monad.Extra   -- | On GHC 7.6 and above with the @-threaded@ flag, brackets a call to 'setNumCapabilities'.@@ -22,10 +26,91 @@         bracket_ (setNumCapabilities new) (setNumCapabilities old) act  +#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 ()-#if __GLASGOW_HASKELL__ >= 706-setNumCapabilities n = Control.Concurrent.setNumCapabilities n-#else setNumCapabilities n = return () #endif+++#if __GLASGOW_HASKELL__ < 706+-- | fork a thread and call the supplied function when the thread is about+-- to terminate, with an exception or a returned value.  The function is+-- called with asynchronous exceptions masked.+--+-- >> forkFinally action and_then =+-- >>   mask $ \restore ->+-- >>     forkIO $ try (restore action) >>= and_then+--+-- This function is useful for informing the parent when a child+-- terminates, for example.+forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId+forkFinally action and_then =+  mask $ \restore ->+    forkIO $ try (restore action) >>= and_then+#endif+++---------------------------------------------------------------------+-- LOCK++-- | Like an MVar, but has no value+newtype Lock = Lock (MVar ())++newLock :: IO Lock+newLock = fmap Lock $ newMVar ()++withLock :: Lock -> IO a -> IO a+withLock (Lock x) = withMVar x . const++withLockTry :: Lock -> IO a -> IO (Maybe a)+withLockTry (Lock m) act =+    mask $ \restore -> do+        a <- tryTakeMVar m+        case a of+            Nothing -> return Nothing+            Just _ -> restore (fmap Just act) `finally` putMVar m ()+++---------------------------------------------------------------------+-- VAR++-- | Like an MVar, but must always be full+newtype Var a = Var (MVar a)++newVar :: a -> IO (Var a)+newVar = fmap Var . newMVar++readVar :: Var a -> IO a+readVar (Var x) = readMVar x++modifyVar :: Var a -> (a -> IO (a, b)) -> IO b+modifyVar (Var x) f = modifyMVar x f++modifyVar_ :: Var a -> (a -> IO a) -> IO ()+modifyVar_ (Var x) f = modifyMVar_ x f++withVar :: Var a -> (a -> IO b) -> IO b+withVar (Var x) f = withMVar x f+++---------------------------------------------------------------------+-- BARRIER++-- | Starts out empty, then is filled exactly once+newtype Barrier a = Barrier (MVar a)++newBarrier :: IO (Barrier a)+newBarrier = fmap Barrier newEmptyMVar++signalBarrier :: Barrier a -> a -> IO ()+signalBarrier (Barrier x) = void . tryPutMVar x++waitBarrier :: Barrier a -> IO a+waitBarrier (Barrier x) = readMVar x++waitBarrierMaybe :: Barrier a -> IO (Maybe a)+waitBarrierMaybe (Barrier x) = do+    res <- tryTakeMVar x+    whenJust res $ void . tryPutMVar x+    return res

@@ -1,7 +1,13 @@ +-- | 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, showException, ignore,+    retry,+    showException, stringException,+    -- * Exception catching/ignoring+    ignore,     catch_, handle_, try_,     catchJust_, handleJust_, tryJust_,     catchBool, handleBool, tryBool@@ -9,27 +15,43 @@  import Control.Exception import Control.Monad+import Data.List.Extra  --- | Print an exception, but if that exception itself contains exceptions, simply print---   @\<NestedException\>@. Since Haskell is a lazy language it is possible to throw---   exceptions that are themselves undefined. This function is useful to report them to users.-showException :: SomeException -> IO String-showException = f . show-    where-        f xs = do-            r <- try_ $ evaluate xs-            case r of-                Left e -> return "<NestedException>"-                Right [] -> return []-                Right (x:xs) -> fmap (x :) $ f xs+-- | Fully evaluate an input String. If the String contains embedded exceptions it will produce @\<Exception\>@.+--+-- > stringException ("test" ++ undefined)            == return "test<Exception>"+-- > stringException ("test" ++ undefined ++ "hello") == return "test<Exception>"+-- > stringException "test"                           == return "test"+stringException :: String -> IO String+stringException x = do+    r <- try_ $ evaluate $ list [] (\x xs -> x `seq` x:xs) x+    case r of+        Left e -> return "<Exception>"+        Right [] -> return []+        Right (x:xs) -> fmap (x:) $ stringException xs  --- | Ignore any exceptions thrown by the action and continue as normal.+-- | Show a value, but if the result contains exceptions, produce+--   @\<Exception\>@. Defined as @'stringException' . show@.+--   Particularly useful for printing exceptions to users, remembering that exceptions+--   can themselves contain undefined values.+showException :: Show e => e -> IO String+showException = stringException . show+++-- | Ignore any exceptions thrown by the action.+--+-- > ignore (print 1)    == print 1+-- > ignore (fail "die") == return () ignore :: IO () -> IO () ignore = void . try_  +-- | Retry an operation at most N times (N must be positive).+--+-- > 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@@ -40,30 +62,43 @@         Right v -> return v  +-- | A version of 'catch' without the 'Exception' context, restricted to 'SomeException',+--   so catches all exceptions. catch_ :: IO a -> (SomeException -> IO a) -> IO a catch_ = Control.Exception.catch +-- | Like 'catch_' but for 'catchJust' catchJust_ :: (SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO a catchJust_ = catchJust +-- | Like 'catch_' but for 'handle' handle_ :: (SomeException -> IO a) -> IO a -> IO a handle_ = handle +-- | Like 'catch_' but for 'handleJust' handleJust_ :: (SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO a handleJust_ = handleJust +-- | Like 'catch_' but for 'try' try_ :: IO a -> IO (Either SomeException a) try_ = try +-- | Like 'catch_' but for 'tryJust' tryJust_ :: (SomeException -> Maybe b) -> IO a -> IO (Either b a) tryJust_ = tryJust +-- | Catch an exception if the predicate passes, then call the handler with the original exception.+--   As an example:+--+-- >> readFileExists x == catchBool isDoesNotExistError (readFile "myfile") (const $ return "") catchBool :: Exception e => (e -> Bool) -> IO a -> (e -> IO a) -> IO a catchBool f a b = catchJust (bool f) a b +-- | Like 'catchBool' but for 'handle'. handleBool :: Exception e => (e -> Bool) -> (e -> IO a) -> IO a -> IO a handleBool f a b = handleJust (bool f) a b +-- | Like 'catchBool' but for 'try'. tryBool :: Exception e => (e -> Bool) -> IO a -> IO (Either e a) tryBool f a = tryJust (bool f) a 

@@ -1,29 +1,45 @@ +-- | Extra functions for "Control.Exception".+--   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> module Control.Monad.Extra(     module Control.Monad,     whenJust,     unit,-    partitionM, concatMapM,+    partitionM, concatMapM, mapMaybeM,     loopM, whileM,+    whenM, unlessM,     ifM, notM, (||^), (&&^), orM, andM, anyM, allM,     findM, firstJustM     ) where  import Control.Monad import Control.Applicative+import Data.Maybe  -- General utilities +-- | Perform some operation on 'Just', given the field inside the 'Just'.+--+-- > whenJust Nothing  print == return ()+-- > whenJust (Just 1) print == print 1 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+--   with overloaded return times.+--+-- > \(x :: Maybe ()) -> unit x == x unit :: m () -> m () unit = id  -- Data.List for Monad +-- | A version of 'partition' that works with a monadic predicate.+--+-- > partitionM (Just . even) [1,2,3] == Just ([2], [1,3])+-- > partitionM (const Nothing) [1,2,3] == Nothing partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) partitionM f [] = return ([], []) partitionM f (x:xs) = do@@ -32,11 +48,18 @@     return ([x | res]++as, [x | not res]++bs)  +-- | A version of 'concatMap' that works with a monadic predicate. concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f = liftM concat . mapM f +-- | A version of 'mapMaybe' that works with a monadic predicate.+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeM f = liftM catMaybes . mapM f+ -- Looping +-- | A looping operation, where the predicate returns 'Left' as a seed for the next loop+--   or 'Right' to abort the loop. loopM :: Monad m => (a -> m (Either a b)) -> a -> m b loopM act x = do     res <- act x@@ -44,12 +67,19 @@         Left x -> loopM act x         Right v -> return v +-- | Keep running an operation until it becomes 'False'. whileM :: Monad m => m Bool -> m () whileM act = do     b <- act     when b $ whileM act  -- Booleans++whenM :: Monad m => m Bool -> m () -> m ()+whenM b t = ifM b t (return ())++unlessM :: Monad m => m Bool -> m () -> m ()+unlessM b f = ifM b (return ()) f  ifM :: Monad m => m Bool -> m a -> m a -> m a ifM b t f = do b <- b; if b then t else f

@@ -8,7 +8,16 @@  import Data.Either +-- | The 'fromLeft' function extracts the element out of a 'Left' and+--   throws an error if its argument is 'Right'.+--   Much like 'fromJust', using this function in polished code is usually a bad idea.+fromLeft :: Either l r -> l fromLeft (Left x) = x++-- | The 'fromRight' function extracts the element out of a 'Right' and+--   throws an error if its argument is 'Left'.+--   Much like 'fromJust', using this function in polished code is usually a bad idea.+fromRight :: Either l r -> r fromRight (Right x) = x  #if __GLASGOW_HASKELL__ < 708@@ -16,5 +25,7 @@ isRight Right{} = True; isRight _ = False #endif +-- | Pull the value out of an 'Either' where both alternatives+--   have the same type. fromEither :: Either a a -> a fromEither = either id id

@@ -10,12 +10,13 @@ import Control.Exception  --- Evaluates before writing to the IORef+-- | 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' atomicWriteIORef' :: IORef a -> a -> IO () atomicWriteIORef' ref x = do     evaluate x@@ -24,10 +25,7 @@  #if __GLASGOW_HASKELL__ < 706 ------------------------------------------------------------------------- Data.IORef---- Two 's because GHC 7.6 has a strict modifyIORef+-- | Version of 'modifyIORef' that evaluates the function. modifyIORef' :: IORef a -> (a -> a) -> IO () modifyIORef' ref f = do     x <- readIORef ref

@@ -6,14 +6,13 @@ --   Some of the names and semantics were inspired by the @text@ package. module Data.List.Extra(     module Data.List,-    lower, upper, strip, stripStart, stripEnd, dropAround, word1, drop1,+    lower, upper, trim, trimStart, trimEnd, dropAround, word1, drop1,     list, uncons, unsnoc, cons, snoc,     groupSort, groupSortOn, nubOn, groupOn, sortOn,-    chop, for,-    rep, reps,-    disjoint, distinct,-    dropEnd, takeEnd, breakEnd, spanEnd, dropWhileEnd, takeWhileEnd, stripSuffix,-    concatUnzip,+    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     ) where@@ -21,33 +20,51 @@ import Data.List import Data.Function import Data.Ord-import Control.Arrow import Data.Char import Data.Tuple.Extra  -chop :: ([a] -> (b, [a])) -> [a] -> [b]-chop f [] = []-chop f as = b : chop f as'+-- | Apply some operation repeatedly, producing an element of output+--   and the remainder of the list.+--+-- > \xs -> repeatedly (splitAt 3) xs  == chunksOf 3 xs+-- > \xs -> repeatedly word1 (trim xs) == words xs+repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]+repeatedly f [] = []+repeatedly f as = b : repeatedly f as'     where (b, as') = f as -rep :: Eq a => a -> a -> a -> a-rep from to x = if x == from then to else x -reps :: Eq a => a -> a -> [a] -> [a]-reps from to = map (rep from to)--+-- | Flipped version of 'map'.+--+-- > for [1,2,3] (+1) == [2,3,4] for :: [a] -> (a -> b) -> [b] for = flip map +-- | Are two lists disjoint, with no elements in common.+--+-- > disjoint [1,2,3] [4,5] == True+-- > disjoint [1,2,3] [4,1] == False disjoint :: Eq a => [a] -> [a] -> Bool disjoint xs = null . intersect xs -distinct :: Eq a => [a] -> Bool-distinct xs = length xs == length (nub xs)+-- | Is there any element which occurs more than once.+--+-- > anySame [1,1,2] == True+-- > anySame [1,2,3] == False+anySame :: Eq a => [a] -> Bool+anySame xs = length xs /= length (nub xs) +-- | Are all elements the same.+--+-- > allSame [1,1,2] == False+-- > allSame [1,1,1] == True+-- > allSame [1]     == True+-- > allSame []      == True+allSame :: Eq a => [a] -> Bool+allSame xs = length (nub xs) <= 1 + list :: b -> (a -> [a] -> b) -> [a] -> b list nil cons [] = nil list nil cons (x:xs) = cons x xs@@ -77,16 +94,24 @@ concatUnzip :: [([a], [b])] -> ([a], [b]) concatUnzip = (concat *** concat) . unzip +concatUnzip3 :: [([a],[b],[c])] -> ([a],[b],[c])+concatUnzip3 xs = (concat a, concat b, concat c)+    where (a,b,c) = unzip3 xs + takeWhileEnd :: (a -> Bool) -> [a] -> [a] takeWhileEnd f = reverse . takeWhile f . reverse  -strip, stripStart, stripEnd :: String -> String-stripStart = dropWhile isSpace-stripEnd = dropWhileEnd isSpace-strip = dropAround isSpace+trim, trimStart, trimEnd :: String -> String+trimStart = dropWhile isSpace+trimEnd = dropWhileEnd isSpace+trim = dropAround isSpace +-- | Documentation about lowercase+--+-- > lower "This is A TEST" == "this is a test"+-- > lower "" == "" lower :: String -> String lower = map toLower @@ -128,7 +153,7 @@     | f x y /= GT = x : mergeBy f xs (y:ys)     | otherwise = y : mergeBy f (x:xs) ys -replace :: String -> String -> String -> String+replace :: Eq a => [a] -> [a] -> [a] -> [a] replace from to xs | Just xs <- stripPrefix from xs = to ++ replace from to xs replace from to (x:xs) = x : replace from to xs replace from to [] = []@@ -237,6 +262,12 @@ dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] #endif ++-- | A version of 'dropWhileEnd' but with different strictness properties.+--   Often outperforms if the list is short or the test is expensive.+dropWhileEnd' :: (a -> Bool) -> [a] -> [a]+dropWhileEnd' p = foldr (\x xs -> if null xs && p x then [] else x : xs) []+ -- | Return the prefix of the second string if its suffix -- matches the entire first string. --@@ -249,9 +280,13 @@ stripSuffix a b = fmap reverse $ stripPrefix (reverse a) (reverse b)  +-- | Split a list into chunks of a given size. The last chunk may contain+--   fewer than n elements. The chunk size must be positive.+--+-- > chunksOf 3 "my test" == ["my ","tes","t"]+-- > chunksOf 3 "mytest"  == ["myt","est"]+-- > chunksOf 8 ""        == []+-- > chunksOf 0 "test"    == error chunksOf :: Int -> [a] -> [[a]]-chunksOf i _ | i <= 0 = error $ "chunksOf, number must be positive, got " ++ show i-chunksOf i [] = []-chunksOf i xs = a : chunksOf i b-    where (a,b) = splitAt i xs-+chunksOf i xs | i <= 0 = error $ "chunksOf, number must be positive, got " ++ show i+chunksOf i xs = repeatedly (splitAt i) xs

@@ -1,11 +1,42 @@ +-- | Extra functions for working with tuples.+--   Some of these functions are available in the "Control.Arrow" module,+--   but here are available specialised to pairs. module Data.Tuple.Extra(     module Data.Tuple,-    dupe, fst3, snd3, thd3, concat2, concat3+    -- * Specialised 'Arrow' functions+    first, second, (***), (&&&),+    -- * More pair operations+    dupe, both,+    -- * Operations on triples+    fst3, snd3, thd3, first3, second3, third3, dupe3, both3,     ) where  import Data.Tuple+import qualified Control.Arrow as Arrow +infixr 3 ***, &&&++-- | Update the first component of a pair.+first :: (a -> a') -> (a, b) -> (a', b)+first = Arrow.first++-- | Update the second component of a pair.+second :: (b -> b') -> (a, b) -> (a, b')+second = Arrow.second++(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')+(***) = (Arrow.***)++(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)+(&&&) = (Arrow.&&&)++dupe :: a -> (a,a)+dupe x = (x,x)++both :: (a -> b) -> (a, a) -> (b, b)+both f (x,y) = (f x, f y)+ fst3 :: (a,b,c) -> a fst3 (a,b,c) = a @@ -15,13 +46,20 @@ thd3 :: (a,b,c) -> c thd3 (a,b,c) = c -concat3 :: [([a],[b],[c])] -> ([a],[b],[c])-concat3 xs = (concat a, concat b, concat c)-    where (a,b,c) = unzip3 xs+-- | Update the first component of a triple.+first3 :: (a -> a') -> (a, b, c) -> (a', b, c)+first3 f (a,b,c) = (f a, b, c) -concat2 :: [([a],[b])] -> ([a],[b])-concat2 xs = (concat a, concat b)-    where (a,b) = unzip xs+-- | Update the second component of a triple.+second3 :: (b -> b') -> (a, b, c) -> (a, b', c)+second3 f (a,b,c) = (a, f b, c) -dupe :: a -> (a,a)-dupe x = (x,x)+-- | Update the third component of a triple.+third3 :: (c -> c') -> (a, b, c) -> (a, b, c')+third3 f (a,b,c) = (a, b, f c)++dupe3 :: a -> (a,a,a)+dupe3 x = (x,x,x)++both3 :: (a -> b) -> (a, a, a) -> (b, b, b)+both3 f (x,y,z) = (f x, f y, f z)

@@ -1,30 +1,50 @@+-- | This module documents all the functions available in this package.+--+--   Most users should import the specific modules (e.g. @"Data.List.Extra"@), which+--   also reexport their non-@Extra@ modules (e.g. @"Data.List"@). module Extra(     -- * Control.Concurrent.Extra-    withNumCapabilities, setNumCapabilities,+    -- | 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,     -- * Control.Exception.Extra-    retry, showException, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,+    -- | Extra functions available in @"Control.Exception.Extra"@.+    retry, showException, stringException, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,     -- * Control.Monad.Extra-    whenJust, unit, partitionM, concatMapM, loopM, whileM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, findM, firstJustM,+    -- | Extra functions available in @"Control.Monad.Extra"@.+    whenJust, unit, partitionM, concatMapM, mapMaybeM, loopM, whileM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, findM, firstJustM,     -- * Data.Either.Extra+    -- | Extra functions available in @"Data.Either.Extra"@.     isLeft, isRight, fromLeft, fromRight, fromEither,     -- * Data.IORef.Extra+    -- | Extra functions available in @"Data.IORef.Extra"@.     modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef',     -- * Data.List.Extra-    lower, upper, strip, stripStart, stripEnd, dropAround, word1, drop1, list, uncons, unsnoc, cons, snoc, groupSort, groupSortOn, nubOn, groupOn, sortOn, chop, for, rep, reps, disjoint, distinct, dropEnd, takeEnd, breakEnd, spanEnd, dropWhileEnd, takeWhileEnd, stripSuffix, concatUnzip, merge, mergeBy, replace, wordsBy, linesBy, firstJust, breakOn, breakOnEnd, splitOn, split, chunksOf,+    -- | Extra functions available in @"Data.List.Extra"@.+    lower, upper, trim, trimStart, trimEnd, dropAround, word1, drop1, list, uncons, unsnoc, cons, snoc, groupSort, groupSortOn, 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,     -- * Data.Tuple.Extra-    dupe, fst3, snd3, thd3, concat2, concat3,+    -- | Extra functions available in @"Data.Tuple.Extra"@.+    first, second, (***), (&&&), dupe, both, fst3, snd3, thd3, first3, second3, third3, dupe3, both3,     -- * Numeric.Extra+    -- | Extra functions available in @"Numeric.Extra"@.     showDP, intToDouble, intToFloat, floatToDouble, doubleToFloat,     -- * System.Directory.Extra-    withCurrentDirectory, getDirectoryContentsRecursive,+    -- | Extra functions available in @"System.Directory.Extra"@.+    withCurrentDirectory, getDirectoryContentsRecursive, createDirectoryPrivate,     -- * System.Environment.Extra+    -- | Extra functions available in @"System.Environment.Extra"@.     getExecutablePath, lookupEnv,     -- * System.Info.Extra+    -- | Extra functions available in @"System.Info.Extra"@.     isWindows, getProcessorCount,     -- * System.IO.Extra-    readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, captureOutput, withBuffering,+    -- | Extra functions available in @"System.IO.Extra"@.+    readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, newTempFile, newTempDir, captureOutput, withBuffering,+    -- * System.Process.Extra+    -- | Extra functions available in @"System.Process.Extra"@.+    system_, systemOutput, systemOutput_,     -- * System.Time.Extra-    sleep, subtractTime, showTime, offsetTime, offsetTimeIncrease, duration,+    -- | Extra functions available in @"System.Time.Extra"@.+    Seconds, sleep, subtractTime, showDuration, offsetTime, offsetTimeIncrease, duration,     ) where  import Control.Concurrent.Extra@@ -39,4 +59,5 @@ import System.Environment.Extra import System.Info.Extra import System.IO.Extra+import System.Process.Extra import System.Time.Extra

@@ -11,6 +11,11 @@ --------------------------------------------------------------------- -- Data.String +-- | Show a number to a number of decimal places.+--+-- > showDP 4 pi == "3.1416"+-- > showDP 0 pi == "3"+-- > showDP 2 3  == "3.00" showDP :: RealFloat a => Int -> a -> String showDP n x = a ++ (if n > 0 then "." else "") ++ b ++ replicate (n - length b) '0'     where (a,b) = second (drop 1) $ break (== '.') $ showFFloat (Just n) x ""@@ -19,16 +24,20 @@ --------------------------------------------------------------------- -- Numeric +-- | Specialised numeric conversion. intToDouble :: Int -> Double-intToDouble = fromInteger . toInteger+intToDouble = fromIntegral +-- | Specialised numeric conversion. intToFloat :: Int -> Float-intToFloat = fromInteger . toInteger+intToFloat = fromIntegral +-- | Specialised numeric conversion. floatToDouble :: Float -> Double-floatToDouble = fromRational . toRational+floatToDouble = realToFrac +-- | Specialised numeric conversion. doubleToFloat :: Double -> Float-doubleToFloat = fromRational . toRational+doubleToFloat = realToFrac  

@@ -1,7 +1,8 @@+{-# LANGUAGE CPP #-}  module System.Directory.Extra(     module System.Directory,-    withCurrentDirectory, getDirectoryContentsRecursive+    withCurrentDirectory, getDirectoryContentsRecursive, createDirectoryPrivate     ) where  import System.Directory@@ -10,17 +11,33 @@ import Data.List import Control.Exception +#ifndef mingw32_HOST_OS+import qualified System.Posix+#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. 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     xs <- getDirectoryContents dir-    (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ isBadDir x]+    (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ all (== '.') x]     rest <- concatMapM getDirectoryContentsRecursive $ sort dirs     return $ sort files ++ rest-    where-        isBadDir x = "." `isPrefixOf` x -- FIXME, need a version that can also exclude _ dirs+++-- | Create a directory with permissions so that only the current user can view it.+--   On Windows this function is equivalent to 'createDirectory'.+createDirectoryPrivate :: String -> IO ()+#ifdef mingw32_HOST_OS+createDirectoryPrivate s = createDirectory s+#else+createDirectoryPrivate s = System.Posix.createDirectory s 0o700+#endif

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | More advanced temporary file manipulation functions can be found in the @exceptions@ package. module System.IO.Extra(@@ -6,7 +6,7 @@     readFileEncoding, readFileUTF8, readFileBinary,     readFile', readFileEncoding', readFileUTF8', readFileBinary',     writeFileEncoding, writeFileUTF8, writeFileBinary,-    withTempFile, withTempDir,+    withTempFile, withTempDir, newTempFile, newTempDir,     captureOutput,     withBuffering,     ) where@@ -14,17 +14,13 @@ import System.IO import Control.Exception.Extra as E import GHC.IO.Handle(hDuplicate,hDuplicateTo)-import System.Directory+import System.Directory.Extra import System.IO.Error import System.FilePath import Data.Char import Data.Time.Clock -#ifndef mingw32_HOST_OS-import qualified System.Posix-#endif - -- File reading  readFileEncoding :: TextEncoding -> FilePath -> IO String@@ -78,24 +74,27 @@ writeFileBinary :: FilePath -> String -> IO () writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x --- Other+-- Console -captureOutput :: IO () -> IO String+-- | Capture the 'stdout' and 'stderr' of a computation.+--+-- > captureOutput (print 1) == return ("1\n",())+captureOutput :: IO a -> IO (String, a) captureOutput act = withTempFile $ \file -> do-    h <- openFile file ReadWriteMode-    bout <- hGetBuffering stdout-    berr <- hGetBuffering stderr-    sto <- hDuplicate stdout-    ste <- hDuplicate stderr-    hDuplicateTo h stdout-    hDuplicateTo h stderr-    hClose h-    act-    hDuplicateTo sto stdout-    hDuplicateTo ste stderr-    hSetBuffering stdout bout-    hSetBuffering stderr berr-    readFile' file+    withFile file ReadWriteMode $ \h -> do+        res <- clone stdout h $ clone stderr h $ do+            hClose h+            act+        out <- readFile' file+        return (out, res)+    where+        clone out h act = do+            buf <- hGetBuffering out+            out2 <- hDuplicate out+            hDuplicateTo h out+            act `finally` do+                hDuplicateTo out2 out+                hSetBuffering out buf   withBuffering :: Handle -> BufferMode -> IO a -> IO a@@ -103,40 +102,36 @@     hSetBuffering h m     act +-- Temporary file -withTempFile :: (FilePath -> IO a) -> IO a-withTempFile act = do-    tmpdir <- getTemporaryDirectory-    bracket-        (openTempFile tmpdir "extra")-        (\(file, h) -> ignore $ removeFile file)-        (\(file, h) -> hClose h >> act file)+newTempFile :: (IO FilePath, FilePath -> IO ())+newTempFile = (create, ignore . removeFile)+    where+        create = do+            tmpdir <- getTemporaryDirectory+            (file, h) <- openTempFile tmpdir "extra"+            hClose h+            return file  -withTempDir :: (FilePath -> IO a) -> IO a-withTempDir act = do-    tmpdir <- getTemporaryDirectory-    bracket-        (createTempDirectory tmpdir "extra")-        (ignore . removeDirectoryRecursive)-        act-+withTempFile :: (FilePath -> IO a) -> IO a+withTempFile = uncurry bracket newTempFile -createTempDirectory :: FilePath -> String -> IO FilePath-createTempDirectory dir prefix = do-    -- 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-    findTempName rand+newTempDir :: (IO FilePath, FilePath -> IO ())+newTempDir = (create, ignore . removeDirectoryRecursive)     where-        findTempName x = do-            let dirpath = dir </> prefix ++ show x+        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             catchBool isAlreadyExistsError-                (mkPrivateDir dirpath >> return dirpath) $-                \e -> findTempName (x+1)+                (createDirectoryPrivate dir >> return dir) $+                \e -> find tmpdir (x+1) -mkPrivateDir :: String -> IO ()-#ifdef mingw32_HOST_OS-mkPrivateDir s = createDirectory s-#else-mkPrivateDir s = System.Posix.createDirectory s 0o700-#endif++withTempDir :: (FilePath -> IO a) -> IO a+withTempDir = uncurry bracket newTempDir

@@ -0,0 +1,33 @@+{-# LANGUAGE TupleSections #-}++module System.Process.Extra(+    module System.Process,+    system_, systemOutput, systemOutput_+    ) where++import Control.Monad+import System.IO.Extra+import System.Process+import System.Exit+++systemOutput :: String -> IO (ExitCode, String)+systemOutput x = withTempFile $ \file -> do+    exit <- withFile file WriteMode $ \h -> do+        (_, _, _, pid) <- createProcess (shell x){std_out=UseHandle h, std_err=UseHandle h}+        waitForProcess pid+    fmap (exit,) $ readFile' file+++system_ :: String -> IO ()+system_ x = do+    res <- system x+    when (res /= ExitSuccess) $+        error $ "Failed when running system command: " ++ x++systemOutput_ :: String -> IO String+systemOutput_ x = do+    (res,out) <- systemOutput x+    when (res /= ExitSuccess) $+        error $ "Failed when running system command: " ++ x+    return out

@@ -1,8 +1,9 @@  module System.Time.Extra(+    Seconds,     sleep,     subtractTime,-    showTime,+    showDuration,     offsetTime, offsetTimeIncrease, duration     ) where @@ -11,27 +12,35 @@ import Numeric.Extra import Data.IORef +type Seconds = Double -sleep :: Double -> IO ()+sleep :: Seconds -> IO () sleep x = threadDelay $ ceiling $ x * 1000000  -subtractTime :: UTCTime -> UTCTime -> Double+subtractTime :: UTCTime -> UTCTime -> Seconds subtractTime end start = fromRational $ toRational $ end `diffUTCTime` start  -showTime :: Double -> String-showTime x | x >= 3600 = f (x / 60) "h" "m"-           | x >= 60 = f x "m" "s"-           | otherwise = showDP 2 x ++ "s"+-- | Show a number of seconds, typically a duration, in a suitable manner with+--   responable precision for a human.+--+-- > showDuration 3.435   == "3.44s"+-- > showDuration 623.8   == "10m24s"+-- > showDuration 62003.8 == "17h13m"+-- > showDuration 1e8     == "27777h47m"+showDuration :: Seconds -> String+showDuration x+    | x >= 3600 = f (x / 60) "h" "m"+    | x >= 60 = f x "m" "s"+    | otherwise = showDP 2 x ++ "s"     where-        f x m s = show ms ++ m ++ ['0' | ss < 10] ++ show ss ++ m+        f x m s = show ms ++ m ++ ['0' | ss < 10] ++ show ss ++ s             where (ms,ss) = round x `divMod` 60  - -- | Call once at the start, then call repeatedly to get Time values out-offsetTime :: IO (IO Double)+offsetTime :: IO (IO Seconds) offsetTime = do     start <- getCurrentTime     return $ do@@ -39,7 +48,7 @@         return $ end `subtractTime` start  -- | Like offsetTime, but results will never decrease (though they may stay the same)-offsetTimeIncrease :: IO (IO Double)+offsetTimeIncrease :: IO (IO Seconds) offsetTimeIncrease = do     t <- offsetTime     ref <- newIORef 0@@ -48,7 +57,7 @@         atomicModifyIORef ref $ \o -> let m = max t o in m `seq` (m, m)  -duration :: IO a -> IO (Double, a)+duration :: IO a -> IO (Seconds, a) duration act = do     time <- offsetTime     res <- act

@@ -1,27 +0,0 @@-{-# LANGUAGE ExtendedDefaultRules #-}-module Test(main) where-import TestUtil-import Extra-import Data.List-import Test.QuickCheck-default(Maybe Bool,Int,Double)-main :: IO ()-main = do-  test "Just False &&^ undefined == Just False" $ Just False &&^ undefined == Just False-  test "Just True &&^ Just True == Just True" $ Just True &&^ Just True == Just True-  test "breakOn \"::\" \"a::b::c\" == (\"a\", \"::b::c\")" $ breakOn "::" "a::b::c" == ("a", "::b::c")-  test "breakOn \"/\" \"foobar\"   == (\"foobar\", \"\")" $ breakOn "/" "foobar"   == ("foobar", "")-  test "\\needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack" $ \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack-  test "breakOnEnd \"::\" \"a::b::c\" == (\"a::b::\", \"c\")" $ breakOnEnd "::" "a::b::c" == ("a::b::", "c")-  test "splitOn \"\\r\\n\" \"a\\r\\nb\\r\\nd\\r\\ne\" == [\"a\",\"b\",\"d\",\"e\"]" $ splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]-  test "splitOn \"aaa\"  \"aaaXaaaXaaaXaaa\"  == [\"\",\"X\",\"X\",\"X\",\"\"]" $ splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]-  test "splitOn \"x\"    \"x\"                == [\"\",\"\"]" $ splitOn "x"    "x"                == ["",""]-  test "splitOn \"x\"    \"\"                 == [\"\"]" $ splitOn "x"    ""                 == [""]-  test "\\s x -> s /= \"\" ==> intercalate s (splitOn s x) == x" $ \s x -> s /= "" ==> intercalate s (splitOn s x) == x-  test "\\c x -> splitOn [c] x                           == split (==c) x" $ \c x -> splitOn [c] x                           == split (==c) x-  test "split (=='a') \"aabbaca\" == [\"\",\"\",\"bb\",\"c\",\"\"]" $ split (=='a') "aabbaca" == ["","","bb","c",""]-  test "split (=='a') \"\"        == [\"\"]" $ split (=='a') ""        == [""]-  test "stripSuffix \"bar\" \"foobar\" == Just \"foo\"" $ stripSuffix "bar" "foobar" == Just "foo"-  test "stripSuffix \"\"    \"baz\"    == Just \"baz\"" $ stripSuffix ""    "baz"    == Just "baz"-  test "stripSuffix \"foo\" \"quux\"   == Nothing" $ stripSuffix "foo" "quux"   == Nothing-  putStrLn "Success"

@@ -1,11 +0,0 @@-module TestUtil(test) where--import Test.QuickCheck-import Test.QuickCheck.Test hiding (test)-import Control.Monad--test :: Testable prop => String -> prop -> IO ()-test msg prop = do-    putStrLn msg-    r <- quickCheckResult prop-    unless (isSuccess r) $ error "Test failed"

@@ -0,0 +1,18 @@++module Test(main) where++import TestGen+import TestUtil++-- Check that we managed to export everything+import Extra(Seconds, whenJust, (&&^), system_, word1, readFile')+_unused1 x = whenJust+_unused2 x = (&&^)+_unused3 x = system_+_unused4 x = word1+_unused5 x = readFile'+_unused6 x = x :: Seconds+++main :: IO ()+main = runTests $ tests

@@ -0,0 +1,63 @@+{-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables #-}+module TestGen(tests) where+import TestUtil+import Extra+import Data.List+import Test.QuickCheck+default(Maybe Bool,Int,Double)+tests :: IO ()+tests = do+    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 "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"+    testGen "retry 3 (fail \"die\") == fail \"die\"" $ retry 3 (fail "die") == fail "die"+    testGen "whenJust Nothing  print == return ()" $ whenJust Nothing  print == return ()+    testGen "whenJust (Just 1) print == print 1" $ whenJust (Just 1) print == print 1+    testGen "\\(x :: Maybe ()) -> unit x == x" $ \(x :: Maybe ()) -> unit x == x+    testGen "partitionM (Just . even) [1,2,3] == Just ([2], [1,3])" $ partitionM (Just . even) [1,2,3] == Just ([2], [1,3])+    testGen "partitionM (const Nothing) [1,2,3] == Nothing" $ partitionM (const Nothing) [1,2,3] == Nothing+    testGen "Just False &&^ undefined == Just False" $ Just False &&^ undefined == Just False+    testGen "Just True &&^ Just True == Just True" $ Just True &&^ Just True == Just True+    testGen "\\xs -> repeatedly (splitAt 3) xs  == chunksOf 3 xs" $ \xs -> repeatedly (splitAt 3) xs  == chunksOf 3 xs+    testGen "\\xs -> repeatedly word1 (trim xs) == words xs" $ \xs -> repeatedly word1 (trim xs) == words xs+    testGen "for [1,2,3] (+1) == [2,3,4]" $ for [1,2,3] (+1) == [2,3,4]+    testGen "disjoint [1,2,3] [4,5] == True" $ disjoint [1,2,3] [4,5] == True+    testGen "disjoint [1,2,3] [4,1] == False" $ disjoint [1,2,3] [4,1] == False+    testGen "anySame [1,1,2] == True" $ anySame [1,1,2] == True+    testGen "anySame [1,2,3] == False" $ anySame [1,2,3] == False+    testGen "allSame [1,1,2] == False" $ allSame [1,1,2] == False+    testGen "allSame [1,1,1] == True" $ allSame [1,1,1] == True+    testGen "allSame [1]     == True" $ allSame [1]     == True+    testGen "allSame []      == True" $ allSame []      == True+    testGen "lower \"This is A TEST\" == \"this is a test\"" $ lower "This is A TEST" == "this is a test"+    testGen "lower \"\" == \"\"" $ lower "" == ""+    testGen "breakOn \"::\" \"a::b::c\" == (\"a\", \"::b::c\")" $ breakOn "::" "a::b::c" == ("a", "::b::c")+    testGen "breakOn \"/\" \"foobar\"   == (\"foobar\", \"\")" $ breakOn "/" "foobar"   == ("foobar", "")+    testGen "\\needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack" $ \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack+    testGen "breakOnEnd \"::\" \"a::b::c\" == (\"a::b::\", \"c\")" $ breakOnEnd "::" "a::b::c" == ("a::b::", "c")+    testGen "splitOn \"\\r\\n\" \"a\\r\\nb\\r\\nd\\r\\ne\" == [\"a\",\"b\",\"d\",\"e\"]" $ splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]+    testGen "splitOn \"aaa\"  \"aaaXaaaXaaaXaaa\"  == [\"\",\"X\",\"X\",\"X\",\"\"]" $ splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]+    testGen "splitOn \"x\"    \"x\"                == [\"\",\"\"]" $ splitOn "x"    "x"                == ["",""]+    testGen "splitOn \"x\"    \"\"                 == [\"\"]" $ splitOn "x"    ""                 == [""]+    testGen "\\s x -> s /= \"\" ==> intercalate s (splitOn s x) == x" $ \s x -> s /= "" ==> intercalate s (splitOn s x) == x+    testGen "\\c x -> splitOn [c] x                           == split (==c) x" $ \c x -> splitOn [c] x                           == split (==c) x+    testGen "split (=='a') \"aabbaca\" == [\"\",\"\",\"bb\",\"c\",\"\"]" $ split (=='a') "aabbaca" == ["","","bb","c",""]+    testGen "split (=='a') \"\"        == [\"\"]" $ split (=='a') ""        == [""]+    testGen "stripSuffix \"bar\" \"foobar\" == Just \"foo\"" $ stripSuffix "bar" "foobar" == Just "foo"+    testGen "stripSuffix \"\"    \"baz\"    == Just \"baz\"" $ stripSuffix ""    "baz"    == Just "baz"+    testGen "stripSuffix \"foo\" \"quux\"   == Nothing" $ stripSuffix "foo" "quux"   == Nothing+    testGen "chunksOf 3 \"my test\" == [\"my \",\"tes\",\"t\"]" $ chunksOf 3 "my test" == ["my ","tes","t"]+    testGen "chunksOf 3 \"mytest\"  == [\"myt\",\"est\"]" $ chunksOf 3 "mytest"  == ["myt","est"]+    testGen "chunksOf 8 \"\"        == []" $ chunksOf 8 ""        == []+    testGen "chunksOf 0 \"test\"    == error" $ erroneous $ chunksOf 0 "test"   +    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 "captureOutput (print 1) == return (\"1\\n\",())" $ captureOutput (print 1) == return ("1\n",())+    testGen "showDuration 3.435   == \"3.44s\"" $ showDuration 3.435   == "3.44s"+    testGen "showDuration 623.8   == \"10m24s\"" $ showDuration 623.8   == "10m24s"+    testGen "showDuration 62003.8 == \"17h13m\"" $ showDuration 62003.8 == "17h13m"+    testGen "showDuration 1e8     == \"27777h47m\"" $ showDuration 1e8     == "27777h47m"

@@ -0,0 +1,45 @@++module TestUtil(runTests, testGen, erroneous) where++import Test.QuickCheck+import Test.QuickCheck.Test+import Control.Monad+import Control.Exception.Extra+import Data.Either.Extra+import System.IO.Extra+import Data.IORef+import System.IO.Unsafe+++{-# NOINLINE testCount #-}+testCount :: IORef Int+testCount = unsafePerformIO $ newIORef 0++testGen :: Testable prop => String -> prop -> IO ()+testGen msg prop = do+    putStrLn msg+    r <- quickCheckResult prop+    unless (isSuccess r) $ error "Test failed"+    modifyIORef testCount (+1)+++erroneous :: a -> Bool+erroneous x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate x+++runTests :: IO () -> IO ()+runTests t = do+    writeIORef testCount 0+    t+    n <- readIORef testCount+    putStrLn $ "Success (" ++ show n ++ " tests)"+++instance Eq a => Eq (IO a) where+    a == b = unsafePerformIO $ do+        a <- try_ $ captureOutput a+        b <- try_ $ captureOutput b+        return $ a == b++instance Eq SomeException where+    a == b = show a == show b