Initial version, not ready for anything yet

.ghci

@@ -0,0 +1,4 @@
+:set -fwarn-unused-binds -fwarn-unused-imports
+:load Extra
+:def docs_ const $ return $ unlines [":!cabal haddock"]
+:def docs const $ return $ unlines [":docs_",":!start dist\\doc\\html\\bake\\Development-Bake.html"]

.gitignore

@@ -0,0 +1 @@
+/dist/

.travis.yml

@@ -0,0 +1,2 @@
+language: haskell
+script: wget https://raw.github.com/ndmitchell/neil/master/travis.sh -O - --no-check-certificate --quiet | sh

CHANGES.txt

@@ -0,0 +1,3 @@
+Changelog for Extra
+
+    Initial version

Control/Concurrent/Extra.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE CPP #-}
+
+module Control.Concurrent.Extra(module Control.Concurrent.Extra) where
+
+import Control.Concurrent
+import Control.Exception
+
+
+withCapabilities :: Int -> IO a -> IO a
+#if __GLASGOW_HASKELL__ >= 706
+withCapabilities new act | rtsSupportsBoundThreads = do
+    old <- getNumCapabilities
+    if old == new then act else
+        bracket_ (setNumCapabilities new) (setNumCapabilities old) act
+#endif
+withCapabilities new act = act
+

Control/Exception/Extra.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Control.Exception.Extra(module Control.Exception.Extra) where
+
+import Control.Exception as E
+
+showException :: SomeException -> IO String
+showException = f . show
+    where
+        f xs = do
+            r <- try $ evaluate xs
+            case r of
+                Left (e :: SomeException) -> return "<NestedException>"
+                Right [] -> return []
+                Right (x:xs) -> fmap (x :) $ f xs
+
+ignoreExceptions :: IO () -> IO ()
+ignoreExceptions act = E.catch act (\(x::SomeException) -> return ())
+
+
+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 (_ :: SomeException) -> retry (i-1) x
+        Right v -> return v
+
+
+try_ :: IO a -> IO (Either SomeException a)
+try_ = try
+
+handle_ :: (SomeException -> IO a) -> IO a -> IO a
+handle_ = handle

Control/Monad/Extra.hs

@@ -0,0 +1,72 @@
+
+module Control.Monad.Extra(module Control.Monad.Extra) where
+
+import Control.Monad
+import Data.Maybe
+
+
+whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenJust mg f = maybe (return ()) f mg
+
+unit :: m () -> m ()
+unit = id
+
+
+
+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
+
+concatM :: Monad m => [m [a]] -> m [a]
+concatM = liftM concat . sequence
+
+concatZipWithM :: Monad m => (a -> b -> m [c]) -> [a] -> [b] -> m [c]
+concatZipWithM f xs ys = liftM concat $ zipWithM f xs ys
+
+listM' :: Monad m => [a] -> m [a]
+listM' x = length x `seq` return x
+
+
+---------------------------------------------------------------------
+-- Control.Monad
+
+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
+
+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
+mapMaybeM f xs = liftM catMaybes $ mapM f xs
+
+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 = do a <- a; if a then return True else b
+(&&^) a b = do a <- a; if a then b else return False
+
+
+findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
+findM p [] = return Nothing
+findM p (x:xs) = do
+    v <- p x
+    if v then return $ Just x else findM p xs
+
+findJustM = undefined

Data/Either/Extra.hs

@@ -0,0 +1,15 @@
+
+module Data.Either.Extra(module Data.Either, module Data.Either.Extra) where
+
+import Data.Either
+
+fromLeft (Left x) = x
+fromRight (Right x) = x
+
+isLeft Left{} = True; isLeft _ = False
+isRight Right{} = True; isRight _ = False
+
+
+loop :: (a -> Either a b) -> a -> b
+loop act x = undefined
+

Data/IORef/Extra.hs

@@ -0,0 +1,16 @@
+
+module Data.IORef.Extra(module Data.IORef, module Data.IORef.Extra) where
+
+import Data.IORef
+
+---------------------------------------------------------------------
+-- 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
+
+writeIORef'' :: IORef a -> a -> IO ()
+writeIORef'' ref x = x `seq` writeIORef ref x

Data/List/Extra.hs

