{-# LANGUAGE TupleSections, ConstraintKinds #-}

-- | This module extends "Data.List" with extra functions of a similar nature.
--   The package also exports the existing "Data.List" functions.
--   Some of the names and semantics were inspired by the
--   <https://hackage.haskell.org/package/text text> package.
module Data.List.Extra(
    module Data.List,
    -- * String operations
    lower, upper, trim, trimStart, trimEnd, word1, line1,
    escapeHTML, escapeJSON,
    unescapeHTML, unescapeJSON,
    -- * Splitting
    dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd,
    dropWhileEnd', takeWhileEnd,
    stripSuffix, stripInfix, stripInfixEnd,
    dropPrefix, dropSuffix,
    wordsBy, linesBy,
    breakOn, breakOnEnd, splitOn, split, chunksOf,
    -- * Basics
    headDef, lastDef, notNull, list, unsnoc, cons, snoc,
    drop1, dropEnd1, mconcatMap,
    -- * Enum operations
    enumerate,
    -- * List operations
    groupSort, groupSortOn, groupSortBy,
    nubOrd, nubOrdBy, nubOrdOn,
    nubOn, groupOn,
    nubSort, nubSortBy, nubSortOn,
    maximumOn, minimumOn,
    disjoint, disjointOrd, disjointOrdBy, allSame, anySame,
    repeatedly, firstJust,
    concatUnzip, concatUnzip3,
    zipFrom, zipWithFrom, zipWithLongest,
    replace, merge, mergeBy,
    ) where

import Partial
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Tuple.Extra
import Data.Monoid
import Numeric
import Data.Functor
import Prelude


-- | 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
-- > \xs -> repeatedly line1 xs == lines xs
repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]
repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]
repeatedly f :: [a] -> (b, [a])
f [] = []
repeatedly f :: [a] -> (b, [a])
f as :: [a]
as = b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: ([a] -> (b, [a])) -> [a] -> [b]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
repeatedly [a] -> (b, [a])
f [a]
as'
    where (b :: b
b, as' :: [a]
as') = [a] -> (b, [a])
f [a]
as


-- | Are two lists disjoint, with no elements in common.
--
-- > disjoint [1,2,3] [4,5] == True
-- > disjoint [1,2,3] [4,1] == False
disjoint :: Eq a => [a] -> [a] -> Bool
disjoint :: [a] -> [a] -> Bool
disjoint xs :: [a]
xs = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
intersect [a]
xs

-- | /O((m+n) log m), m <= n/. Are two lists disjoint, with no elements in common.
--
-- @disjointOrd@ is more strict than `disjoint`. For example, @disjointOrd@ cannot
-- terminate if both lists are inifite, while `disjoint` can.
--
-- > disjointOrd [1,2,3] [4,5] == True
-- > disjointOrd [1,2,3] [4,1] == False
disjointOrd :: Ord a => [a] -> [a] -> Bool
disjointOrd :: [a] -> [a] -> Bool
disjointOrd = (a -> a -> Ordering) -> [a] -> [a] -> Bool
forall a. (a -> a -> Ordering) -> [a] -> [a] -> Bool
disjointOrdBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | 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
disjointOrdBy :: (a -> a -> Ordering) -> [a] -> [a] -> Bool
disjointOrdBy :: (a -> a -> Ordering) -> [a] -> [a] -> Bool
disjointOrdBy cmp :: a -> a -> Ordering
cmp xs :: [a]
xs ys :: [a]
ys
    | [a] -> [a] -> Bool
forall a a. [a] -> [a] -> Bool
shorter [a]
xs [a]
ys = [a] -> [a] -> Bool
forall (t :: * -> *) (t :: * -> *).
(Foldable t, Foldable t) =>
t a -> t a -> Bool
go [a]
xs [a]
ys
    | Bool
otherwise = [a] -> [a] -> Bool
forall (t :: * -> *) (t :: * -> *).
(Foldable t, Foldable t) =>
t a -> t a -> Bool
go [a]
ys [a]
xs
  where
    shorter :: [a] -> [a] -> Bool
shorter _ [] = Bool
False
    shorter [] _ = Bool
True
    shorter (_:xs :: [a]
xs) (_:ys :: [a]
ys) = [a] -> [a] -> Bool
shorter [a]
xs [a]
ys

    go :: t a -> t a -> Bool
go xs :: t a
xs = Bool -> Bool
not (Bool -> Bool) -> (t a -> Bool) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\a :: a
a -> (a -> a -> Ordering) -> a -> RB a -> Bool
forall a. (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB a -> a -> Ordering
cmp a
a RB a
tree)
      where
        tree :: RB a
tree = (RB a -> a -> RB a) -> RB a -> t a -> RB a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> RB a -> RB a) -> RB a -> a -> RB a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> Ordering) -> a -> RB a -> RB a
forall a. (a -> a -> Ordering) -> a -> RB a -> RB a
insertRB a -> a -> Ordering
cmp)) RB a
forall a. RB a
E t a
xs

-- | 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)
anySame :: Eq a => [a] -> Bool
anySame :: [a] -> Bool
anySame = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
f []
    where
        f :: [a] -> [a] -> Bool
