packages feed

extra 0.1 → 0.2

raw patch · 18 files changed

+958/−899 lines, 18 filesdep +unixdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: unix

Dependency ranges changed: base

API changes (from Hackage documentation)

- Data.List.Extra: trim :: String -> String
- Data.List.Extra: trimBy :: (a -> Bool) -> [a] -> [a]
- Data.List.Extra: trimLeft :: String -> String
- Data.List.Extra: trimRight :: String -> String
- Extra: trim :: String -> String
- Extra: trimBy :: (a -> Bool) -> [a] -> [a]
- Extra: trimLeft :: String -> String
- Extra: trimRight :: String -> String
- Extra: withTemporaryFile :: String -> (FilePath -> IO a) -> IO a
- System.IO.Extra: withTemporaryFile :: String -> (FilePath -> IO a) -> IO a
+ Data.List.Extra: cons :: a -> [a] -> [a]
+ Data.List.Extra: drop1 :: [a] -> [a]
+ Data.List.Extra: dropAround :: (a -> Bool) -> [a] -> [a]
+ Data.List.Extra: snoc :: [a] -> a -> [a]
+ Data.List.Extra: strip :: String -> String
+ Data.List.Extra: stripEnd :: String -> String
+ Data.List.Extra: stripStart :: String -> String
+ Extra: (&&^) :: Monad m => m Bool -> m Bool -> m Bool
+ Extra: (||^) :: Monad m => m Bool -> m Bool -> m Bool
+ Extra: cons :: a -> [a] -> [a]
+ Extra: drop1 :: [a] -> [a]
+ Extra: dropAround :: (a -> Bool) -> [a] -> [a]
+ Extra: snoc :: [a] -> a -> [a]
+ Extra: strip :: String -> String
+ Extra: stripEnd :: String -> String
+ Extra: stripStart :: String -> String
+ Extra: withTempDir :: (FilePath -> IO a) -> IO a
+ Extra: withTempFile :: (FilePath -> IO a) -> IO a
+ System.IO.Extra: withTempDir :: (FilePath -> IO a) -> IO a
+ System.IO.Extra: withTempFile :: (FilePath -> IO a) -> IO a
- Data.List.Extra: uncons :: [a] -> (a, [a])
+ Data.List.Extra: uncons :: [a] -> Maybe (a, [a])
- Data.List.Extra: unsnoc :: [a] -> ([a], a)
+ Data.List.Extra: unsnoc :: [a] -> Maybe ([a], a)
- Extra: uncons :: [a] -> (a, [a])
+ Extra: uncons :: [a] -> Maybe (a, [a])
- Extra: unsnoc :: [a] -> ([a], a)
+ Extra: unsnoc :: [a] -> Maybe ([a], a)

Files