@@ -0,0 +1,198 @@
+
+-- | This module extends "Data.List" with extra functions of a similar nature.
+--   The package also exports the existing "Data.List" functions.
+module Data.List.Extra(
+    -- * Existing functions
+    module Data.List,
+    -- * Extra functions
+    module Data.List.Extra
+    ) where
+
+import Data.List
+import Data.Function
+import Data.Ord
+import Control.Arrow
+import Data.Char
+import Data.Maybe
+
+
+chop :: ([a] -> (b, [a])) -> [a] -> [b]
+chop _ [] = []
+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)
+
+
+unzipEithers :: [Either a b] -> ([a],[b])
+unzipEithers [] = ([],[])
+unzipEithers (Left x:xs) = (x:a,b)
+    where (a,b) = unzipEithers xs
+unzipEithers (Right x:xs) = (a,x:b)
+    where (a,b) = unzipEithers xs
+
+
+initLast :: [a] -> ([a], a)
+initLast [] = error "initLast, empty list []"
+initLast [x] = ([], x)
+initLast (x:xs) = (x:a, b)
+    where (a,b) = initLast xs
+
+for = flip map
+
+notNull = not . null
+
+groupSortFst :: Ord a => [(a,b)] -> [(a,[b])]
+groupSortFst = map (fst . head &&& map snd) . groupBy ((==) `on` fst) . sortBy (comparing fst)
+
+disjoint :: Eq a => [a] -> [a] -> Bool
+disjoint xs = null . intersect xs
+
+unsnoc :: [a] -> ([a],a)
+unsnoc [] = error "Unsnoc on empty list"
+unsnoc xs = (init xs, last xs)
+
+revTake :: Int -> [a] -> [a]
+revTake i = reverse . take i . reverse
+
+concatUnzip :: [([a], [b])] -> ([a], [b])
+concatUnzip = (concat *** concat) . unzip
+
+
+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 [] = []
+
+
+
+
+trimLeft = dropWhile isSpace
+trimRight = reverse . trimLeft . reverse
+trim = trimLeft . trimRight
+
+
+
+trim, trimLeft, trimRight :: String -> String
+
+lower = map toLower
+upper = map toUpper
+
+trimBy :: (a -> Bool) -> [a] -> [a]
+trimBy f = reverse . dropWhile f . reverse . dropWhile f
+
+
+word1 :: String -> (String, String)
+word1 x = second (dropWhile isSpace) $ break isSpace $ dropWhile isSpace x
+
+
+-- | Only append strings if neither one is empty
+(++?) :: String -> String -> String
+a ++? b = if null a || null b then [] else a ++ b
+
+sortOn f = sortBy (comparing f)
+groupOn f = groupBy ((==) `on` f)
+nubOn f = nubBy ((==) `on` f)
+
+sortFst mr = sortOn fst mr
+groupFst mr = groupOn fst mr
+
+
+groupFsts :: Eq k => [(k,v)] -> [(k,[v])]
+groupFsts = map (fst . head &&& map snd) . groupFst
+
+sortGroupFsts mr = groupFsts . sortFst $ mr
+sortGroupFst mr = groupFst . sortFst $ mr
+
+
+fold :: a -> (a -> a -> a) -> [a] -> a
+fold x f [] = x
+fold x f xs = fold1 f xs
+
+
+fold1 :: (a -> a -> a) -> [a] -> a
+fold1 f [x] = x
+fold1 f xs = f (fold1 f a) (fold1 f b)
+    where (a,b) = halves xs
+
+
+halves :: [a] -> ([a],[a])
+halves [] = ([], [])
+halves (x:xs) = (x:b,a)
+    where (a,b) = halves xs
+
+
+merge :: Ord a => [a] -> [a] -> [a]
+merge xs [] = xs
+merge [] ys = ys
+merge (x:xs) (y:ys)
+    | x <= y = x : merge xs (y:ys)
+    | otherwise = y : merge (x:xs) ys
+
+
+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
+
+
+merges :: Ord a => [[a]] -> [a]
+merges = fold [] merge
+
+mergesBy :: (a -> a -> Ordering) -> [[a]] -> [a]
+mergesBy f = fold [] (mergeBy f)
+
+
+split :: Eq a => a -> [a] -> [[a]]
+split x [] = []
+split x xs = if null b then [a] else a : split x (tail b)
+    where (a,b) = break (== x) xs
+
+
+
+-- | Like splitAt, but also return the number of items that were split.
+--   For performance.
+splitAtLength :: Int -> [a] -> (Int,[a],[a])
+splitAtLength n xs = f n xs
+    where
+        f i xs | i == 0 = (n,[],xs)
+        f i [] = (n-i,[],[])
+        f i (x:xs) = (a,x:b,c)
+            where (a,b,c) = f (i-1) xs
+
+
+rbreak f xs = case break f $ reverse xs of
+    (_, []) -> (xs, [])
+    (as, b:bs) -> (reverse bs, b:reverse as)
+
+
+
+
+splitList :: Eq a => [a] -> [a] -> [[a]]
+splitList find str = if isJust q then a : splitList find b else [str]
+    where
+        q = splitPair find str
+        Just (a, b) = q
+
+
+splitPair :: Eq a => [a] -> [a] -> Maybe ([a], [a])
+splitPair find str = f str
+    where
+        f [] = Nothing
+        f x  | isPrefixOf find x = Just ([], drop (length find) x)
+             | otherwise = if isJust q then Just (head x:a, b) else Nothing
+                where
+                    q = f (tail x)
+                    Just (a, b) = q
+
+wordsBy = undefined
+
+linesBy = undefined
+
+findJust = undefined

Data/Tuple/Extra.hs

@@ -0,0 +1,23 @@
+
+module Data.Tuple.Extra(module Data.Tuple, module Data.Tuple.Extra) 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 x = (x,x)