f seen :: [a]
seen (x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
seen Bool -> Bool -> Bool
|| [a] -> [a] -> Bool
f (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
seen) [a]
xs
        f seen :: [a]
seen [] = Bool
False

-- | 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)
allSame :: Eq a => [a] -> Bool
allSame :: [a] -> Bool
allSame [] = Bool
True
allSame (x :: a
x:xs :: [a]
xs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
xs


-- | 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)
headDef :: a -> [a] -> a
headDef :: a -> [a] -> a
headDef d :: a
d [] = a
d
headDef _ (x :: a
x:_) = a
x


-- | A total 'last' with a default value.
--
-- > lastDef 1 []      == 1
-- > lastDef 1 [2,3,4] == 4
-- > \x xs -> lastDef x xs == last (x:xs)
lastDef :: a -> [a] -> a
lastDef :: a -> [a] -> a
lastDef d :: a
d xs :: [a]
xs = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\_ x :: a
x -> a
x) a
d [a]
xs -- I know this looks weird, but apparently this is the fastest way to do this: https://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.List.html#last
{-# INLINE lastDef #-}


-- | A composition of 'not' and 'null'.
--
-- > notNull []  == False
-- > notNull [1] == True
-- > \xs -> notNull xs == not (null xs)
notNull :: [a] -> Bool
notNull :: [a] -> Bool
notNull = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | 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
list :: b -> (a -> [a] -> b) -> [a] -> b
list :: b -> (a -> [a] -> b) -> [a] -> b
list nil :: b
nil cons :: a -> [a] -> b
cons [] = b
nil
list nil :: b
nil cons :: a -> [a] -> b
cons (x :: a
x:xs :: [a]
xs) = a -> [a] -> b
cons a
x [a]
xs

-- | If the list is empty returns 'Nothing', otherwise returns the 'init' and the 'last'.
--
-- > unsnoc "test" == Just ("tes",'t')
-- > unsnoc ""     == Nothing
-- > \xs -> unsnoc xs == if null xs then Nothing else Just (init xs, last xs)
unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Maybe ([a], a)
forall a. Maybe a
Nothing
unsnoc [x :: a
x] = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([], a
x)
unsnoc (x :: a
x:xs :: [a]
xs) = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a, a
b)
    where Just (a :: [a]
a,b :: a
b) = [a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
unsnoc [a]
xs

-- | 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)
cons :: a -> [a] -> [a]
cons :: a -> [a] -> [a]
cons = (:)

-- | 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)
snoc :: [a] -> a -> [a]
snoc :: [a] -> a -> [a]
snoc xs :: [a]
xs x :: a
x = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]


-- | Enumerate all the values of an 'Enum', from 'minBound' to 'maxBound'.
--
-- > enumerate == [False, True]
enumerate :: (Enum a, Bounded a) => [a]
enumerate :: [a]
enumerate = [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]

-- | 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)
takeEnd :: Int -> [a] -> [a]
takeEnd :: Int -> [a] -> [a]
takeEnd i :: Int
i xs :: [a]
xs = [a] -> [a] -> [a]
forall a a. [a] -> [a] -> [a]
f [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i [a]
xs)
    where f :: [a] -> [a] -> [a]
f (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) = [a] -> [a] -> [a]
f [a]
xs [a]
ys
          f xs :: [a]
xs _ = [a]
xs

-- | 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..]
dropEnd :: Int -> [a] -> [a]
dropEnd :: Int -> [a] -> [a]
dropEnd i :: Int
i xs :: [a]
xs = [a] -> [a] -> [a]
forall a a. [a] -> [a] -> [a]
f [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i [a]
xs)
    where f :: [a] -> [a] -> [a]
f (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
f [a]
xs [a]
ys
          f _ _ = []


-- | @'splitAtEnd' n xs@ returns a split where the second element tries to
--   contain @n@ 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)
splitAtEnd :: Int -> [a] -> ([a], [a])
splitAtEnd :: Int -> [a] -> ([a], [a])
splitAtEnd i :: Int
i xs :: [a]
xs = [a] -> [a] -> ([a], [a])
forall a a. [a] -> [a] -> ([a], [a])
f [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i [a]
xs)
    where f :: [a] -> [a] -> ([a], [a])
f (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], [a])
f [a]
xs [a]
ys
          f xs :: [a]
xs _ = ([], [a]
xs)


-- | 'zip' against an enumeration.
--   Never truncates the output - raises an error if the enumeration runs out.
--
-- > \i xs -> zip [i..] xs == zipFrom i xs
-- > zipFrom False [1..3] == [(False,1),(True, 2)]
zipFrom :: Enum a => a -> [b] -> [(a, b)]
zipFrom :: a -> [b] -> [(a, b)]
zipFrom = (a -> b -> (a, b)) -> a -> [b] -> [(a, b)]
forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom (,)

