Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
List utils
Synopsis
- at :: [a] -> Word -> Maybe a
- unsafeAt :: [a] -> Word -> a
- checkLength :: Word -> [a] -> Bool
- (++) :: [a] -> [a] -> [a]
- replicate :: Word -> a -> [a]
- drop :: Word -> [a] -> [a]
- length :: Foldable t => t a -> Word
- take :: Word -> [a] -> [a]
- chunksOf :: Word -> [a] -> [[a]]
- pick1 :: [a] -> [(a, [a])]
- enumList :: forall a. (Bounded a, Enum a) => [a]
- zipLeftWith :: (a -> b) -> [a] -> [(b, a)]
- zipRightWith :: (a -> b) -> [a] -> [(a, b)]
- partition :: (a -> Bool) -> [a] -> ([a], [a])
- nub :: Eq a => [a] -> [a]
- sort :: Ord a => [a] -> [a]
- intersperse :: a -> [a] -> [a]
- foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b
- head :: [a] -> a
- tail :: [a] -> [a]
- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
- repeat :: a -> [a]
- nubOn :: Eq b => (a -> b) -> [a] -> [a]
- nubBy :: (a -> a -> Bool) -> [a] -> [a]
- sortOn :: Ord b => (a -> b) -> [a] -> [a]
- sortBy :: (a -> a -> Ordering) -> [a] -> [a]
- groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
- transpose :: [[a]] -> [[a]]
- (\\) :: Eq a => [a] -> [a] -> [a]
- intersect :: Eq a => [a] -> [a] -> [a]
- find :: Foldable t => (a -> Bool) -> t a -> Maybe a
- zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]
- zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
- zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
- zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]
- zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]
- stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
- isPrefixOf :: Eq a => [a] -> [a] -> Bool
- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
- isSuffixOf :: Eq a => [a] -> [a] -> Bool
- elem :: (Foldable t, Eq a) => a -> t a -> Bool
- notElem :: (Foldable t, Eq a) => a -> t a -> Bool
- splitAt :: Integral n => n -> [a] -> ([a], [a])
- split :: (a -> Bool) -> [a] -> [[a]]
- splitOn :: Eq a => [a] -> [a] -> [[a]]
- breakOn :: Eq a => [a] -> [a] -> ([a], [a])
Documentation
at :: [a] -> Word -> Maybe a Source #
Safely index into a list
>>>
[0,1,2,3] `at` 10
Nothing
>>>
[0,1,2,3] `at` 2
Just 2
checkLength :: Word -> [a] -> Bool Source #
Check that a list has the given length (support infinite lists)
(++) :: [a] -> [a] -> [a] infixr 5 #
Append two lists, i.e.,
[x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]
If the first list is not finite, the result is the first list.
chunksOf :: Word -> [a] -> [[a]] Source #
Split a list into chunks of a given size. The last chunk may contain fewer than n elements.
>>>
chunksOf 3 "my test"
["my ","tes","t"]
>>>
chunksOf 3 "mytest"
["myt","est"]
>>>
chunksOf 8 ""
[]
> chunksOf 0 "test"
undefined
pick1 :: [a] -> [(a, [a])] Source #
Pick each element and return the element and the rest of the list
>>>
pick1 [1,2,3,4]
[(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
enumList :: forall a. (Bounded a, Enum a) => [a] Source #
Get members of a bounded enum in a list
>>>
:set -XTypeApplications
>>>
data Letters = A | B | C | D deriving (Bounded,Enum,Show)
>>>
enumList @Letters
[A,B,C,D]
zipLeftWith :: (a -> b) -> [a] -> [(b, a)] Source #
Zip left with something extracted from each value
>>>
zipLeftWith odd [0..5]
[(False,0),(True,1),(False,2),(True,3),(False,4),(True,5)]
zipRightWith :: (a -> b) -> [a] -> [(a, b)] Source #
Zip right with something extracted from each value
>>>
zipRightWith odd [0..5]
[(0,False),(1,True),(2,False),(3,True),(4,False),(5,True)]
partition :: (a -> Bool) -> [a] -> ([a], [a]) #
The partition
function takes a predicate a list and returns
the pair of lists of elements which do and do not satisfy the
predicate, respectively; i.e.,
partition p xs == (filter p xs, filter (not . p) xs)
>>>
partition (`elem` "aeiou") "Hello World!"
("eoo","Hll Wrld!")
O(n^2). The nub
function removes duplicate elements from a list.
In particular, it keeps only the first occurrence of each element.
(The name nub
means `essence'.)
It is a special case of nubBy
, which allows the programmer to supply
their own equality test.
>>>
nub [1,2,3,4,3,2,1,2,4,3,5]
[1,2,3,4,5]
The sort
function implements a stable sorting algorithm.
It is a special case of sortBy
, which allows the programmer to supply
their own comparison function.
Elements are arranged from from lowest to highest, keeping duplicates in the order they appeared in the input.
>>>
sort [1,6,4,3,2,5]
[1,2,3,4,5,6]
intersperse :: a -> [a] -> [a] #
The intersperse
function takes an element and a list and
`intersperses' that element between the elements of the list.
For example,
>>>
intersperse ',' "abcde"
"a,b,c,d,e"
foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b #
Left-associative fold of a structure but with strict application of the operator.
This ensures that each step of the fold is forced to weak head normal
form before being applied, avoiding the collection of thunks that would
otherwise occur. This is often what you want to strictly reduce a finite
list to a single, monolithic result (e.g. length
).
For a general Foldable
structure this should be semantically identical
to,
foldl f z =foldl'
f z .toList
nubOn :: Eq b => (a -> b) -> [a] -> [a] Source #
A version of nub
where the equality is done on some extracted value.
nubOn f
is equivalent to nubBy ((==)
, but has the
performance advantage of only evaluating on
f)f
once for each element in the
input list.
sortOn :: Ord b => (a -> b) -> [a] -> [a] #
Sort a list by comparing the results of a key function applied to each
element. sortOn f
is equivalent to sortBy (comparing f)
, but has the
performance advantage of only evaluating f
once for each element in the
input list. This is called the decorate-sort-undecorate paradigm, or
Schwartzian transform.
Elements are arranged from from lowest to highest, keeping duplicates in the order they appeared in the input.
>>>
sortOn fst [(2, "world"), (4, "!"), (1, "Hello")]
[(1,"Hello"),(2,"world"),(4,"!")]
Since: base-4.8.0.0
groupOn :: Eq b => (a -> b) -> [a] -> [[a]] Source #
A version of group
where the equality is done on some extracted value.
The transpose
function transposes the rows and columns of its argument.
For example,
>>>
transpose [[1,2,3],[4,5,6]]
[[1,4],[2,5],[3,6]]
If some of the rows are shorter than the following rows, their elements are skipped:
>>>
transpose [[10,11],[20],[],[30,31,32]]
[[10,20,30],[11,31],[32]]
(\\) :: Eq a => [a] -> [a] -> [a] infix 5 #
The \\
function is list difference (non-associative).
In the result of xs
\\
ys
, the first occurrence of each element of
ys
in turn (if any) has been removed from xs
. Thus
(xs ++ ys) \\ xs == ys.
>>>
"Hello World!" \\ "ell W"
"Hoorld!"
It is a special case of deleteFirstsBy
, which allows the programmer
to supply their own equality test.
intersect :: Eq a => [a] -> [a] -> [a] #
The intersect
function takes the list intersection of two lists.
For example,
>>>
[1,2,3,4] `intersect` [2,4,6,8]
[2,4]
If the first list contains duplicates, so will the result.
>>>
[1,2,2,3,4] `intersect` [6,4,4,2]
[2,2,4]
It is a special case of intersectBy
, which allows the programmer to
supply their own equality test. If the element is found in both the first
and the second list, the element from the first list will be used.
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] #
The stripPrefix
function drops the given prefix from a list.
It returns Nothing
if the list did not start with the prefix
given, or Just
the list after the prefix, if it does.
>>>
stripPrefix "foo" "foobar"
Just "bar"
>>>
stripPrefix "foo" "foo"
Just ""
>>>
stripPrefix "foo" "barfoo"
Nothing
>>>
stripPrefix "foo" "barfoobaz"
Nothing
isPrefixOf :: Eq a => [a] -> [a] -> Bool #
The isPrefixOf
function takes two lists and returns True
iff the first list is a prefix of the second.
>>>
"Hello" `isPrefixOf` "Hello World!"
True
>>>
"Hello" `isPrefixOf` "Wello Horld!"
False
isSuffixOf :: Eq a => [a] -> [a] -> Bool #
The isSuffixOf
function takes two lists and returns True
iff
the first list is a suffix of the second. The second list must be
finite.
>>>
"ld!" `isSuffixOf` "Hello World!"
True
>>>
"World" `isSuffixOf` "Hello World!"
False
Split
splitAt :: Integral n => n -> [a] -> ([a], [a]) Source #
splitAt
n xs
returns a tuple where first element is xs
prefix of
length n
and second element is the remainder of the list:
splitAt 6 "Hello World!" == ("Hello ","World!") splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5]) splitAt 1 [1,2,3] == ([1],[2,3]) splitAt 3 [1,2,3] == ([1,2,3],[]) splitAt 4 [1,2,3] == ([1,2,3],[]) splitAt 0 [1,2,3] == ([],[1,2,3]) splitAt (-1) [1,2,3] == ([],[1,2,3])
It is equivalent to (
when take
n xs, drop
n xs)n
is not _|_
(splitAt _|_ xs = _|_
).
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.
split (== 'a') "aabbaca" == ["","","bb","c",""] split (== 'a') "" == [""] split (== ':') "::xyz:abc::123::" == ["","","xyz","abc","","123","",""] split (== ',') "my,list,here" == ["my","list","here"]
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.
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" "" == [""] \s x -> s /= "" ==> intercalate s (splitOn s x) == x \c x -> splitOn [c] x == split (==c) x
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.
If you want the remainder without the match, use stripInfix
.
breakOn "::" "a::b::c" == ("a", "::b::c") breakOn "/" "foobar" == ("foobar", "") \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack