| Safe Haskell | Safe-Inferred |
|---|---|
| Language | GHC2021 |
Futhark.Util
Description
Non-Futhark-specific utilities. If you find yourself writing general functions on generic data structures, consider putting them here.
Sometimes it is also preferable to copy a small function rather than introducing a large dependency. In this case, make sure to note where you got it from (and make sure that the license is compatible).
Synopsis
- nubOrd :: Ord a => [a] -> [a]
- nubByOrd :: (a -> a -> Ordering) -> [a] -> [a]
- mapAccumLM :: (Monad m, Traversable t) => (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
- maxinum :: (Num a, Ord a, Foldable f) => f a -> a
- mininum :: (Num a, Ord a, Foldable f) => f a -> a
- chunk :: Int -> [a] -> [[a]]
- chunks :: [Int] -> [a] -> [[a]]
- chunkLike :: [[a]] -> [b] -> [[b]]
- dropAt :: Int -> Int -> [a] -> [a]
- takeLast :: Int -> [a] -> [a]
- dropLast :: Int -> [a] -> [a]
- mapEither :: (a -> Either b c) -> [a] -> ([b], [c])
- partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
- maybeNth :: Integral int => int -> [a] -> Maybe a
- maybeHead :: [a] -> Maybe a
- lookupWithIndex :: Eq a => a -> [(a, b)] -> Maybe (Int, b)
- splitFromEnd :: Int -> [a] -> ([a], [a])
- splitAt3 :: Int -> Int -> [a] -> ([a], [a], [a])
- focusNth :: Integral int => int -> [a] -> Maybe ([a], a, [a])
- focusMaybe :: (a -> Maybe b) -> [a] -> Maybe ([a], b, [a])
- hashText :: Text -> Text
- showText :: Show a => a -> Text
- unixEnvironment :: [(String, String)]
- isEnvVarAtLeast :: String -> Int -> Bool
- startupTime :: UTCTime
- fancyTerminal :: Bool
- hFancyTerminal :: Handle -> IO Bool
- runProgramWithExitCode :: FilePath -> [String] -> ByteString -> IO (Either IOException (ExitCode, String, String))
- directoryContents :: FilePath -> IO [FilePath]
- fromPOSIX :: FilePath -> FilePath
- toPOSIX :: FilePath -> FilePath
- trim :: String -> String
- pmapIO :: Maybe Int -> (a -> IO b) -> [a] -> IO [b]
- interactWithFileSafely :: IO a -> IO (Maybe (Either String a))
- convFloat :: (RealFloat from, RealFloat to) => from -> to
- type UserText = Text
- type EncodedText = Text
- zEncodeText :: UserText -> EncodedText
- atMostChars :: Int -> Text -> Text
- invertMap :: (Ord v, Ord k) => Map k v -> Map v (Set k)
- cartesian :: (Monoid m, Foldable t) => (a -> a -> m) -> t a -> t a -> m
- traverseFold :: (Monoid m, Traversable t, Applicative f) => (a -> f m) -> t a -> f m
- fixPoint :: Eq a => (a -> a) -> a -> a
- concatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
- topologicalSort :: (a -> a -> Bool) -> [a] -> [a]
- debugTraceM :: Monad m => Int -> String -> m ()
Documentation
nubByOrd :: (a -> a -> Ordering) -> [a] -> [a] Source #
Like nubBy, but without the quadratic runtime.
mapAccumLM :: (Monad m, Traversable t) => (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y) Source #
Like mapAccumL, but monadic and generalised to
any Traversable.
maxinum :: (Num a, Ord a, Foldable f) => f a -> a Source #
Like maximum, but returns zero for an empty list.
mininum :: (Num a, Ord a, Foldable f) => f a -> a Source #
Like minimum, but returns zero for an empty list.
chunk :: Int -> [a] -> [[a]] Source #
chunk n a splits a into n-size-chunks. If the length of
a is not divisible by n, the last chunk will have fewer than
n elements (but it will never be empty).
chunks :: [Int] -> [a] -> [[a]] Source #
chunks ns a splits a into chunks determined by the elements
of ns. It must hold that sum ns == length a, or the resulting
list may contain too few chunks, or not all elements of a.
chunkLike :: [[a]] -> [b] -> [[b]] Source #
chunkLike xss ys chunks the elements of ys to match the
elements of xss. The sum of the lengths of the sublists of xss
must match the length of ys.
mapEither :: (a -> Either b c) -> [a] -> ([b], [c]) Source #
A combination of map and partitionEithers.
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a]) Source #
maybeNth :: Integral int => int -> [a] -> Maybe a Source #
Return the list element at the given index, if the index is valid.
lookupWithIndex :: Eq a => a -> [(a, b)] -> Maybe (Int, b) Source #
Lookup a value, returning also the index at which it appears.
splitFromEnd :: Int -> [a] -> ([a], [a]) Source #
Like splitAt, but from the end.
focusNth :: Integral int => int -> [a] -> Maybe ([a], a, [a]) Source #
Return the list element at the given index, if the index is valid, along with the elements before and after.
focusMaybe :: (a -> Maybe b) -> [a] -> Maybe ([a], b, [a]) Source #
Return the first list element that satisifes a predicate, along with the elements before and after.
hashText :: Text -> Text Source #
Compute a hash of a text that is stable across OS versions. Returns the hash as a text as well, ready for human consumption.
unixEnvironment :: [(String, String)] Source #
The Unix environment when the Futhark compiler started.
isEnvVarAtLeast :: String -> Int -> Bool Source #
True if the environment variable, viewed as an integer, has at least this numeric value. Returns False if variable is unset or not numeric.
startupTime :: UTCTime Source #
The time at which the process started - or more accurately, the first time this binding was forced.
fancyTerminal :: Bool Source #
Are we running in a terminal capable of fancy commands and visualisation?
hFancyTerminal :: Handle -> IO Bool Source #
Is this handle connected to a terminal capable of fancy commands and visualisation?
runProgramWithExitCode :: FilePath -> [String] -> ByteString -> IO (Either IOException (ExitCode, String, String)) Source #
Like readProcessWithExitCode, but also wraps exceptions when
the indicated binary cannot be launched, or some other exception is
thrown. Also does shenanigans to handle improperly encoded outputs.
directoryContents :: FilePath -> IO [FilePath] Source #
Every non-directory file contained in a directory tree.
fromPOSIX :: FilePath -> FilePath Source #
Some bad operating systems do not use forward slash as directory separator - this is where we convert Futhark includes (which always use forward slash) to native paths.
toPOSIX :: FilePath -> FilePath Source #
Turn a POSIX filepath into a filepath for the native system.
trim :: String -> String Source #
Remove leading and trailing whitespace from a string. Not an efficient implementation!
pmapIO :: Maybe Int -> (a -> IO b) -> [a] -> IO [b] Source #
Run various IO actions concurrently, possibly with a bound on
the number of threads. The list must be finite. The ordering of
the result list is not deterministic - add your own sorting if
needed. If any of the actions throw an exception, then that
exception is propagated to this function.
convFloat :: (RealFloat from, RealFloat to) => from -> to Source #
Convert between different floating-point types, preserving infinities and NaNs.
type EncodedText = Text Source #
Encoded form.
zEncodeText :: UserText -> EncodedText Source #
Z-encode a text using a slightly simplified variant of GHC Z-encoding. The encoded string is a valid identifier in most programming languages.
atMostChars :: Int -> Text -> Text Source #
Truncate to at most this many characters, making the last three characters "..." if truncation is necessary.
invertMap :: (Ord v, Ord k) => Map k v -> Map v (Set k) Source #
Invert a map, handling duplicate values (now keys) by constructing a set of corresponding values.
cartesian :: (Monoid m, Foldable t) => (a -> a -> m) -> t a -> t a -> m Source #
Compute the cartesian product of two foldable collections, using the given combinator function.
traverseFold :: (Monoid m, Traversable t, Applicative f) => (a -> f m) -> t a -> f m Source #
Applicatively fold a traversable.
concatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b Source #
Like concatMap, but monoidal and monadic.
topologicalSort :: (a -> a -> Bool) -> [a] -> [a] Source #
Topological sorting of an array with an adjancency function, if
there is a cycle, it causes an error. dep a b means a -> b,
and the returned array guarantee that for i < j:
not ( dep (ret !! j) (ret !! i) ).