Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- module Data.List
- lower :: String -> String
- upper :: String -> String
- trim :: String -> String
- trimStart :: String -> String
- trimEnd :: String -> String
- word1 :: String -> (String, String)
- line1 :: String -> (String, String)
- escapeHTML :: String -> String
- escapeJSON :: String -> String
- unescapeHTML :: String -> String
- unescapeJSON :: String -> String
- dropEnd :: Int -> [a] -> [a]
- takeEnd :: Int -> [a] -> [a]
- splitAtEnd :: Int -> [a] -> ([a], [a])
- breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
- spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
- dropWhileEnd' :: (a -> Bool) -> [a] -> [a]
- takeWhileEnd :: (a -> Bool) -> [a] -> [a]
- stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
- stripInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a])
- stripInfixEnd :: Eq a => [a] -> [a] -> Maybe ([a], [a])
- dropPrefix :: Eq a => [a] -> [a] -> [a]
- dropSuffix :: Eq a => [a] -> [a] -> [a]
- wordsBy :: (a -> Bool) -> [a] -> [[a]]
- linesBy :: (a -> Bool) -> [a] -> [[a]]
- breakOn :: Eq a => [a] -> [a] -> ([a], [a])
- breakOnEnd :: Eq a => [a] -> [a] -> ([a], [a])
- splitOn :: (Partial, Eq a) => [a] -> [a] -> [[a]]
- split :: (a -> Bool) -> [a] -> [[a]]
- chunksOf :: Partial => Int -> [a] -> [[a]]
- headDef :: a -> [a] -> a
- lastDef :: a -> [a] -> a
- (!?) :: [a] -> Int -> Maybe a
- notNull :: [a] -> Bool
- list :: b -> (a -> [a] -> b) -> [a] -> b
- unsnoc :: [a] -> Maybe ([a], a)
- cons :: a -> [a] -> [a]
- snoc :: [a] -> a -> [a]
- drop1 :: [a] -> [a]
- dropEnd1 :: [a] -> [a]
- mconcatMap :: Monoid b => (a -> b) -> [a] -> b
- compareLength :: (Ord b, Num b, Foldable f) => f a -> b -> Ordering
- comparingLength :: (Foldable f1, Foldable f2) => f1 a -> f2 b -> Ordering
- enumerate :: (Enum a, Bounded a) => [a]
- groupSort :: Ord k => [(k, v)] -> [(k, [v])]
- groupSortOn :: Ord b => (a -> b) -> [a] -> [[a]]
- groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]]
- nubOrd :: Ord a => [a] -> [a]
- nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a]
- nubOrdOn :: Ord b => (a -> b) -> [a] -> [a]
- nubOn :: Eq b => (a -> b) -> [a] -> [a]
- groupOn :: Eq k => (a -> k) -> [a] -> [[a]]
- groupOnKey :: Eq k => (a -> k) -> [a] -> [(k, [a])]
- nubSort :: Ord a => [a] -> [a]
- nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]
- nubSortOn :: Ord b => (a -> b) -> [a] -> [a]
- maximumOn :: (Partial, Ord b) => (a -> b) -> [a] -> a
- minimumOn :: (Partial, Ord b) => (a -> b) -> [a] -> a
- sum' :: Num a => [a] -> a
- product' :: Num a => [a] -> a
- sumOn' :: Num b => (a -> b) -> [a] -> b
- productOn' :: Num b => (a -> b) -> [a] -> b
- disjoint :: Eq a => [a] -> [a] -> Bool
- disjointOrd :: Ord a => [a] -> [a] -> Bool
- disjointOrdBy :: (a -> a -> Ordering) -> [a] -> [a] -> Bool
- allSame :: Eq a => [a] -> Bool
- anySame :: Eq a => [a] -> Bool
- repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]
- repeatedlyNE :: (NonEmpty a -> (b, [a])) -> [a] -> [b]
- firstJust :: (a -> Maybe b) -> [a] -> Maybe b
- concatUnzip :: [([a], [b])] -> ([a], [b])
- concatUnzip3 :: [([a], [b], [c])] -> ([a], [b], [c])
- zipFrom :: Enum a => a -> [b] -> [(a, b)]
- zipWithFrom :: Enum a => (a -> b -> c) -> a -> [b] -> [c]
- zipWithLongest :: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c]
- replace :: Eq a => [a] -> [a] -> [a] -> [a]
- merge :: Ord a => [a] -> [a] -> [a]
- mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
Documentation
module Data.List
String operations
lower :: String -> String Source #
Convert a string to lower case.
lower "This is A TEST" == "this is a test" lower "" == ""
upper :: String -> String Source #
Convert a string to upper case.
upper "This is A TEST" == "THIS IS A TEST" upper "" == ""
word1 :: String -> (String, String) Source #
Split the first word off a string. Useful for when starting to parse the beginning of a string, but you want to accurately preserve whitespace in the rest of the string.
word1 "" == ("", "") word1 "keyword rest of string" == ("keyword","rest of string") word1 " keyword\n rest of string" == ("keyword","rest of string") \s -> fst (word1 s) == concat (take 1 $ words s) \s -> words (snd $ word1 s) == drop 1 (words s)
line1 :: String -> (String, String) Source #
Split the first line off a string.
line1 "" == ("", "") line1 "test" == ("test","") line1 "test\n" == ("test","") line1 "test\nrest" == ("test","rest") line1 "test\nrest\nmore" == ("test","rest\nmore")
escapeHTML :: String -> String Source #
Escape a string such that it can be inserted into an HTML document or "
attribute
without any special interpretation. This requires escaping the <
, >
, &
and "
characters.
Note that it will escape "
and '
even though that is not required in an HTML body (but is not harmful).
escapeHTML "this is a test" == "this is a test" escapeHTML "<b>\"g&t\"</n>" == "<b>"g&t"</n>" escapeHTML "t'was another test" == "t'was another test"
escapeJSON :: String -> String Source #
Escape a string so it can form part of a JSON literal. This requires escaping the special whitespace and control characters. Additionally, Note that it does not add quote characters around the string.
escapeJSON "this is a test" == "this is a test" escapeJSON "\ttab\nnewline\\" == "\\ttab\\nnewline\\\\" escapeJSON "\ESC[0mHello" == "\\u001b[0mHello"
unescapeHTML :: String -> String Source #
Invert of escapeHTML
(does not do general HTML unescaping)
\xs -> unescapeHTML (escapeHTML xs) == xs
unescapeJSON :: String -> String Source #
General JSON unescaping, inversion of escapeJSON
and all other JSON escapes.
\xs -> unescapeJSON (escapeJSON xs) == xs
Splitting
dropEnd :: Int -> [a] -> [a] Source #
Drop a number of elements from the end of the list.
dropEnd 3 "hello" == "he" dropEnd 5 "bye" == "" dropEnd (-1) "bye" == "bye" \i xs -> dropEnd i xs `isPrefixOf` xs \i xs -> length (dropEnd i xs) == max 0 (length xs - max 0 i) \i -> take 3 (dropEnd 5 [i..]) == take 3 [i..]
takeEnd :: Int -> [a] -> [a] Source #
Take a number of elements from the end of the list.
takeEnd 3 "hello" == "llo" takeEnd 5 "bye" == "bye" takeEnd (-1) "bye" == "" \i xs -> takeEnd i xs `isSuffixOf` xs \i xs -> length (takeEnd i xs) == min (max 0 i) (length xs)
splitAtEnd :: Int -> [a] -> ([a], [a]) Source #
returns a split where the second element tries to
contain splitAtEnd
n xsn
elements.
splitAtEnd 3 "hello" == ("he","llo") splitAtEnd 3 "he" == ("", "he") \i xs -> uncurry (++) (splitAt i xs) == xs \i xs -> splitAtEnd i xs == (dropEnd i xs, takeEnd i xs)
breakEnd :: (a -> Bool) -> [a] -> ([a], [a]) Source #
Break, but from the end.
breakEnd isLower "youRE" == ("you","RE") breakEnd isLower "youre" == ("youre","") breakEnd isLower "YOURE" == ("","YOURE") \f xs -> breakEnd (not . f) xs == spanEnd f xs
spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) Source #
Span, but from the end.
spanEnd isUpper "youRE" == ("you","RE") spanEnd (not . isSpace) "x y z" == ("x y ","z") \f xs -> uncurry (++) (spanEnd f xs) == xs \f xs -> spanEnd f xs == swap (both reverse (span f (reverse xs)))
dropWhileEnd' :: (a -> Bool) -> [a] -> [a] Source #
A version of dropWhileEnd
but with different strictness properties.
The function dropWhileEnd
can be used on an infinite list and tests the property
on each character. In contrast, dropWhileEnd'
is strict in the spine of the list
but only tests the trailing suffix.
This version usually outperforms dropWhileEnd
if the list is short or the test is expensive.
Note the tests below cover both the prime and non-prime variants.
dropWhileEnd isSpace "ab cde " == "ab cde" dropWhileEnd' isSpace "ab cde " == "ab cde" last (dropWhileEnd even [undefined,3]) == undefined last (dropWhileEnd' even [undefined,3]) == 3 head (dropWhileEnd even (3:undefined)) == 3 head (dropWhileEnd' even (3:undefined)) == undefined
takeWhileEnd :: (a -> Bool) -> [a] -> [a] Source #
A version of takeWhile
operating from the end.
takeWhileEnd even [2,3,4,6] == [4,6]
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] Source #
Return the prefix of the second list if its suffix matches the entire first list.
Examples:
stripSuffix "bar" "foobar" == Just "foo" stripSuffix "" "baz" == Just "baz" stripSuffix "foo" "quux" == Nothing
stripInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a]) Source #
Return the the string before and after the search string,
or Nothing
if the search string is not present.
Examples:
stripInfix "::" "a::b::c" == Just ("a", "b::c") stripInfix "/" "foobar" == Nothing
stripInfixEnd :: Eq a => [a] -> [a] -> Maybe ([a], [a]) Source #
Similar to stripInfix
, but searches from the end of the
string.
stripInfixEnd "::" "a::b::c" == Just ("a::b", "c")
dropPrefix :: Eq a => [a] -> [a] -> [a] Source #
Drops the given prefix from a list. It returns the original sequence if the sequence doesn't start with the given prefix.
dropPrefix "Mr. " "Mr. Men" == "Men" dropPrefix "Mr. " "Dr. Men" == "Dr. Men"
dropSuffix :: Eq a => [a] -> [a] -> [a] Source #
Drops the given suffix from a list. It returns the original sequence if the sequence doesn't end with the given suffix.
dropSuffix "!" "Hello World!" == "Hello World" dropSuffix "!" "Hello World!!" == "Hello World!" dropSuffix "!" "Hello World." == "Hello World."
wordsBy :: (a -> Bool) -> [a] -> [[a]] Source #
A variant of words
with a custom test. In particular,
adjacent separators are discarded, as are leading or trailing separators.
wordsBy (== ':') "::xyz:abc::123::" == ["xyz","abc","123"] \s -> wordsBy isSpace s == words s
linesBy :: (a -> Bool) -> [a] -> [[a]] Source #
A variant of lines
with a custom test. In particular,
if there is a trailing separator it will be discarded.
linesBy (== ':') "::xyz:abc::123::" == ["","","xyz","abc","","123",""] \s -> linesBy (== '\n') s == lines s linesBy (== ';') "my;list;here;" == ["my","list","here"]
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
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 :: (Partial, 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
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"]
chunksOf :: Partial => 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" == undefined
Basics
headDef :: a -> [a] -> a Source #
A total head
with a default value.
headDef 1 [] == 1 headDef 1 [2,3,4] == 2 \x xs -> headDef x xs == fromMaybe x (listToMaybe xs)
lastDef :: a -> [a] -> a Source #
A total last
with a default value.
lastDef 1 [] == 1 lastDef 1 [2,3,4] == 4 \x xs -> lastDef x xs == last (x:xs)
(!?) :: [a] -> Int -> Maybe a Source #
A total variant of the list index function (!!)
.
[2,3,4] !? 1 == Just 3 [2,3,4] !? (-1) == Nothing [] !? 0 == Nothing
list :: b -> (a -> [a] -> b) -> [a] -> b Source #
Non-recursive transform over a list, like maybe
.
list 1 (\v _ -> v - 2) [5,6,7] == 3 list 1 (\v _ -> v - 2) [] == 1 \nil cons xs -> maybe nil (uncurry cons) (uncons xs) == list nil cons xs
cons :: a -> [a] -> [a] Source #
Append an element to the start of a list, an alias for (:)
.
cons 't' "est" == "test" \x xs -> uncons (cons x xs) == Just (x,xs)
snoc :: [a] -> a -> [a] Source #
Append an element to the end of a list, takes O(n) time.
snoc "tes" 't' == "test" \xs x -> unsnoc (snoc xs x) == Just (xs,x)
Equivalent to drop 1
, but likely to be faster and a single lexeme.
drop1 "" == "" drop1 "test" == "est" \xs -> drop 1 xs == drop1 xs
dropEnd1 :: [a] -> [a] Source #
Equivalent to dropEnd 1
, but likely to be faster and a single lexeme.
dropEnd1 "" == "" dropEnd1 "test" == "tes" \xs -> dropEnd 1 xs == dropEnd1 xs
mconcatMap :: Monoid b => (a -> b) -> [a] -> b Source #
compareLength :: (Ord b, Num b, Foldable f) => f a -> b -> Ordering Source #
Lazily compare the length of a Foldable
with a number.
compareLength [1,2,3] 1 == GT compareLength [1,2] 2 == EQ \(xs :: [Int]) n -> compareLength xs n == compare (length xs) n compareLength (1:2:3:undefined) 2 == GT
Enum operations
List operations
groupSortOn :: Ord b => (a -> b) -> [a] -> [[a]] Source #
groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]] Source #
nubOrd :: Ord a => [a] -> [a] Source #
O(n log n). The nubOrd
function removes duplicate elements from a list.
In particular, it keeps only the first occurrence of each element.
Unlike the standard nub
operator, this version requires an Ord
instance
and consequently runs asymptotically faster.
nubOrd "this is a test" == "this ae" nubOrd (take 4 ("this" ++ undefined)) == "this" \xs -> nubOrd xs == nub xs
nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a] Source #
A version of nubOrd
with a custom predicate.
nubOrdBy (compare `on` length) ["a","test","of","this"] == ["a","test","of"]
nubOrdOn :: Ord b => (a -> b) -> [a] -> [a] Source #
A version of nubOrd
which operates on a portion of the value.
nubOrdOn length ["a","test","of","this"] == ["a","test","of"]
nubOn :: Eq b => (a -> b) -> [a] -> [a] Source #
Deprecated: Use nubOrdOn, since this function is O(n^2)
DEPRECATED Use nubOrdOn
, since this function is _O(n^2)_.
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.
groupOn :: Eq k => (a -> k) -> [a] -> [[a]] Source #
A version of group
where the equality is done on some extracted value.
groupOn abs [1,-1,2] == [[1,-1], [2]]
groupOnKey :: Eq k => (a -> k) -> [a] -> [(k, [a])] Source #
A version of groupOn
which pairs each group with its "key" - the
extracted value used for equality testing.
groupOnKey abs [1,-1,2] == [(1, [1,-1]), (2, [2])]
nubSort :: Ord a => [a] -> [a] Source #
O(n log n). The nubSort
function sorts and removes duplicate elements from a list.
In particular, it keeps only the first occurrence of each element.
nubSort "this is a test" == " aehist" \xs -> nubSort xs == nub (sort xs)
nubSortBy :: (a -> a -> Ordering) -> [a] -> [a] Source #
A version of nubSort
with a custom predicate.
nubSortBy (compare `on` length) ["a","test","of","this"] == ["a","of","test"]
nubSortOn :: Ord b => (a -> b) -> [a] -> [a] Source #
A version of nubSort
which operates on a portion of the value.
nubSortOn length ["a","test","of","this"] == ["a","of","test"]
maximumOn :: (Partial, Ord b) => (a -> b) -> [a] -> a Source #
A version of maximum
where the comparison is done on some extracted value.
Raises an error if the list is empty. Only calls the function once per element.
maximumOn id [] == undefined maximumOn length ["test","extra","a"] == "extra"
minimumOn :: (Partial, Ord b) => (a -> b) -> [a] -> a Source #
A version of minimum
where the comparison is done on some extracted value.
Raises an error if the list is empty. Only calls the function once per element.
minimumOn id [] == undefined minimumOn length ["test","extra","a"] == "a"
sumOn' :: Num b => (a -> b) -> [a] -> b Source #
A strict version of sum
, using a custom valuation function.
sumOn' read ["1", "2", "3"] == 6
productOn' :: Num b => (a -> b) -> [a] -> b Source #
A strict version of product
, using a custom valuation function.
productOn' read ["1", "2", "4"] == 8
disjoint :: Eq a => [a] -> [a] -> Bool Source #
Are two lists disjoint, with no elements in common.
disjoint [1,2,3] [4,5] == True disjoint [1,2,3] [4,1] == False
disjointOrd :: Ord a => [a] -> [a] -> Bool Source #
disjointOrdBy :: (a -> a -> Ordering) -> [a] -> [a] -> Bool Source #
A version of disjointOrd
with a custom predicate.
disjointOrdBy (compare `on` (`mod` 7)) [1,2,3] [4,5] == True disjointOrdBy (compare `on` (`mod` 7)) [1,2,3] [4,8] == False
allSame :: Eq a => [a] -> Bool Source #
Are all elements the same.
allSame [1,1,2] == False allSame [1,1,1] == True allSame [1] == True allSame [] == True allSame (1:1:2:undefined) == False \xs -> allSame xs == (length (nub xs) <= 1)
anySame :: Eq a => [a] -> Bool Source #
Is there any element which occurs more than once.
anySame [1,1,2] == True anySame [1,2,3] == False anySame (1:2:1:undefined) == True anySame [] == False \xs -> anySame xs == (length (nub xs) < length xs)
repeatedly :: ([a] -> (b, [a])) -> [a] -> [b] Source #
Apply some operation repeatedly, producing an element of output and the remainder of the list.
When the empty list is reached it is returned, so the operation
is never applied to the empty input.
That fact is encoded in the type system with repeatedlyNE
\xs -> repeatedly (splitAt 3) xs == chunksOf 3 xs \xs -> repeatedly word1 (trim xs) == words xs \xs -> repeatedly line1 xs == lines xs
repeatedlyNE :: (NonEmpty a -> (b, [a])) -> [a] -> [b] Source #
Apply some operation repeatedly, producing an element of output and the remainder of the list.
Identical to repeatedly
, but has a more precise type signature.
firstJust :: (a -> Maybe b) -> [a] -> Maybe b Source #
Find the first element of a list for which the operation returns Just
, along
with the result of the operation. Like find
but useful where the function also
computes some expensive information that can be reused. Particular useful
when the function is monadic, see firstJustM
.
firstJust id [Nothing,Just 3] == Just 3 firstJust id [Nothing,Nothing] == Nothing
concatUnzip :: [([a], [b])] -> ([a], [b]) Source #
concatUnzip3 :: [([a], [b], [c])] -> ([a], [b], [c]) Source #
zipFrom :: Enum a => a -> [b] -> [(a, b)] Source #
zip
against an enumeration.
Truncates the output if the enumeration runs out.
\i xs -> zip [i..] xs == zipFrom i xs zipFrom False [1..3] == [(False,1),(True, 2)]
zipWithFrom :: Enum a => (a -> b -> c) -> a -> [b] -> [c] Source #
zipFrom
generalised to any combining operation.
Truncates the output if the enumeration runs out.
\i xs -> zipWithFrom (,) i xs == zipFrom i xs
zipWithLongest :: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c] Source #
Like zipWith
, but keep going to the longest value. The function
argument will always be given at least one Just
, and while both
lists have items, two Just
values.
zipWithLongest (,) "a" "xyz" == [(Just 'a', Just 'x'), (Nothing, Just 'y'), (Nothing, Just 'z')] zipWithLongest (,) "a" "x" == [(Just 'a', Just 'x')] zipWithLongest (,) "" "x" == [(Nothing, Just 'x')]
replace :: Eq a => [a] -> [a] -> [a] -> [a] Source #
Replace a subsequence everywhere it occurs.
replace "el" "_" "Hello Bella" == "H_lo B_la" replace "el" "e" "Hello" == "Helo" replace "" "x" "Hello" == "xHxexlxlxox" replace "" "x" "" == "x" \xs ys -> replace xs xs ys == ys