extra-0.3: Extra functions I use.

Safe HaskellNone

Extra

Contents

Description

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).

Synopsis

Control.Concurrent.Extra

Extra functions available in Control.Concurrent.Extra.

withNumCapabilities :: Int -> IO a -> IO aSource

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.

setNumCapabilities :: Int -> IO ()

Set the number of Haskell threads that can run truly simultaneously (on separate physical processors) at any given time. The number passed to forkOn is interpreted modulo this value. The initial value is given by the +RTS -N runtime flag.

This is also the number of threads that will participate in parallel garbage collection. It is strongly recommended that the number of capabilities is not set larger than the number of physical processor cores, and it may often be beneficial to leave one or more cores free to avoid contention with other processes in the machine.

forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId

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.

data Lock Source

Like an MVar, but has no value

withLock :: Lock -> IO a -> IO aSource

data Var a Source

Like an MVar, but must always be full

newVar :: a -> IO (Var a)Source

readVar :: Var a -> IO aSource

modifyVar :: Var a -> (a -> IO (a, b)) -> IO bSource

modifyVar_ :: Var a -> (a -> IO a) -> IO ()Source

withVar :: Var a -> (a -> IO b) -> IO bSource

data Barrier a Source

Starts out empty, then is filled exactly once

Control.Exception.Extra

Extra functions available in Control.Exception.Extra.

retry :: Int -> IO a -> IO aSource

Retry an operation at most N times (N must be positive).

 retry 1 (print "x")  == print "x"
 retry 3 (fail "die") == fail "die"

showException :: Show e => e -> IO StringSource

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.

stringException :: String -> IO StringSource

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"

ignore :: IO () -> IO ()Source

Ignore any exceptions thrown by the action.

 ignore (print 1)    == print 1
 ignore (fail "die") == return ()

catch_ :: IO a -> (SomeException -> IO a) -> IO aSource

A version of catch without the Exception context, restricted to SomeException, so catches all exceptions.

handle_ :: (SomeException -> IO a) -> IO a -> IO aSource

Like catch_ but for handle

try_ :: IO a -> IO (Either SomeException a)Source

Like catch_ but for try

catchJust_ :: (SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO aSource

Like catch_ but for catchJust

handleJust_ :: (SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO aSource

Like catch_ but for handleJust

tryJust_ :: (SomeException -> Maybe b) -> IO a -> IO (Either b a)Source

Like catch_ but for tryJust

catchBool :: Exception e => (e -> Bool) -> IO a -> (e -> IO a) -> IO aSource

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 "")

handleBool :: Exception e => (e -> Bool) -> (e -> IO a) -> IO a -> IO aSource

Like catchBool but for handle.

tryBool :: Exception e => (e -> Bool) -> IO a -> IO (Either e a)Source

Like catchBool but for try.

Control.Monad.Extra

Extra functions available in Control.Monad.Extra.

whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()Source

Perform some operation on Just, given the field inside the Just.

 whenJust Nothing  print == return ()
 whenJust (Just 1) print == print 1

unit :: m () -> m ()Source

The identity function which requires the inner argument to be '()'. Useful for functions with overloaded return times.

 \(x :: Maybe ()) -> unit x == x

partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])Source

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

concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]Source

A version of concatMap that works with a monadic predicate.

mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]Source

A version of mapMaybe that works with a monadic predicate.

loopM :: Monad m => (a -> m (Either a b)) -> a -> m bSource

A looping operation, where the predicate returns Left as a seed for the next loop or Right to abort the loop.

whileM :: Monad m => m Bool -> m ()Source

Keep running an operation until it becomes False.

whenM :: Monad m => m Bool -> m () -> m ()Source

unlessM :: Monad m => m Bool -> m () -> m ()Source

ifM :: Monad m => m Bool -> m a -> m a -> m aSource

notM :: Functor m => m Bool -> m BoolSource

(||^) :: Monad m => m Bool -> m Bool -> m BoolSource