-- | 'zipFrom' generalised to any combining operation.
--   Never truncates the output - raises an error if the enumeration runs out.
--
-- > \i xs -> zipWithFrom (,) i xs == zipFrom i xs
zipWithFrom :: Enum a => (a -> b -> c) -> a -> [b] -> [c]
-- would love to deforest the intermediate [a..] list
-- but would require Bounded and Eq as well, so better go for simplicit
zipWithFrom :: (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom f :: a -> b -> c
f a :: a
a = (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f [a
a..]


-- | A merging of 'unzip' and 'concat'.
--
-- > concatUnzip [("a","AB"),("bc","C")] == ("abc","ABC")
concatUnzip :: [([a], [b])] -> ([a], [b])
concatUnzip :: [([a], [b])] -> ([a], [b])
concatUnzip = ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([[b]] -> [b]) -> ([[a]], [[b]]) -> ([a], [b])
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (([[a]], [[b]]) -> ([a], [b]))
-> ([([a], [b])] -> ([[a]], [[b]])) -> [([a], [b])] -> ([a], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([a], [b])] -> ([[a]], [[b]])
forall a b. [(a, b)] -> ([a], [b])
unzip

-- | A merging of 'unzip3' and 'concat'.
--
-- > concatUnzip3 [("a","AB",""),("bc","C","123")] == ("abc","ABC","123")
concatUnzip3 :: [([a],[b],[c])] -> ([a],[b],[c])
concatUnzip3 :: [([a], [b], [c])] -> ([a], [b], [c])
concatUnzip3 xs :: [([a], [b], [c])]
xs = ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
a, [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[b]]
b, [[c]] -> [c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[c]]
c)
    where (a :: [[a]]
a,b :: [[b]]
b,c :: [[c]]
c) = [([a], [b], [c])] -> ([[a]], [[b]], [[c]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([a], [b], [c])]
xs


-- | A version of 'takeWhile' operating from the end.
--
-- > takeWhileEnd even [2,3,4,6] == [4,6]
takeWhileEnd :: (a -> Bool) -> [a] -> [a]
takeWhileEnd :: (a -> Bool) -> [a] -> [a]
takeWhileEnd f :: a -> Bool
f = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse


-- | Remove spaces from the start of a string, see 'trim'.
trimStart :: String -> String
trimStart :: String -> String
trimStart = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Remove spaces from the end of a string, see 'trim'.
trimEnd :: String -> String
trimEnd :: String -> String
trimEnd = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace

-- | Remove spaces from either side of a string. A combination of 'trimEnd' and 'trimStart'.
--
-- > trim      "  hello   " == "hello"
-- > trimStart "  hello   " == "hello   "
-- > trimEnd   "  hello   " == "  hello"
-- > \s -> trim s == trimEnd (trimStart s)
trim :: String -> String
trim :: String -> String
trim = String -> String
trimEnd (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trimStart

-- | Convert a string to lower case.
--
-- > lower "This is A TEST" == "this is a test"
-- > lower "" == ""
lower :: String -> String
lower :: String -> String
lower = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

-- | Convert a string to upper case.
--
-- > upper "This is A TEST" == "THIS IS A TEST"
-- > upper "" == ""
upper :: String -> String
upper :: String -> String
upper = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper


-- | 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)
word1 :: String -> (String, String)
word1 :: String -> (String, String)
word1 = (String -> String) -> (String, String) -> (String, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second String -> String
trimStart ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trimStart

-- | 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")
line1 :: String -> (String, String)
line1 :: String -> (String, String)
line1 = (String -> String) -> (String, String) -> (String, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second String -> String
forall a. [a] -> [a]
drop1 ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n')

-- | 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>" == "&lt;b&gt;&quot;g&amp;t&quot;&lt;/n&gt;"
-- > escapeHTML "t'was another test" == "t&#39;was another test"
escapeHTML :: String -> String
escapeHTML :: String -> String
escapeHTML = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f
    where
        f :: Char -> String
f '>' = "&gt;"
        f '<' = "&lt;"
        f '&' = "&amp;"
        f '\"' = "&quot;"
        f '\'' = "&#39;"
        f x :: Char
x = [Char
x]

-- | Invert of 'escapeHTML' (does not do general HTML unescaping)
--
-- > \xs -> unescapeHTML (escapeHTML xs) == xs
unescapeHTML :: String -> String
unescapeHTML :: String -> String
unescapeHTML ('&':xs :: String
xs)
    | Just xs :: String
xs <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "lt;" String
xs = '<' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeHTML String
xs
    | Just xs :: String
xs <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "gt;" String
xs = '>' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeHTML String
xs
    | Just xs :: String
xs <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "amp;" String
xs = '&' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeHTML String
xs
    | Just xs :: String
xs <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "quot;" String
xs = '\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeHTML String
xs
    | Just xs :: String
xs <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "#39;" String
xs = '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeHTML String
xs
unescapeHTML (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeHTML String
xs
unescapeHTML [] = []


-- | 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"
escapeJSON :: String -> String
escapeJSON :: String -> String
escapeJSON x :: String
x = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
x
    where f :: Char -> String
f '\"' = "\\\""
          f '\\' = "\\\\"
          -- the spaces are technically optional, but we include them so the JSON is readable
          f '\b' = "\\b"
          f '\f' = "\\f"
          f '\n' = "\\n"
          f '\r' = "\\r"
          f '\t' = "\\t"
          f x :: Char
x | Char -> Bool
isControl Char
x = "\\u" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
takeEnd 4 ("0000" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (Char -> Int
ord Char
x) "")
          f x :: Char
x = [Char
x]

-- | General JSON unescaping, inversion of 'escapeJSON' and all other JSON escapes.
--
-- > \xs -> unescapeJSON (escapeJSON xs) == xs
unescapeJSON :: String -> String
unescapeJSON :: String -> String
unescapeJSON ('\\':x :: Char
x:xs :: String
xs)
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\"' = '\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' = '\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' = '/' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'b' = '\b' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'f' = '\f' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'n' = '\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'r' = '\r' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 't' = '\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'u', let (a :: String
a,b :: String
b) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt 4 String
xs, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4, [(i :: Int
i, "")] <- ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex String
a = Int -> Char
chr Int
i Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
b
unescapeJSON (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescapeJSON String
xs
unescapeJSON [] = []


-- | A version of 'group' where the equality is done on some extracted value.
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn :: (a -> b) -> [a] -> [[a]]
groupOn f :: a -> b
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall t t p. (t -> t -> t) -> (p -> t) -> p -> p -> t
`on2` a -> b
f)
    -- redefine on so we avoid duplicate computation for most values.
    where .*. :: t -> t -> t
(.*.) on2 :: (t -> t -> t) -> (p -> t) -> p -> p -> t
`on2` f :: p -> t
f = \x :: p
x -> let fx :: t
fx = p -> t
f p
x in \y :: p
y -> t
fx t -> t -> t
.*. p -> t
f p
y


-- | /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 ((==) `on` f)@, but has the
--   performance advantage of only evaluating @f@ once for each element in the
--   input list.
{-# DEPRECATED nubOn "Use nubOrdOn, since this function is O(n^2)" #-}
nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn :: (a -> b) -> [a] -> [a]
nubOn f :: a -> b
f = ((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, a)] -> [a]) -> ([a] -> [(b, a)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Bool) -> [(b, a)] -> [(b, a)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> ((b, a) -> b) -> (b, a) -> (b, a) -> Bool
forall t t p. (t -> t -> t) -> (p -> t) -> p -> p -> t
`on` (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: a
x -> let y :: b
y = a -> b
f a
x in b
y b -> (b, a) -> (b, a)
forall a b. a -> b -> b
`seq` (b
y, a
x))

-- | 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"
maximumOn :: (Partial, Ord b) => (a -> b) -> [a] -> a
maximumOn :: (a -> b) -> [a] -> a
maximumOn f :: a -> b
f [] = String -> a
forall a. HasCallStack => String -> a
error "Data.List.Extra.maximumOn: empty list"
maximumOn f :: a -> b
f (x :: a
x:xs :: [a]
xs) = a -> b -> [a] -> a
g a
x (a -> b
f a
x) [a]
xs
    where
        g :: a -> b -> [a] -> a
g v :: a
v mv :: b
mv [] = a
v
        g v :: a
v mv :: b
mv (x :: a
x:xs :: [a]
xs) | b
mx b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
mv = a -> b -> [a] -> a
g a
x b
mx [a]
xs
                      | Bool
otherwise = a -> b -> [a] -> a
g a
v b
mv [a]
xs
            where mx :: b
mx = a -> b
f a
x


-- | 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"
minimumOn :: (Partial, Ord b) => (a -> b) -> [a] -> a
minimumOn :: (a -> b) -> [a] -> a
minimumOn f :: a -> b
f [] = String -> a
forall a. HasCallStack => String -> a
error "Data.List.Extra.minimumOn: empty list"
minimumOn f :: a -> b
f (x :: a
x:xs :: [a]
xs) = a -> b -> [a] -> a
g a
x (a -> b
f a
x) [a]
xs
    where
        g :: a -> b -> [a] -> a
g v :: a
v mv :: b
mv [] = a
v
        g v :: a
v mv :: b
mv (x :: a
x:xs :: [a]
xs) | b
mx b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
mv = a -> b -> [a] -> a
g a
x b
mx [a]
xs
                      | Bool
otherwise = a -> b -> [a] -> a
g a
v b
mv [a]
xs
            where mx :: b
mx = a -> b
f a
x

-- | A combination of 'group' and 'sort'.
--
-- > groupSort [(1,'t'),(3,'t'),(2,'e'),(2,'s')] == [(1,"t"),(2,"es"),(3,"t")]
-- > \xs -> map fst (groupSort xs) == sort (nub (map fst xs))
-- > \xs -> concatMap snd (groupSort xs) == map snd (sortOn fst xs)
groupSort :: Ord k => [(k, v)] -> [(k, [v])]
groupSort :: [(k, v)] -> [(k, [v])]
groupSort = ([(k, v)] -> (k, [v])) -> [[(k, v)]] -> [(k, [v])]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: [(k, v)]
x -> ((k, v) -> k
forall a b. (a, b) -> a
fst ((k, v) -> k) -> (k, v) -> k
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> (k, v)
forall a. [a] -> a
head [(k, v)]
x, ((k, v) -> v) -> [(k, v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> v
forall a b. (a, b) -> b
snd [(k, v)]
x)) ([[(k, v)]] -> [(k, [v])])
-> ([(k, v)] -> [[(k, v)]]) -> [(k, v)] -> [(k, [v])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> k) -> [(k, v)] -> [[(k, v)]]
forall b a. Eq b => (a -> b) -> [a] -> [[a]]
groupOn (k, v) -> k
forall a b. (a, b) -> a
fst ([(k, v)] -> [[(k, v)]])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [[(k, v)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> k) -> [(k, v)] -> [(k, v)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (k, v) -> k
forall a b. (a, b) -> a
fst

-- | A combination of 'group' and 'sort', using a part of the value to compare on.
--
-- > groupSortOn length ["test","of","sized","item"] == [["of"],["test","item"],["sized"]]
groupSortOn :: Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn :: (a -> b) -> [a] -> [[a]]
groupSortOn f :: a -> b
f = ([(b, a)] -> [a]) -> [[(b, a)]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd) ([[(b, a)]] -> [[a]]) -> ([a] -> [[(b, a)]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Bool) -> [(b, a)] -> [[(b, a)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> ((b, a) -> b) -> (b, a) -> (b, a) -> Bool
forall t t p. (t -> t -> t) -> (p -> t) -> p -> p -> t
`on` (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [[(b, a)]]) -> ([a] -> [(b, a)]) -> [a] -> [[(b, a)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Ordering) -> [(b, a)] -> [(b, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering)
-> ((b, a) -> b) -> (b, a) -> (b, a) -> Ordering
forall t t p. (t -> t -> t) -> (p -> t) -> p -> p -> t
`on` (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f (a -> b) -> (a -> a) -> a -> (b, a)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& a -> a
forall a. a -> a
id)

-- | A combination of 'group' and 'sort', using a predicate to compare on.
--
-- > groupSortBy (compare `on` length) ["test","of","sized","item"] == [["of"],["test","item"],["sized"]]
groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]]
groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]]
groupSortBy f :: a -> a -> Ordering
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a :: a
a b :: a
b -> a -> a -> Ordering
f a
a a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
f


-- | Merge two lists which are assumed to be ordered.
--
-- > merge "ace" "bd" == "abcde"
-- > \xs ys -> merge (sort xs) (sort ys) == sort (xs ++ ys)
merge :: Ord a => [a] -> [a] -> [a]
merge :: [a] -> [a] -> [a]
merge = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare


-- | Like 'merge', but with a custom ordering function.
mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy f :: a -> a -> Ordering
f xs :: [a]
xs [] = [a]
xs
mergeBy f :: a -> a -> Ordering
f [] ys :: [a]
ys = [a]
ys
mergeBy f :: a -> a -> Ordering
f (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys)
    | a -> a -> Ordering
f a
x a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy a -> a -> Ordering
f [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    | Bool
otherwise = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy a -> a -> Ordering
f (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys


-- | Replace a subsequence everywhere it occurs. The first argument must
--   not be the empty list.
--
-- > replace "el" "_" "Hello Bella" == "H_lo B_la"
-- > replace "el" "e" "Hello"       == "Helo"
-- > replace "" "e" "Hello"         == undefined
-- > \xs ys -> not (null xs) ==> replace xs xs ys == ys
replace :: (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace :: [a] -> [a] -> [a] -> [a]
replace [] _ _ = String -> [a]
forall a. HasCallStack => String -> a
error "Extra.replace, first argument cannot be empty"
replace from :: [a]
from to :: [a]
to xs :: [a]
xs | Just xs :: [a]
xs <- [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
from [a]
xs = [a]
to [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a] -> [a] -> [a]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [a] -> [a]
replace [a]
from [a]
to [a]
xs
replace from :: [a]
from to :: [a]
to (x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [a] -> [a]
replace [a]
from [a]
to [a]
xs
replace from :: [a]
from to :: [a]
to [] = []


-- | 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
breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd f :: a -> Bool
f = ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (b, a)
swap (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> (a, a) -> (b, b)
both [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f ([a] -> ([a], [a])) -> ([a] -> [a]) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

-- | 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)))
spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd f :: a -> Bool
f = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f)


-- | 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
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy f :: a -> Bool
f s :: [a]
s = case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
f [a]
s of
    [] -> []
    x :: a
x:xs :: [a]
xs -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
w) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
f ([a] -> [a]
forall a. [a] -> [a]
drop1 [a]
z)
        where (w :: [a]
w,z :: [a]
z) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f [a]
xs

-- | 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"]
linesBy :: (a -> Bool) -> [a] -> [[a]]
linesBy :: (a -> Bool) -> [a] -> [[a]]
linesBy f :: a -> Bool
f [] = []
linesBy f :: a -> Bool
f s :: [a]
s = ([a], [[a]]) -> [[a]]
forall a. (a, [a]) -> [a]
cons (([a], [[a]]) -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b. (a -> b) -> a -> b
$ case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f [a]
s of
    (l :: [a]
l, s :: [a]
s) -> ([a]
l,) ([[a]] -> ([a], [[a]])) -> [[a]] -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ case [a]
s of
        [] -> []
        _:s :: [a]
s -> (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
linesBy a -> Bool
f [a]
s
  where
    cons :: (a, [a]) -> [a]
cons ~(h :: a
h, t :: [a]
t) = a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t -- to fix a space leak, see the GHC defn of lines

-- | 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
firstJust :: (a -> Maybe b) -> [a] -> Maybe b
firstJust :: (a -> Maybe b) -> [a] -> Maybe b
firstJust f :: a -> Maybe b
f = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> ([a] -> [b]) -> [a] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f


-- | Equivalent to @drop 1@, but likely to be faster and a single lexeme.
--
-- > drop1 ""         == ""
-- > drop1 "test"     == "est"
-- > \xs -> drop 1 xs == drop1 xs
drop1 :: [a] -> [a]
drop1 :: [a] -> [a]
drop1 [] = []
drop1 (x :: a
x:xs :: [a]
xs) = [a]
xs


-- | Equivalent to @dropEnd 1@, but likely to be faster and a single lexeme.
--
-- > dropEnd1 ""         == ""
-- > dropEnd1 "test"     == "tes"
-- > \xs -> dropEnd 1 xs == dropEnd1 xs
dropEnd1 :: [a] -> [a]
dropEnd1 :: [a] -> [a]
dropEnd1 [] = []
dropEnd1 (x :: a
x:xs :: [a]
xs) = (a -> (a -> [a]) -> a -> [a]) -> (a -> [a]) -> [a] -> a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\z :: a
z f :: a -> [a]
f y :: a
y -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
f a
z) ([a] -> a -> [a]
forall a b. a -> b -> a
const []) [a]
xs a
x


-- | Version on `concatMap` generalised to a `Monoid` rather than just a list.
--
-- > mconcatMap Sum [1,2,3] == Sum 6
-- > \f xs -> mconcatMap f xs == concatMap f xs
mconcatMap :: Monoid b => (a -> b) -> [a] -> b
mconcatMap :: (a -> b) -> [a] -> b
mconcatMap f :: a -> b
f = [b] -> b
forall a. Monoid a => [a] -> a
mconcat ([b] -> b) -> ([a] -> [b]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f


-- | 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
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
breakOn :: [a] -> [a] -> ([a], [a])
breakOn needle :: [a]
needle haystack :: [a]
haystack | [a]
needle [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
haystack = ([], [a]
haystack)
breakOn needle :: [a]
needle [] = ([], [])
breakOn needle :: [a]
needle (x :: a
x:xs :: [a]
xs) = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn [a]
needle [a]
xs

-- | 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")
breakOnEnd :: Eq a => [a] -> [a] -> ([a], [a])
breakOnEnd :: [a] -> [a] -> ([a], [a])
breakOnEnd needle :: [a]
needle haystack :: [a]
haystack = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> (a, a) -> (b, b)
both [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (b, a)
swap (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
needle) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
haystack)


-- | 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
splitOn :: (Partial, Eq a) => [a] -> [a] -> [[a]]
splitOn :: [a] -> [a] -> [[a]]
splitOn [] _ = String -> [[a]]
forall a. HasCallStack => String -> a
error "splitOn, needle may not be empty"
splitOn _ [] = [[]]
splitOn needle :: [a]
needle haystack :: [a]
haystack = [a]
a [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
b then [] else [a] -> [a] -> [[a]]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
splitOn [a]
needle ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
needle) [a]
b
    where (a :: [a]
a,b :: [a]
b) = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn [a]
needle [a]
haystack


-- | 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"]
split :: (a -> Bool) -> [a] -> [[a]]
split :: (a -> Bool) -> [a] -> [[a]]
split f :: a -> Bool
f [] = [[]]
split f :: a -> Bool
f (x :: a
x:xs :: [a]
xs) | a -> Bool
f a
x = [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
split a -> Bool
f [a]
xs
split f :: a -> Bool
f (x :: a
x:xs :: [a]
xs) | y :: [a]
y:ys :: [[a]]
ys <- (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
split a -> Bool
f [a]
xs = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
ys


-- | 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
dropWhileEnd' :: (a -> Bool) -> [a] -> [a]
dropWhileEnd' :: (a -> Bool) -> [a] -> [a]
dropWhileEnd' p :: a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x :: a
x xs :: [a]
xs -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs Bool -> Bool -> Bool
&& a -> Bool
p a
x then [] else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) []


-- | 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"
dropPrefix :: Eq a => [a] -> [a] -> [a]
dropPrefix :: [a] -> [a] -> [a]
dropPrefix a :: [a]
a b :: [a]
b = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
b (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
a [a]
b


-- | 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."
dropSuffix :: Eq a => [a] -> [a] -> [a]
dropSuffix :: [a] -> [a] -> [a]
dropSuffix a :: [a]
a b :: [a]
b = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
b (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
a [a]
b

-- | 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
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix :: [a] -> [a] -> Maybe [a]
stripSuffix a :: [a]
a b :: [a]
b = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
a) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
b)


-- | 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
stripInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix :: [a] -> [a] -> Maybe ([a], [a])
stripInfix needle :: [a]
needle haystack :: [a]
haystack | Just rest :: [a]
rest <- [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
needle [a]
haystack = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just ([], [a]
rest)
stripInfix needle :: [a]
needle [] = Maybe ([a], [a])
forall a. Maybe a
Nothing
stripInfix needle :: [a]
needle (x :: a
x:xs :: [a]
xs) = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> Maybe ([a], [a]) -> Maybe ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe ([a], [a])
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix [a]
needle [a]
xs


-- | Similar to 'stripInfix', but searches from the end of the
-- string.
--
-- > stripInfixEnd "::" "a::b::c" == Just ("a::b", "c")
stripInfixEnd :: Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfixEnd :: [a] -> [a] -> Maybe ([a], [a])
stripInfixEnd needle :: [a]
needle haystack :: [a]
haystack = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> (a, a) -> (b, b)
both [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a]) -> ([a], [a]))
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (b, a)
swap (([a], [a]) -> ([a], [a])) -> Maybe ([a], [a]) -> Maybe ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe ([a], [a])
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
needle) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
haystack)


-- | 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
chunksOf :: Partial => Int -> [a] -> [[a]]
chunksOf :: Int -> [a] -> [[a]]
chunksOf i :: Int
i xs :: [a]
xs | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = String -> [[a]]
forall a. HasCallStack => String -> a
error (String -> [[a]]) -> String -> [[a]]
forall a b. (a -> b) -> a -> b
$ "chunksOf, number must be positive, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
chunksOf i :: Int
i xs :: [a]
xs = ([a] -> ([a], [a])) -> [a] -> [[a]]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
repeatedly (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i) [a]
xs


-- | /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)
nubSort :: Ord a => [a] -> [a]
nubSort :: [a] -> [a]
nubSort = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | A version of 'nubSort' which operates on a portion of the value.
--
-- > nubSortOn length ["a","test","of","this"] == ["a","of","test"]
nubSortOn :: Ord b => (a -> b) -> [a] -> [a]
nubSortOn :: (a -> b) -> [a] -> [a]
nubSortOn f :: a -> b
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall t t p. (t -> t -> t) -> (p -> t) -> p -> p -> t
`on` a -> b
f)

-- | A version of 'nubSort' with a custom predicate.
--
-- > nubSortBy (compare `on` length) ["a","test","of","this"] == ["a","of","test"]
nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]
nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]
nubSortBy cmp :: a -> a -> Ordering
cmp = [a] -> [a]
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp
    where f :: [a] -> [a]
f (x1 :: a
x1:x2 :: a
x2:xs :: [a]
xs) | a -> a -> Ordering
cmp a
x1 a
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ = [a] -> [a]
f (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
          f (x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
f [a]
xs
          f [] = []

-- | /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
nubOrd :: Ord a => [a] -> [a]
nubOrd :: [a] -> [a]
nubOrd = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | A version of 'nubOrd' which operates on a portion of the value.
--
-- > nubOrdOn length ["a","test","of","this"] == ["a","test","of"]
nubOrdOn :: Ord b => (a -> b) -> [a] -> [a]
nubOrdOn :: (a -> b) -> [a] -> [a]
nubOrdOn f :: a -> b
f = ((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, a)] -> [a]) -> ([a] -> [(b, a)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Ordering) -> [(b, a)] -> [(b, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering)
-> ((b, a) -> b) -> (b, a) -> (b, a) -> Ordering
forall t t p. (t -> t -> t) -> (p -> t) -> p -> p -> t
`on` (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f (a -> b) -> (a -> a) -> a -> (b, a)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& a -> a
forall a. a -> a
id)

-- | A version of 'nubOrd' with a custom predicate.
--
-- > nubOrdBy (compare `on` length) ["a","test","of","this"] == ["a","test","of"]
nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy cmp :: a -> a -> Ordering
cmp xs :: [a]
xs = RB a -> [a] -> [a]
f RB a
forall a. RB a
E [a]
xs
    where f :: RB a -> [a] -> [a]
f seen :: RB a
seen [] = []
          f seen :: RB a
seen (x :: a
x:xs :: [a]
xs) | (a -> a -> Ordering) -> a -> RB a -> Bool
forall a. (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB a -> a -> Ordering
cmp a
x RB a
seen = RB a -> [a] -> [a]
f RB a
seen [a]
xs
                        | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: RB a -> [a] -> [a]
f ((a -> a -> Ordering) -> a -> RB a -> RB a
forall a. (a -> a -> Ordering) -> a -> RB a -> RB a
insertRB a -> a -> Ordering
cmp a
x RB a
seen) [a]
xs

---------------------------------------------------------------------
-- OKASAKI RED BLACK TREE
-- Taken from https://www.cs.kent.ac.uk/people/staff/smk/redblack/Untyped.hs
-- But with the Color = R|B fused into the tree

data RB a = E | T_R (RB a) a (RB a) | T_B (RB a) a (RB a) deriving Int -> RB a -> String -> String
[RB a] -> String -> String
RB a -> String
(Int -> RB a -> String -> String)
-> (RB a -> String) -> ([RB a] -> String -> String) -> Show (RB a)
forall a. Show a => Int -> RB a -> String -> String
forall a. Show a => [RB a] -> String -> String
forall a. Show a => RB a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RB a] -> String -> String
$cshowList :: forall a. Show a => [RB a] -> String -> String
show :: RB a -> String
$cshow :: forall a. Show a => RB a -> String
showsPrec :: Int -> RB a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> RB a -> String -> String
Show

{- Insertion and membership test as by Okasaki -}
insertRB :: (a -> a -> Ordering) -> a -> RB a -> RB a
insertRB :: (a -> a -> Ordering) -> a -> RB a -> RB a
insertRB cmp :: a -> a -> Ordering
cmp x :: a
x s :: RB a
s = case RB a -> RB a
ins RB a
s of
    T_R a :: RB a
a z :: a
z b :: RB a
b -> RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
z RB a
b
    x :: RB a
x -> RB a
x
    where
    ins :: RB a -> RB a
ins E = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R RB a
forall a. RB a
E a
x RB a
forall a. RB a
E
    ins s :: RB a
s@(T_B a :: RB a
a y :: a
y b :: RB a
b) = case a -> a -> Ordering
cmp a
x a
y of
        LT -> RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
lbalance (RB a -> RB a
ins RB a
a) a
y RB a
b
        GT -> RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
rbalance RB a
a a
y (RB a -> RB a
ins RB a
b)
        EQ -> RB a
s
    ins s :: RB a
s@(T_R a :: RB a
a y :: a
y b :: RB a
b) = case a -> a -> Ordering
cmp a
x a
y of
        LT -> RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> RB a
ins RB a
a) a
y RB a
b
        GT -> RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R RB a
a a
y (RB a -> RB a
ins RB a
b)
        EQ -> RB a
s

memberRB :: (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB :: (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB cmp :: a -> a -> Ordering
cmp x :: a
x E = Bool
False
memberRB cmp :: a -> a -> Ordering
cmp x :: a
x (T_R a :: RB a
a y :: a
y b :: RB a
b) = case a -> a -> Ordering
cmp a
x a
y of
    LT -> (a -> a -> Ordering) -> a -> RB a -> Bool
forall a. (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB a -> a -> Ordering
cmp a
x RB a
a
    GT -> (a -> a -> Ordering) -> a -> RB a -> Bool
forall a. (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB a -> a -> Ordering
cmp a
x RB a
b
    EQ -> Bool
True
memberRB cmp :: a -> a -> Ordering
cmp x :: a
x (T_B a :: RB a
a y :: a
y b :: RB a
b) = case a -> a -> Ordering
cmp a
x a
y of
    LT -> (a -> a -> Ordering) -> a -> RB a -> Bool
forall a. (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB a -> a -> Ordering
cmp a
x RB a
a
    GT -> (a -> a -> Ordering) -> a -> RB a -> Bool
forall a. (a -> a -> Ordering) -> a -> RB a -> Bool
memberRB a -> a -> Ordering
cmp a
x RB a
b
    EQ -> Bool
True

{- balance: first equation is new,
   to make it work with a weaker invariant -}
lbalance, rbalance :: RB a -> a -> RB a -> RB a
lbalance :: RB a -> a -> RB a -> RB a
lbalance (T_R a :: RB a
a x :: a
x b :: RB a
b) y :: a
y (T_R c :: RB a
c z :: a
z d :: RB a
d) = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b) a
y (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
c a
z RB a
d)
lbalance (T_R (T_R a :: RB a
a x :: a
x b :: RB a
b) y :: a
y c :: RB a
c) z :: a
z d :: RB a
d = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b) a
y (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
c a
z RB a
d)
lbalance (T_R a :: RB a
a x :: a
x (T_R b :: RB a
b y :: a
y c :: RB a
c)) z :: a
z d :: RB a
d = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b) a
y (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
c a
z RB a
d)
lbalance a :: RB a
a x :: a
x b :: RB a
b = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b
rbalance :: RB a -> a -> RB a -> RB a
rbalance (T_R a :: RB a
a x :: a
x b :: RB a
b) y :: a
y (T_R c :: RB a
c z :: a
z d :: RB a
d) = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b) a
y (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
c a
z RB a
d)
rbalance a :: RB a
a x :: a
x (T_R b :: RB a
b y :: a
y (T_R c :: RB a
c z :: a
z d :: RB a
d)) = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b) a
y (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
c a
z RB a
d)
rbalance a :: RB a
a x :: a
x (T_R (T_R b :: RB a
b y :: a
y c :: RB a
c) z :: a
z d :: RB a
d) = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_R (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b) a
y (RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
c a
z RB a
d)
rbalance a :: RB a
a x :: a
x b :: RB a
b = RB a -> a -> RB a -> RB a
forall a. RB a -> a -> RB a -> RB a
T_B RB a
a a
x RB a
b


-- | 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')]
zipWithLongest :: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c]
zipWithLongest :: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c]
zipWithLongest f :: Maybe a -> Maybe b -> c
f [] [] = []
zipWithLongest f :: Maybe a -> Maybe b -> c
f (x :: a
x:xs :: [a]
xs) (y :: b
y:ys :: [b]
ys) = Maybe a -> Maybe b -> c
f (a -> Maybe a
forall a. a -> Maybe a
Just a
x) (b -> Maybe b
forall a. a -> Maybe a
Just b
y) c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c]
forall a b c. (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c]
zipWithLongest Maybe a -> Maybe b -> c
f [a]
xs [b]
ys
zipWithLongest f :: Maybe a -> Maybe b -> c
f [] ys :: [b]
ys = (b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe a -> Maybe b -> c
f Maybe a
forall a. Maybe a
Nothing (Maybe b -> c) -> (b -> Maybe b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just) [b]
ys
zipWithLongest f :: Maybe a -> Maybe b -> c
f xs :: [a]
xs [] = (a -> c) -> [a] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe a -> Maybe b -> c
`f` Maybe b
forall a. Maybe a
Nothing) (Maybe a -> c) -> (a -> Maybe a) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) [a]
xs