CHANGES.txt view
@@ -1,4 +1,10 @@ Changelog for Extra +0.2+    Redo the cons/uncons functions+    Add withTempDir+    Rename withTemporaryFile to withTempFile+    Change trim to strip (follow text naming convention)+    Ensure operators get exported 0.1     Initial version, still unstable
extra.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               extra-version:            0.1+version:            0.2 license:            BSD3 license-file:       LICENSE category:           Development@@ -31,6 +31,8 @@         directory,         filepath,         time+    if !os(windows)+        build-depends: unix      exposed-modules:         Extra@@ -57,6 +59,8 @@         filepath,         time,         QuickCheck+    if !os(windows)+        build-depends: unix     hs-source-dirs: src     ghc-options: -main-is Test.main     main-is:        Test.hs
src/Control/Concurrent/Extra.hs view
@@ -1,31 +1,31 @@-{-# LANGUAGE CPP #-}
-
-module Control.Concurrent.Extra(
-    module Control.Concurrent,
-    withNumCapabilities, setNumCapabilities
-    ) where
-
-import Control.Concurrent
-#if __GLASGOW_HASKELL__ >= 706
-    hiding (setNumCapabilities)
-import qualified Control.Concurrent
-#endif
-import Control.Exception
-
-
--- | On GHC 7.6 and above with the @-threaded@ flag, brackets a call to 'setNumCapabilities'.
---   On lower versions (which lack 'setNumCapabilities') this function just runs the argument action.
-withNumCapabilities :: Int -> IO a -> IO a
-withNumCapabilities new act | rtsSupportsBoundThreads = do
-    old <- getNumCapabilities
-    if old == new then act else
-        bracket_ (setNumCapabilities new) (setNumCapabilities old) act
-
-
--- | 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
+{-# LANGUAGE CPP #-}++module Control.Concurrent.Extra(+    module Control.Concurrent,+    withNumCapabilities, setNumCapabilities+    ) where++import Control.Concurrent+#if __GLASGOW_HASKELL__ >= 706+    hiding (setNumCapabilities)+import qualified Control.Concurrent+#endif+import Control.Exception+++-- | On GHC 7.6 and above with the @-threaded@ flag, brackets a call to 'setNumCapabilities'.+--   On lower versions (which lack 'setNumCapabilities') this function just runs the argument action.+withNumCapabilities :: Int -> IO a -> IO a+withNumCapabilities new act | rtsSupportsBoundThreads = do+    old <- getNumCapabilities+    if old == new then act else+        bracket_ (setNumCapabilities new) (setNumCapabilities old) act+++-- | 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
src/Control/Exception/Extra.hs view
@@ -1,71 +1,71 @@-
-module Control.Exception.Extra(
-    module Control.Exception,
-    retry, showException, ignore,
-    catch_, handle_, try_,
-    catchJust_, handleJust_, tryJust_,
-    catchBool, handleBool, tryBool
-    ) where
-
-import Control.Exception
-import Control.Monad
-
-
--- | 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
-
-
--- | Ignore any exceptions thrown by the action and continue as normal.
-ignore :: IO () -> IO ()
-ignore = void . try_
-
-
-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
-    case res of
-        Left _ -> retry (i-1) x
-        Right v -> return v
-
-
-catch_ :: IO a -> (SomeException -> IO a) -> IO a
-catch_ = Control.Exception.catch
-
-catchJust_ :: (SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO a
-catchJust_ = catchJust
-
-handle_ :: (SomeException -> IO a) -> IO a -> IO a
-handle_ = handle
-
-handleJust_ :: (SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO a
-handleJust_ = handleJust
-
-try_ :: IO a -> IO (Either SomeException a)
-try_ = try
-
-tryJust_ :: (SomeException -> Maybe b) -> IO a -> IO (Either b a)
-tryJust_ = tryJust
-
-catchBool :: Exception e => (e -> Bool) -> IO a -> (e -> IO a) -> IO a
-catchBool f a b = catchJust (bool f) a b
-
-handleBool :: Exception e => (e -> Bool) -> (e -> IO a) -> IO a -> IO a
-handleBool f a b = handleJust (bool f) a b
-
-tryBool :: Exception e => (e -> Bool) -> IO a -> IO (Either e a)
-tryBool f a = tryJust (bool f) a
-
-bool :: Exception e => (e -> Bool) -> (e -> Maybe e)
-bool f x = if f x then Just x else Nothing
++module Control.Exception.Extra(+    module Control.Exception,+    retry, showException, ignore,+    catch_, handle_, try_,+    catchJust_, handleJust_, tryJust_,+    catchBool, handleBool, tryBool+    ) where++import Control.Exception+import Control.Monad+++-- | 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+++-- | Ignore any exceptions thrown by the action and continue as normal.+ignore :: IO () -> IO ()+ignore = void . try_+++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+    case res of+        Left _ -> retry (i-1) x+        Right v -> return v+++catch_ :: IO a -> (SomeException -> IO a) -> IO a+catch_ = Control.Exception.catch++catchJust_ :: (SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO a+catchJust_ = catchJust++handle_ :: (SomeException -> IO a) -> IO a -> IO a+handle_ = handle++handleJust_ :: (SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO a+handleJust_ = handleJust++try_ :: IO a -> IO (Either SomeException a)+try_ = try++tryJust_ :: (SomeException -> Maybe b) -> IO a -> IO (Either b a)+tryJust_ = tryJust++catchBool :: Exception e => (e -> Bool) -> IO a -> (e -> IO a) -> IO a+catchBool f a b = catchJust (bool f) a b++handleBool :: Exception e => (e -> Bool) -> (e -> IO a) -> IO a -> IO a+handleBool f a b = handleJust (bool f) a b++tryBool :: Exception e => (e -> Bool) -> IO a -> IO (Either e a)+tryBool f a = tryJust (bool f) a++bool :: Exception e => (e -> Bool) -> (e -> Maybe e)+bool f x = if f x then Just x else Nothing
src/Control/Monad/Extra.hs view
@@ -1,86 +1,88 @@-
--- 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,
-    loopM, whileM,
-    ifM, notM, (||^), (&&^), orM, andM, anyM, allM,
-    findM, firstJustM
-    ) where
-
-import Control.Monad
-import Control.Applicative
-
--- General utilities
-
-whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
-whenJust mg f = maybe (pure ()) f mg
-
-unit :: m () -> m ()
-unit = id
-
--- Data.List for Monad
-
-partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
-partitionM f [] = return ([], [])
-partitionM f (x:xs) = do
-    res <- f x
-    (as,bs) <- partitionM f xs
-    return ([x | res]++as, [x | not res]++bs)
-
-
-concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
-concatMapM f = liftM concat . mapM f
-
--- Looping
-
-loopM :: Monad m => (a -> m (Either a b)) -> a -> m b
-loopM act x = do
-    res <- act x
-    case res of
-        Left x -> loopM act x
-        Right v -> return v
-
-whileM :: Monad m => m Bool -> m ()
-whileM act = do
-    b <- act
-    when b $ whileM act
-
--- Booleans
-
-ifM :: Monad m => m Bool -> m a -> m a -> m a
-ifM b t f = do b <- b; if b then t else f
-
-notM :: Functor m => m Bool -> m Bool
-notM = fmap not
-
-(||^), (&&^) :: Monad m => m Bool -> m Bool -> m Bool
-(||^) a b = ifM a (return True) b
-(&&^) a b = ifM a b (return False)
-
-anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-anyM p [] = return False
-anyM p (x:xs) = ifM (p x) (return True) (anyM p xs)
-
-allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-allM p [] = return True
-allM p (x:xs) = ifM (p x) (allM p xs) (return False)
-
-orM :: Monad m => [m Bool] -> m Bool
-orM = anyM id
-
-andM :: Monad m => [m Bool] -> m Bool
-andM = allM id
-
--- Searching
-
-findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
-findM p [] = return Nothing
-findM p (x:xs) = ifM (p x) (return $ Just x) (findM p xs)
-
-firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
-firstJustM p [] = return Nothing
-firstJustM p (x:xs) = maybe (firstJustM p xs) (return . Just) =<< p x
++-- 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,+    loopM, whileM,+    ifM, notM, (||^), (&&^), orM, andM, anyM, allM,+    findM, firstJustM+    ) where++import Control.Monad+import Control.Applicative++-- General utilities++whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()+whenJust mg f = maybe (pure ()) f mg++unit :: m () -> m ()+unit = id++-- Data.List for Monad++partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])+partitionM f [] = return ([], [])+partitionM f (x:xs) = do+    res <- f x+    (as,bs) <- partitionM f xs+    return ([x | res]++as, [x | not res]++bs)+++concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f = liftM concat . mapM f++-- Looping++loopM :: Monad m => (a -> m (Either a b)) -> a -> m b+loopM act x = do+    res <- act x+    case res of+        Left x -> loopM act x+        Right v -> return v++whileM :: Monad m => m Bool -> m ()+whileM act = do+    b <- act+    when b $ whileM act++-- Booleans++ifM :: Monad m => m Bool -> m a -> m a -> m a+ifM b t f = do b <- b; if b then t else f++notM :: Functor m => m Bool -> m Bool+notM = fmap not++-- > Just False &&^ undefined == Just False+-- > Just True &&^ Just True == Just True+(||^), (&&^) :: Monad m => m Bool -> m Bool -> m Bool+(||^) a b = ifM a (return True) b+(&&^) a b = ifM a b (return False)++anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool+anyM p [] = return False+anyM p (x:xs) = ifM (p x) (return True) (anyM p xs)++allM :: Monad m => (a -> m Bool) -> [a] -> m Bool+allM p [] = return True+allM p (x:xs) = ifM (p x) (allM p xs) (return False)++orM :: Monad m => [m Bool] -> m Bool+orM = anyM id++andM :: Monad m => [m Bool] -> m Bool+andM = allM id++-- Searching++findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)+findM p [] = return Nothing+findM p (x:xs) = ifM (p x) (return $ Just x) (findM p xs)++firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)+firstJustM p [] = return Nothing+firstJustM p (x:xs) = maybe (firstJustM p xs) (return . Just) =<< p x
src/Data/Either/Extra.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
-
-module Data.Either.Extra(
-    module Data.Either,
-    isLeft, isRight, fromLeft, fromRight, fromEither
-    ) where
-
-import Data.Either
-
-fromLeft (Left x) = x
-fromRight (Right x) = x
-
-#if __GLASGOW_HASKELL__ < 708
-isLeft Left{} = True; isLeft _ = False
-isRight Right{} = True; isRight _ = False
-#endif
-
-fromEither :: Either a a -> a
-fromEither = either id id
+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++module Data.Either.Extra(+    module Data.Either,+    isLeft, isRight, fromLeft, fromRight, fromEither+    ) where++import Data.Either++fromLeft (Left x) = x+fromRight (Right x) = x++#if __GLASGOW_HASKELL__ < 708+isLeft Left{} = True; isLeft _ = False+isRight Right{} = True; isRight _ = False+#endif++fromEither :: Either a a -> a+fromEither = either id id
src/Data/IORef/Extra.hs view
@@ -1,48 +1,48 @@-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
-
-module Data.IORef.Extra(
-    module Data.IORef,
-    modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef'
-    ) where
-
-import Data.IORef
-import Control.Exception
-
-
--- Evaluates before writing to the IORef
-writeIORef' :: IORef a -> a -> IO ()
-writeIORef' ref x = do
-    evaluate x
-    writeIORef ref x
-
-atomicWriteIORef' :: IORef a -> a -> IO ()
-atomicWriteIORef' ref x = do
-    evaluate x
-    atomicWriteIORef ref x
-
-
-#if __GLASGOW_HASKELL__ < 706
-
----------------------------------------------------------------------
--- Data.IORef
-
--- Two 's because GHC 7.6 has a strict modifyIORef
-modifyIORef' :: IORef a -> (a -> a) -> IO ()
-modifyIORef' ref f = do
-    x <- readIORef ref
-    writeIORef' ref $ f x
-
-atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
-atomicModifyIORef' ref f = do
-    b <- atomicModifyIORef ref
-            (\x -> let (a, b) = f x
-                    in (a, a `seq` b))
-    b `seq` return b
-
-atomicWriteIORef :: IORef a -> a -> IO ()
-atomicWriteIORef ref a = do
-    x <- atomicModifyIORef ref (\_ -> (a, ()))
-    x `seq` return ()
-
-#endif
+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++module Data.IORef.Extra(+    module Data.IORef,+    modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef'+    ) where++import Data.IORef+import Control.Exception+++-- Evaluates before writing to the IORef+writeIORef' :: IORef a -> a -> IO ()+writeIORef' ref x = do+    evaluate x+    writeIORef ref x++atomicWriteIORef' :: IORef a -> a -> IO ()+atomicWriteIORef' ref x = do+    evaluate x+    atomicWriteIORef ref x+++#if __GLASGOW_HASKELL__ < 706++---------------------------------------------------------------------+-- Data.IORef++-- Two 's because GHC 7.6 has a strict modifyIORef+modifyIORef' :: IORef a -> (a -> a) -> IO ()+modifyIORef' ref f = do+    x <- readIORef ref+    writeIORef' ref $ f x++atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORef' ref f = do+    b <- atomicModifyIORef ref+            (\x -> let (a, b) = f x+                    in (a, a `seq` b))+    b `seq` return b++atomicWriteIORef :: IORef a -> a -> IO ()+atomicWriteIORef ref a = do+    x <- atomicModifyIORef ref (\_ -> (a, ()))+    x `seq` return ()++#endif
src/Data/List/Extra.hs view
@@ -1,252 +1,257 @@-{-# LANGUAGE CPP, TupleSections #-}
-{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
-
--- | 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.
-module Data.List.Extra(
-    module Data.List,
-    lower, upper, trim, trimLeft, trimRight, trimBy, word1,
-    list, uncons, unsnoc,
-    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
-    ) where
-
-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'
-    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)
-
-
-for :: [a] -> (a -> b) -> [b]
-for = flip map
-
-disjoint :: Eq a => [a] -> [a] -> Bool
-disjoint xs = null . intersect xs
-
-distinct :: Eq a => [a] -> Bool
-distinct xs = length xs == length (nub xs)
-
-
-list :: b -> (a -> [a] -> b) -> [a] -> b
-list nil cons [] = nil
-list nil cons (x:xs) = cons x xs
-
-uncons :: [a] -> (a,[a])
-uncons [] = error "Uncons on an empty list"
-uncons (x:xs) = (x,xs)
-
-unsnoc :: [a] -> ([a],a)
-unsnoc [] = error "Unsnoc on empty list"
-unsnoc [x] = ([], x)
-unsnoc (x:xs) = (x:a, b)
-    where (a,b) = unsnoc xs
-
-
-takeEnd :: Int -> [a] -> [a]
-takeEnd i = reverse . take i . reverse
-
-dropEnd :: Int -> [a] -> [a]
-dropEnd i = reverse . drop i . reverse
-
-concatUnzip :: [([a], [b])] -> ([a], [b])
-concatUnzip = (concat *** concat) . unzip
-
-
-takeWhileEnd :: (a -> Bool) -> [a] -> [a]
-takeWhileEnd f = reverse . takeWhile f . reverse
-
-
-trim, trimLeft, trimRight :: String -> String
-trimLeft = dropWhile isSpace
-trimRight = dropWhileEnd isSpace
-trim = trimRight . trimLeft
-
-lower :: String -> String
-lower = map toLower
-
-upper :: String -> String
-upper = map toUpper
-
-trimBy :: (a -> Bool) -> [a] -> [a]
-trimBy f = dropWhileEnd f . dropWhile f
-
-
-word1 :: String -> (String, String)
-word1 x = second (dropWhile isSpace) $ break isSpace $ dropWhile isSpace x
-
-
-sortOn :: Ord b => (a -> b) -> [a] -> [a]
-sortOn f = sortBy (comparing f)
-
-groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
-groupOn f = groupBy ((==) `on` f)
-
-nubOn :: Eq b => (a -> b) -> [a] -> [a]
-nubOn f = nubBy ((==) `on` f)
-
-groupSort :: Ord k => [(k, v)] -> [(k, [v])]
-groupSort = groupSortOn id
-
-groupSortOn :: Ord a => (k -> a) -> [(k, v)] -> [(k, [v])]
-groupSortOn f = map (\x -> (fst $ head x, map snd x)) . groupOn (f . fst) . sortOn (f . fst)
-
-
-merge :: Ord a => [a] -> [a] -> [a]
-merge = mergeBy compare
-
-
-mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
-mergeBy f xs [] = xs
-mergeBy f [] ys = ys
-mergeBy f (x:xs) (y:ys)
-    | f x y /= GT = x : mergeBy f xs (y:ys)
-    | otherwise = y : mergeBy f (x:xs) ys
-
-replace :: String -> String -> String -> String
-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 [] = []
-
-
-breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
-breakEnd f xs = case break f $ reverse xs of
-    (_, []) -> (xs, [])
-    (as, b:bs) -> (reverse bs, b:reverse as)
-
-spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
-spanEnd f xs = breakEnd (not . f) xs
-
-
-wordsBy :: (a -> Bool) -> [a] -> [[a]]
-wordsBy f s = case dropWhile f s of
-    [] -> []
-    x:xs -> (x:w) : wordsBy f (drop1 z)
-        where (w,z) = break f xs
-
-linesBy :: (a -> Bool) -> [a] -> [[a]]
-linesBy f [] = []
-linesBy f s = cons $ case break f s of
-    (l, s) -> (l,) $ case s of
-        [] -> []
-        _:s -> linesBy f s
-  where
-    cons ~(h, t) = h : t -- to fix a space leak, see the GHC defn of lines
-
-firstJust :: (a -> Maybe b) -> [a] -> Maybe b
-firstJust p [] = Nothing
-firstJust p (x:xs) = maybe (firstJust p xs) Just (p x)
-
-drop1 :: [a] -> [a]
-drop1 [] = []
-drop1 (x:xs) = xs
-
-
--- | Find the first instance of @needle@ in @haystack@.
--- The first element of the returned tuple
--- is the prefix of @haystack@ before @needle@ is matched.  The second
--- is the remainder of @haystack@, starting with the match.
---
--- Examples:
---
--- > breakOn "::" "a::b::c" == ("a", "::b::c")
--- > breakOn "/" "foobar"   == ("foobar", "")
---
--- Laws:
---
--- > \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
-breakOn :: Eq a => [a] -> [a] -> ([a], [a])
-breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
-breakOn needle [] = ([], [])
-breakOn needle (x:xs) = first (x:) $ breakOn needle xs
-
--- | Similar to 'breakOn', but searches from the end of the
--- string.
---
--- The first element of the returned tuple is the prefix of @haystack@
--- up to and including the last match of @needle@.  The second is the
--- remainder of @haystack@, following the match.
---
--- > breakOnEnd "::" "a::b::c" == ("a::b::", "c")
-breakOnEnd :: Eq a => [a] -> [a] -> ([a], [a])
-breakOnEnd needle haystack = (reverse *** reverse) $ swap $ breakOn (reverse needle) (reverse haystack)
-
-
--- | Break a list into pieces separated by the first
--- list argument, consuming the delimiter. An empty delimiter is
--- invalid, and will cause an error to be raised.
---
--- Examples:
---
--- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
--- > splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]
--- > splitOn "x"    "x"                == ["",""]
--- > splitOn "x"    ""                 == [""]
---
--- and
---
--- > \s x -> s /= "" ==> intercalate s (splitOn s x) == x
--- > \c x -> splitOn [c] x                           == split (==c) x
-splitOn :: Eq a => [a] -> [a] -> [[a]]
-splitOn [] _ = error "splitOn, needle may not be empty"
-splitOn _ [] = [[]]
-splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
-    where (a,b) = breakOn needle haystack
-
-
--- | Splits a list into components delimited by separators,
--- where the predicate returns True for a separator element.  The
--- resulting components do not contain the separators.  Two adjacent
--- separators result in an empty component in the output.  eg.
---
--- > split (=='a') "aabbaca" == ["","","bb","c",""]
--- > split (=='a') ""        == [""]
-split :: (a -> Bool) -> [a] -> [[a]]
-split f [] = [[]]
-split f (x:xs) | f x = [] : split f xs
-split f (x:xs) | y:ys <- split f xs = (x:y) : ys
-
-
-#if __GLASGOW_HASKELL__ < 704
-dropWhileEnd :: (a -> Bool) -> [a] -> [a]
-dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
-#endif
-
--- | Return the prefix of the second string if its suffix
--- matches the entire first string.
---
--- Examples:
---
--- > stripSuffix "bar" "foobar" == Just "foo"
--- > stripSuffix ""    "baz"    == Just "baz"
--- > stripSuffix "foo" "quux"   == Nothing
-stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
-stripSuffix a b = fmap reverse $ stripPrefix (reverse a) (reverse b)
-
-
-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
-
+{-# LANGUAGE CPP, TupleSections #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++-- | 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.+module Data.List.Extra(+    module Data.List,+    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+    ) where++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'+    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)+++for :: [a] -> (a -> b) -> [b]+for = flip map++disjoint :: Eq a => [a] -> [a] -> Bool+disjoint xs = null . intersect xs++distinct :: Eq a => [a] -> Bool+distinct xs = length xs == length (nub xs)+++list :: b -> (a -> [a] -> b) -> [a] -> b+list nil cons [] = nil+list nil cons (x:xs) = cons x xs++uncons :: [a] -> Maybe (a, [a])+uncons [] = Nothing+uncons (x:xs) = Just (x,xs)++unsnoc :: [a] -> Maybe ([a], a)+unsnoc [] = Nothing+unsnoc [x] = Just ([], x)+unsnoc (x:xs) = Just (x:a, b)+    where Just (a,b) = unsnoc xs++cons :: a -> [a] -> [a]+cons = (:)++snoc :: [a] -> a -> [a]+snoc xs x = xs ++ [x]++takeEnd :: Int -> [a] -> [a]+takeEnd i = reverse . take i . reverse++dropEnd :: Int -> [a] -> [a]+dropEnd i = reverse . drop i . reverse++concatUnzip :: [([a], [b])] -> ([a], [b])+concatUnzip = (concat *** concat) . unzip+++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++lower :: String -> String+lower = map toLower++upper :: String -> String+upper = map toUpper++dropAround :: (a -> Bool) -> [a] -> [a]+dropAround f = dropWhileEnd f . dropWhile f+++word1 :: String -> (String, String)+word1 x = second (dropWhile isSpace) $ break isSpace $ dropWhile isSpace x+++sortOn :: Ord b => (a -> b) -> [a] -> [a]+sortOn f = sortBy (comparing f)++groupOn :: Eq b => (a -> b) -> [a] -> [[a]]+groupOn f = groupBy ((==) `on` f)++nubOn :: Eq b => (a -> b) -> [a] -> [a]+nubOn f = nubBy ((==) `on` f)++groupSort :: Ord k => [(k, v)] -> [(k, [v])]+groupSort = groupSortOn id++groupSortOn :: Ord a => (k -> a) -> [(k, v)] -> [(k, [v])]+groupSortOn f = map (\x -> (fst $ head x, map snd x)) . groupOn (f . fst) . sortOn (f . fst)+++merge :: Ord a => [a] -> [a] -> [a]+merge = mergeBy compare+++mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]+mergeBy f xs [] = xs+mergeBy f [] ys = ys+mergeBy f (x:xs) (y:ys)+    | f x y /= GT = x : mergeBy f xs (y:ys)+    | otherwise = y : mergeBy f (x:xs) ys++replace :: String -> String -> String -> String+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 [] = []+++breakEnd :: (a -> Bool) -> [a] -> ([a], [a])+breakEnd f xs = case break f $ reverse xs of+    (_, []) -> (xs, [])+    (as, b:bs) -> (reverse bs, b:reverse as)++spanEnd :: (a -> Bool) -> [a] -> ([a], [a])+spanEnd f xs = breakEnd (not . f) xs+++wordsBy :: (a -> Bool) -> [a] -> [[a]]+wordsBy f s = case dropWhile f s of+    [] -> []+    x:xs -> (x:w) : wordsBy f (drop1 z)+        where (w,z) = break f xs++linesBy :: (a -> Bool) -> [a] -> [[a]]+linesBy f [] = []+linesBy f s = cons $ case break f s of+    (l, s) -> (l,) $ case s of+        [] -> []+        _:s -> linesBy f s+  where+    cons ~(h, t) = h : t -- to fix a space leak, see the GHC defn of lines++firstJust :: (a -> Maybe b) -> [a] -> Maybe b+firstJust p [] = Nothing+firstJust p (x:xs) = maybe (firstJust p xs) Just (p x)++drop1 :: [a] -> [a]+drop1 [] = []+drop1 (x:xs) = xs+++-- | Find the first instance of @needle@ in @haystack@.+-- The first element of the returned tuple+-- is the prefix of @haystack@ before @needle@ is matched.  The second+-- is the remainder of @haystack@, starting with the match.+--+-- Examples:+--+-- > breakOn "::" "a::b::c" == ("a", "::b::c")+-- > breakOn "/" "foobar"   == ("foobar", "")+--+-- Laws:+--+-- > \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack+breakOn :: Eq a => [a] -> [a] -> ([a], [a])+breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)+breakOn needle [] = ([], [])+breakOn needle (x:xs) = first (x:) $ breakOn needle xs++-- | Similar to 'breakOn', but searches from the end of the+-- string.+--+-- The first element of the returned tuple is the prefix of @haystack@+-- up to and including the last match of @needle@.  The second is the+-- remainder of @haystack@, following the match.+--+-- > breakOnEnd "::" "a::b::c" == ("a::b::", "c")+breakOnEnd :: Eq a => [a] -> [a] -> ([a], [a])+breakOnEnd needle haystack = (reverse *** reverse) $ swap $ breakOn (reverse needle) (reverse haystack)+++-- | Break a list into pieces separated by the first+-- list argument, consuming the delimiter. An empty delimiter is+-- invalid, and will cause an error to be raised.+--+-- Examples:+--+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]+-- > splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]+-- > splitOn "x"    "x"                == ["",""]+-- > splitOn "x"    ""                 == [""]+--+-- and+--+-- > \s x -> s /= "" ==> intercalate s (splitOn s x) == x+-- > \c x -> splitOn [c] x                           == split (==c) x+splitOn :: Eq a => [a] -> [a] -> [[a]]+splitOn [] _ = error "splitOn, needle may not be empty"+splitOn _ [] = [[]]+splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b+    where (a,b) = breakOn needle haystack+++-- | Splits a list into components delimited by separators,+-- where the predicate returns True for a separator element.  The+-- resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.  eg.+--+-- > split (=='a') "aabbaca" == ["","","bb","c",""]+-- > split (=='a') ""        == [""]+split :: (a -> Bool) -> [a] -> [[a]]+split f [] = [[]]+split f (x:xs) | f x = [] : split f xs+split f (x:xs) | y:ys <- split f xs = (x:y) : ys+++#if __GLASGOW_HASKELL__ < 704+dropWhileEnd :: (a -> Bool) -> [a] -> [a]+dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []+#endif++-- | Return the prefix of the second string if its suffix+-- matches the entire first string.+--+-- Examples:+--+-- > stripSuffix "bar" "foobar" == Just "foo"+-- > stripSuffix ""    "baz"    == Just "baz"+-- > stripSuffix "foo" "quux"   == Nothing+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix a b = fmap reverse $ stripPrefix (reverse a) (reverse b)+++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+
src/Data/Tuple/Extra.hs view
@@ -1,27 +1,27 @@-
-module Data.Tuple.Extra(
-    module Data.Tuple,
-    dupe, fst3, snd3, thd3, concat2, concat3
-    ) where
-
-import Data.Tuple
-
-fst3 :: (a,b,c) -> a
-fst3 (a,b,c) = a
-
-snd3 :: (a,b,c) -> b
-snd3 (a,b,c) = b
-
-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
-
-concat2 :: [([a],[b])] -> ([a],[b])
-concat2 xs = (concat a, concat b)
-    where (a,b) = unzip xs
-
-dupe :: a -> (a,a)
-dupe x = (x,x)
++module Data.Tuple.Extra(+    module Data.Tuple,+    dupe, fst3, snd3, thd3, concat2, concat3+    ) where++import Data.Tuple++fst3 :: (a,b,c) -> a+fst3 (a,b,c) = a++snd3 :: (a,b,c) -> b+snd3 (a,b,c) = b++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++concat2 :: [([a],[b])] -> ([a],[b])+concat2 xs = (concat a, concat b)+    where (a,b) = unzip xs++dupe :: a -> (a,a)+dupe x = (x,x)
src/Extra.hs view
@@ -1,42 +1,42 @@-module Extra(
-    -- * Control.Concurrent.Extra
-    withNumCapabilities, setNumCapabilities,
-    -- * Control.Exception.Extra
-    retry, showException, 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,
-    -- * Data.Either.Extra
-    isLeft, isRight, fromLeft, fromRight, fromEither,
-    -- * Data.IORef.Extra
-    modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef',
-    -- * Data.List.Extra
-    lower, upper, trim, trimLeft, trimRight, trimBy, word1, list, uncons, unsnoc, 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,
-    -- * Data.Tuple.Extra
-    dupe, fst3, snd3, thd3, concat2, concat3,
-    -- * Numeric.Extra
-    showDP, intToDouble, intToFloat, floatToDouble, doubleToFloat,
-    -- * System.Directory.Extra
-    withCurrentDirectory, getDirectoryContentsRecursive,
-    -- * System.Environment.Extra
-    getExecutablePath, lookupEnv,
-    -- * System.Info.Extra
-    isWindows, getProcessorCount,
-    -- * System.IO.Extra
-    readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTemporaryFile, captureOutput, withBuffering,
-    -- * System.Time.Extra
-    sleep, subtractTime, showTime, offsetTime, offsetTimeIncrease, duration,
-    ) where
-
-import Control.Concurrent.Extra
-import Control.Exception.Extra
-import Control.Monad.Extra
-import Data.Either.Extra
-import Data.IORef.Extra
-import Data.List.Extra
-import Data.Tuple.Extra
-import Numeric.Extra
-import System.Directory.Extra
-import System.Environment.Extra
-import System.Info.Extra
-import System.IO.Extra
-import System.Time.Extra
+module Extra(+    -- * Control.Concurrent.Extra+    withNumCapabilities, setNumCapabilities,+    -- * Control.Exception.Extra+    retry, showException, 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,+    -- * Data.Either.Extra+    isLeft, isRight, fromLeft, fromRight, fromEither,+    -- * 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,+    -- * Data.Tuple.Extra+    dupe, fst3, snd3, thd3, concat2, concat3,+    -- * Numeric.Extra+    showDP, intToDouble, intToFloat, floatToDouble, doubleToFloat,+    -- * System.Directory.Extra+    withCurrentDirectory, getDirectoryContentsRecursive,+    -- * System.Environment.Extra+    getExecutablePath, lookupEnv,+    -- * System.Info.Extra+    isWindows, getProcessorCount,+    -- * System.IO.Extra+    readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, captureOutput, withBuffering,+    -- * System.Time.Extra+    sleep, subtractTime, showTime, offsetTime, offsetTimeIncrease, duration,+    ) where++import Control.Concurrent.Extra+import Control.Exception.Extra+import Control.Monad.Extra+import Data.Either.Extra+import Data.IORef.Extra+import Data.List.Extra+import Data.Tuple.Extra+import Numeric.Extra+import System.Directory.Extra+import System.Environment.Extra+import System.Info.Extra+import System.IO.Extra+import System.Time.Extra
src/Numeric/Extra.hs view
@@ -1,34 +1,34 @@-
-module Numeric.Extra(
-    module Numeric,
-    showDP,
-    intToDouble, intToFloat, floatToDouble, doubleToFloat
-    ) where
-
-import Numeric
-import Control.Arrow
-
----------------------------------------------------------------------
--- Data.String
-
-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 ""
-
-
----------------------------------------------------------------------
--- Numeric
-
-intToDouble :: Int -> Double
-intToDouble = fromInteger . toInteger
-
-intToFloat :: Int -> Float
-intToFloat = fromInteger . toInteger
-
-floatToDouble :: Float -> Double
-floatToDouble = fromRational . toRational
-
-doubleToFloat :: Double -> Float
-doubleToFloat = fromRational . toRational
-
-
++module Numeric.Extra(+    module Numeric,+    showDP,+    intToDouble, intToFloat, floatToDouble, doubleToFloat+    ) where++import Numeric+import Control.Arrow++---------------------------------------------------------------------+-- Data.String++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 ""+++---------------------------------------------------------------------+-- Numeric++intToDouble :: Int -> Double+intToDouble = fromInteger . toInteger++intToFloat :: Int -> Float+intToFloat = fromInteger . toInteger++floatToDouble :: Float -> Double+floatToDouble = fromRational . toRational++doubleToFloat :: Double -> Float+doubleToFloat = fromRational . toRational++
src/System/Directory/Extra.hs view
@@ -1,26 +1,26 @@-
-module System.Directory.Extra(
-    module System.Directory,
-    withCurrentDirectory, getDirectoryContentsRecursive
-    ) where
-
-import System.Directory
-import Control.Monad.Extra
-import System.FilePath
-import Data.List
-import Control.Exception
-
-
-withCurrentDirectory :: FilePath -> IO a -> IO a
-withCurrentDirectory dir act =
-    bracket getCurrentDirectory setCurrentDirectory $ const $ do
-        setCurrentDirectory dir; act
-
-getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
-getDirectoryContentsRecursive dir = do
-    xs <- getDirectoryContents dir
-    (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ isBadDir x]
-    rest <- concatMapM getDirectoryContentsRecursive $ sort dirs
-    return $ sort files ++ rest
-    where
-        isBadDir x = "." `isPrefixOf` x -- FIXME, need a version that can also exclude _ dirs
++module System.Directory.Extra(+    module System.Directory,+    withCurrentDirectory, getDirectoryContentsRecursive+    ) where++import System.Directory+import Control.Monad.Extra+import System.FilePath+import Data.List+import Control.Exception+++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory dir act =+    bracket getCurrentDirectory setCurrentDirectory $ const $ do+        setCurrentDirectory dir; act++getDirectoryContentsRecursive :: FilePath -> IO [FilePath]+getDirectoryContentsRecursive dir = do+    xs <- getDirectoryContents dir+    (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ isBadDir x]+    rest <- concatMapM getDirectoryContentsRecursive $ sort dirs+    return $ sort files ++ rest+    where+        isBadDir x = "." `isPrefixOf` x -- FIXME, need a version that can also exclude _ dirs
src/System/Environment/Extra.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
-
-module System.Environment.Extra(
-    module System.Environment,
-    getExecutablePath, lookupEnv
-    ) where
-
-import System.Environment
-
-#if __GLASGOW_HASKELL__ < 706
-import Control.Exception.Extra
-import System.IO.Error
-
-getExecutablePath :: IO FilePath
-getExecutablePath = getProgName
-
-lookupEnv :: String -> IO (Maybe String)
-lookupEnv x = catchBool isDoesNotExistError (fmap Just $ getEnv x) (const $ return Nothing)
-#endif
+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++module System.Environment.Extra(+    module System.Environment,+    getExecutablePath, lookupEnv+    ) where++import System.Environment++#if __GLASGOW_HASKELL__ < 706+import Control.Exception.Extra+import System.IO.Error++getExecutablePath :: IO FilePath+getExecutablePath = getProgName++lookupEnv :: String -> IO (Maybe String)+lookupEnv x = catchBool isDoesNotExistError (fmap Just $ getEnv x) (const $ return Nothing)+#endif
src/System/IO/Extra.hs view
@@ -1,102 +1,142 @@-{-# LANGUAGE ScopedTypeVariables #-}
-
-module System.IO.Extra(
-    module System.IO,
-    readFileEncoding, readFileUTF8, readFileBinary,
-    readFile', readFileEncoding', readFileUTF8', readFileBinary',
-    writeFileEncoding, writeFileUTF8, writeFileBinary,
-    withTemporaryFile,
-    captureOutput,
-    withBuffering,
-    ) where
-
-import System.IO
-import System.Directory
-import Control.Exception as E
-import GHC.IO.Handle(hDuplicate,hDuplicateTo)
-
-
--- File reading
-
-readFileEncoding :: TextEncoding -> FilePath -> IO String
-readFileEncoding enc file = do
-    h <- openFile file ReadMode
-    hSetEncoding h enc
-    hGetContents h
-
-readFileUTF8 :: FilePath -> IO String
-readFileUTF8 = readFileEncoding utf8
-
-readFileBinary :: FilePath -> IO String
-readFileBinary file = do
-    h <- openBinaryFile file ReadMode
-    hGetContents h
-
--- Strict file reading
-
-readFile' :: FilePath -> IO String
-readFile' file = withFile file ReadMode $ \h -> do
-    s <- hGetContents h
-    evaluate $ length s
-    return s
-
-readFileEncoding' :: TextEncoding -> FilePath -> IO String
-readFileEncoding' e file = withFile file ReadMode $ \h -> do
-    hSetEncoding h e
-    s <- hGetContents h
-    evaluate $ length s
-    return s
-
-readFileUTF8' :: FilePath -> IO String
-readFileUTF8' = readFileEncoding' utf8
-
-readFileBinary' :: FilePath -> IO String
-readFileBinary' file = withBinaryFile file ReadMode $ \h -> do
-    s <- hGetContents h
-    evaluate $ length s
-    return s
-
--- File writing
-
-writeFileEncoding :: TextEncoding -> FilePath -> String -> IO ()
-writeFileEncoding enc file x = withFile x WriteMode $ \h -> do
-    hSetEncoding h enc
-    hPutStr h x
-
-writeFileUTF8 :: FilePath -> String -> IO ()
-writeFileUTF8 = writeFileEncoding utf8
-
-writeFileBinary :: FilePath -> String -> IO ()
-writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x
-
--- Other
-
-withTemporaryFile :: String -> (FilePath -> IO a) -> IO a
-withTemporaryFile pat act = do
-    tmp <- getTemporaryDirectory
-    bracket (openTempFile tmp pat) (removeFile . fst) $
-        \(file,h) -> hClose h >> act file
-
-
-captureOutput :: IO () -> IO String
-captureOutput act = withTemporaryFile "extra-capture.txt" $ \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
-
-
-withBuffering :: Handle -> BufferMode -> IO a -> IO a
-withBuffering h m act = bracket (hGetBuffering h) (hSetBuffering h) $ const $ do
-    hSetBuffering h m
-    act
+{-# LANGUAGE ScopedTypeVariables, CPP #-}++-- | More advanced temporary file manipulation functions can be found in the @exceptions@ package.+module System.IO.Extra(+    module System.IO,+    readFileEncoding, readFileUTF8, readFileBinary,+    readFile', readFileEncoding', readFileUTF8', readFileBinary',+    writeFileEncoding, writeFileUTF8, writeFileBinary,+    withTempFile, withTempDir,+    captureOutput,+    withBuffering,+    ) where++import System.IO+import Control.Exception.Extra as E+import GHC.IO.Handle(hDuplicate,hDuplicateTo)+import System.Directory+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+readFileEncoding enc file = do+    h <- openFile file ReadMode+    hSetEncoding h enc+    hGetContents h++readFileUTF8 :: FilePath -> IO String+readFileUTF8 = readFileEncoding utf8++readFileBinary :: FilePath -> IO String+readFileBinary file = do+    h <- openBinaryFile file ReadMode+    hGetContents h++-- Strict file reading++readFile' :: FilePath -> IO String+readFile' file = withFile file ReadMode $ \h -> do+    s <- hGetContents h+    evaluate $ length s+    return s++readFileEncoding' :: TextEncoding -> FilePath -> IO String+readFileEncoding' e file = withFile file ReadMode $ \h -> do+    hSetEncoding h e+    s <- hGetContents h+    evaluate $ length s+    return s++readFileUTF8' :: FilePath -> IO String+readFileUTF8' = readFileEncoding' utf8++readFileBinary' :: FilePath -> IO String+readFileBinary' file = withBinaryFile file ReadMode $ \h -> do+    s <- hGetContents h+    evaluate $ length s+    return s++-- File writing++writeFileEncoding :: TextEncoding -> FilePath -> String -> IO ()+writeFileEncoding enc file x = withFile x WriteMode $ \h -> do+    hSetEncoding h enc+    hPutStr h x++writeFileUTF8 :: FilePath -> String -> IO ()+writeFileUTF8 = writeFileEncoding utf8++writeFileBinary :: FilePath -> String -> IO ()+writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x++-- Other++captureOutput :: IO () -> IO String+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+++withBuffering :: Handle -> BufferMode -> IO a -> IO a+withBuffering h m act = bracket (hGetBuffering h) (hSetBuffering h) $ const $ do+    hSetBuffering h m+    act+++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)+++withTempDir :: (FilePath -> IO a) -> IO a+withTempDir act = do+    tmpdir <- getTemporaryDirectory+    bracket+        (createTempDirectory tmpdir "extra")+        (ignore . removeDirectoryRecursive)+        act+++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+    where+        findTempName x = do+            let dirpath = dir </> prefix ++ show x+            catchBool isAlreadyExistsError+                (mkPrivateDir dirpath >> return dirpath) $+                \e -> findTempName (x+1)++mkPrivateDir :: String -> IO ()+#ifdef mingw32_HOST_OS+mkPrivateDir s = createDirectory s+#else+mkPrivateDir s = System.Posix.createDirectory s 0o700+#endif
src/System/Info/Extra.hs view
@@ -1,47 +1,47 @@-{-# LANGUAGE CPP #-}
-
-module System.Info.Extra(
-    module System.Info,
-    isWindows, getProcessorCount
-    ) 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
-
-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]
-
+{-# LANGUAGE CPP #-}++module System.Info.Extra(+    module System.Info,+    isWindows, getProcessorCount+    ) 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++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]+
src/System/Time/Extra.hs view
@@ -1,56 +1,56 @@-
-module System.Time.Extra(
-    sleep,
-    subtractTime,
-    showTime,
-    offsetTime, offsetTimeIncrease, duration
-    ) where
-
-import Control.Concurrent
-import Data.Time.Clock
-import Numeric.Extra
-import Data.IORef
-
-
-sleep :: Double -> IO ()
-sleep x = threadDelay $ ceiling $ x * 1000000
-
-
-subtractTime :: UTCTime -> UTCTime -> Double
-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"
-    where
-        f x m s = show ms ++ m ++ ['0' | ss < 10] ++ show ss ++ m
-            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 = do
-    start <- getCurrentTime
-    return $ do
-        end <- getCurrentTime
-        return $ end `subtractTime` start
-
--- | Like offsetTime, but results will never decrease (though they may stay the same)
-offsetTimeIncrease :: IO (IO Double)
-offsetTimeIncrease = do
-    t <- offsetTime
-    ref <- newIORef 0
-    return $ do
-        t <- t
-        atomicModifyIORef ref $ \o -> let m = max t o in m `seq` (m, m)
-
-
-duration :: IO a -> IO (Double, a)
-duration act = do
-    time <- offsetTime
-    res <- act
-    time <- time
-    return (time, res)
++module System.Time.Extra(+    sleep,+    subtractTime,+    showTime,+    offsetTime, offsetTimeIncrease, duration+    ) where++import Control.Concurrent+import Data.Time.Clock+import Numeric.Extra+import Data.IORef+++sleep :: Double -> IO ()+sleep x = threadDelay $ ceiling $ x * 1000000+++subtractTime :: UTCTime -> UTCTime -> Double+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"+    where+        f x m s = show ms ++ m ++ ['0' | ss < 10] ++ show ss ++ m+            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 = do+    start <- getCurrentTime+    return $ do+        end <- getCurrentTime+        return $ end `subtractTime` start++-- | Like offsetTime, but results will never decrease (though they may stay the same)+offsetTimeIncrease :: IO (IO Double)+offsetTimeIncrease = do+    t <- offsetTime+    ref <- newIORef 0+    return $ do+        t <- t+        atomicModifyIORef ref $ \o -> let m = max t o in m `seq` (m, m)+++duration :: IO a -> IO (Double, a)+duration act = do+    time <- offsetTime+    res <- act+    time <- time+    return (time, res)
src/Test.hs view
@@ -1,25 +1,27 @@-{-# 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 "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"
+{-# 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"
src/TestUtil.hs view
@@ -1,11 +1,11 @@-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"
+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"