(&&^) :: Monad m => m Bool -> m Bool -> m BoolSource

orM :: Monad m => [m Bool] -> m BoolSource

andM :: Monad m => [m Bool] -> m BoolSource

anyM :: Monad m => (a -> m Bool) -> [a] -> m BoolSource

allM :: Monad m => (a -> m Bool) -> [a] -> m BoolSource

findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)Source

firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)Source

Data.Either.Extra

Extra functions available in Data.Either.Extra.

fromLeft :: Either l r -> lSource

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.

fromRight :: Either l r -> rSource

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.

fromEither :: Either a a -> aSource

Pull the value out of an Either where both alternatives have the same type.

Data.IORef.Extra

Extra functions available in Data.IORef.Extra.

modifyIORef' :: IORef a -> (a -> a) -> IO ()

Strict version of modifyIORef

writeIORef' :: IORef a -> a -> IO ()Source

Evaluates the value before calling writeIORef

atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b

Strict version of atomicModifyIORef. This forces both the value stored in the IORef as well as the value returned.

atomicWriteIORef :: IORef a -> a -> IO ()

Variant of writeIORef with the "barrier to reordering" property that atomicModifyIORef has.

atomicWriteIORef' :: IORef a -> a -> IO ()Source

Evaluates the value before calling atomicWriteIORef

Data.List.Extra

Extra functions available in Data.List.Extra.

lower :: String -> StringSource

Documentation about lowercase

 lower "This is A TEST" == "this is a test"
 lower "" == ""

dropAround :: (a -> Bool) -> [a] -> [a]Source

drop1 :: [a] -> [a]Source

list :: b -> (a -> [a] -> b) -> [a] -> bSource

uncons :: [a] -> Maybe (a, [a])Source

unsnoc :: [a] -> Maybe ([a], a)Source

cons :: a -> [a] -> [a]Source

snoc :: [a] -> a -> [a]Source

groupSort :: Ord k => [(k, v)] -> [(k, [v])]Source

groupSortOn :: Ord a => (k -> a) -> [(k, v)] -> [(k, [v])]Source

nubOn :: Eq b => (a -> b) -> [a] -> [a]Source

groupOn :: Eq b => (a -> b) -> [a] -> [[a]]Source

sortOn :: Ord b => (a -> b) -> [a] -> [a]Source

repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]Source

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

for :: [a] -> (a -> b) -> [b]Source

Flipped version of map.

 for [1,2,3] (+1) == [2,3,4]

disjoint :: Eq a => [a] -> [a] -> BoolSource

Are two lists disjoint, with no elements in common.

 disjoint [1,2,3] [4,5] == True
 disjoint [1,2,3] [4,1] == False

allSame :: Eq a => [a] -> BoolSource

Are all elements the same.

 allSame [1,1,2] == False
 allSame [1,1,1] == True
 allSame [1]     == True
 allSame []      == True

anySame :: Eq a => [a] -> BoolSource

Is there any element which occurs more than once.

 anySame [1,1,2] == True
 anySame [1,2,3] == False

dropEnd :: Int -> [a] -> [a]Source

takeEnd :: Int -> [a] -> [a]Source

breakEnd :: (a -> Bool) -> [a] -> ([a], [a])Source

spanEnd :: (a -> Bool) -> [a] -> ([a], [a])Source

dropWhileEnd :: (a -> Bool) -> [a] -> [a]

The dropWhileEnd function drops the largest suffix of a list in which the given predicate holds for all elements. For example:

 dropWhileEnd isSpace "foo\n" == "foo"
 dropWhileEnd isSpace "foo bar" == "foo bar"
 dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined

dropWhileEnd' :: (a -> Bool) -> [a] -> [a]Source

A version of dropWhileEnd but with different strictness properties. Often outperforms if the list is short or the test is expensive.

takeWhileEnd :: (a -> Bool) -> [a] -> [a]Source

stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]Source

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

concatUnzip :: [([a], [b])] -> ([a], [b])Source

concatUnzip3 :: [([a], [b], [c])] -> ([a], [b], [c])Source

merge :: Ord a => [a] -> [a] -> [a]Source

mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]Source

replace :: Eq a => [a] -> [a] -> [a] -> [a]Source

wordsBy :: (a -> Bool) -> [a] -> [[a]]Source

linesBy :: (a -> Bool) -> [a] -> [[a]]Source

firstJust :: (a -> Maybe b) -> [a] -> Maybe bSource

breakOn :: Eq a => [a] -> [a] -> ([a], [a])Source

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

breakOnEnd :: Eq a => [a] -> [a] -> ([a], [a])Source

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")

splitOn :: Eq a => [a] -> [a] -> [[a]]Source

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

split :: (a -> Bool) -> [a] -> [[a]]Source

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') ""        == [""]

chunksOf :: Int -> [a] -> [[a]]Source

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

Data.Tuple.Extra

Extra functions available in Data.Tuple.Extra.

first :: (a -> a') -> (a, b) -> (a', b)Source

Update the first component of a pair.

second :: (b -> b') -> (a, b) -> (a, b')Source

Update the second component of a pair.

(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')Source

(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)Source

dupe :: a -> (a, a)Source

both :: (a -> b) -> (a, a) -> (b, b)Source

fst3 :: (a, b, c) -> aSource

snd3 :: (a, b, c) -> bSource

thd3 :: (a, b, c) -> cSource

first3 :: (a -> a') -> (a, b, c) -> (a', b, c)Source

Update the first component of a triple.

second3 :: (b -> b') -> (a, b, c) -> (a, b', c)Source

Update the second component of a triple.

third3 :: (c -> c') -> (a, b, c) -> (a, b, c')Source

Update the third component of a triple.

dupe3 :: a -> (a, a, a)Source

both3 :: (a -> b) -> (a, a, a) -> (b, b, b)Source

Numeric.Extra

Extra functions available in Numeric.Extra.

showDP :: RealFloat a => Int -> a -> StringSource

Show a number to a number of decimal places.

 showDP 4 pi == "3.1416"
 showDP 0 pi == "3"
 showDP 2 3  == "3.00"

intToDouble :: Int -> DoubleSource

Specialised numeric conversion.

intToFloat :: Int -> FloatSource

Specialised numeric conversion.

floatToDouble :: Float -> DoubleSource

Specialised numeric conversion.

doubleToFloat :: Double -> FloatSource

Specialised numeric conversion.

System.Directory.Extra

Extra functions available in System.Directory.Extra.

withCurrentDirectory :: FilePath -> IO a -> IO aSource

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.

getDirectoryContentsRecursive :: FilePath -> IO [FilePath]Source

Find all the files within a directory, including recursively. Looks through all folders, including those beginning with ..

createDirectoryPrivate :: String -> IO ()Source

Create a directory with permissions so that only the current user can view it. On Windows this function is equivalent to createDirectory.

System.Environment.Extra

Extra functions available in System.Environment.Extra.

getExecutablePath :: IO FilePath

Returns the absolute pathname of the current executable.

Note that for scripts and interactive sessions, this is the path to the interpreter (e.g. ghci.)

lookupEnv :: String -> IO (Maybe String)

Return the value of the environment variable var, or Nothing if there is no such value.

For POSIX users, this is equivalent to getEnv.

System.Info.Extra

Extra functions available in System.Info.Extra.

System.IO.Extra

Extra functions available in System.IO.Extra.

captureOutput :: IO a -> IO (String, a)Source

Capture the stdout and stderr of a computation.

 captureOutput (print 1) == return ("1\n",())

System.Process.Extra

Extra functions available in System.Process.Extra.

System.Time.Extra

Extra functions available in System.Time.Extra.

showDuration :: Seconds -> StringSource

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"

offsetTime :: IO (IO Seconds)Source

Call once at the start, then call repeatedly to get Time values out

offsetTimeIncrease :: IO (IO Seconds)Source

Like offsetTime, but results will never decrease (though they may stay the same)