{-# 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, compareLength, comparingLength, -- * Enum operations enumerate, -- * List operations groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, nubOn, groupOn, nubSort, nubSortBy, nubSortOn, maximumOn, minimumOn, sum', product', sumOn', productOn', 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 Data.Foldable 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 [a] -> (b, [a]) f [] = [] repeatedly [a] -> (b, [a]) f [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, [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 [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 a -> a -> Ordering cmp [a] xs [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 [a] _ [] = Bool False shorter [] [a] _ = Bool True shorter (a _:[a] xs) (a _:[a] ys) = [a] -> [a] -> Bool shorter [a] xs [a] ys go :: t a -> t a -> Bool go 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 -> 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 [a] seen (a x:[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 [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 (a x:[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 a d [] = a d headDef a _ (a x:[a] _) = 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 a d [a] xs = (a -> a -> a) -> a -> [a] -> a forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl (\a _ 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 b nil a -> [a] -> b cons [] = b nil list b nil a -> [a] -> b cons (a x:[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 [a x] = ([a], a) -> Maybe ([a], a) forall a. a -> Maybe a Just ([], a x) unsnoc (a x:[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] -> 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 [a] xs 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 Int i [a] xs | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0 = [] | Bool otherwise = [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 (a x:[a] xs) (a y:[a] ys) = [a] -> [a] -> [a] f [a] xs [a] ys f [a] xs [a] _ = [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 Int i [a] xs | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0 = [a] xs | Bool otherwise = [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 (a x:[a] xs) (a y:[a] ys) = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] -> [a] -> [a] f [a] xs [a] ys f [a] _ [a] _ = [] -- | @'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 Int i [a] xs | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0 = ([a] xs, []) | Bool otherwise = [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 (a x:[a] xs) (a y:[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 [a] xs [a] _ = ([], [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 a -> b -> c f 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 [([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,[[b]] b,[[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 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 == Char '\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>" == "<b>"g&t"</n>" -- > escapeHTML "t'was another test" == "t'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 Char '>' = String ">" f Char '<' = String "<" f Char '&' = String "&" f Char '\"' = String """ f Char '\'' = String "'" f 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 (Char '&':String xs) | Just String xs <- String -> String -> Maybe String forall a. Eq a => [a] -> [a] -> Maybe [a] stripPrefix String "lt;" String xs = Char '<' Char -> String -> String forall a. a -> [a] -> [a] : String -> String unescapeHTML String xs | Just String xs <- String -> String -> Maybe String forall a. Eq a => [a] -> [a] -> Maybe [a] stripPrefix String "gt;" String xs = Char '>' Char -> String -> String forall a. a -> [a] -> [a] : String -> String unescapeHTML String xs | Just String xs <- String -> String -> Maybe String forall a. Eq a => [a] -> [a] -> Maybe [a] stripPrefix String "amp;" String xs = Char '&' Char -> String -> String forall a. a -> [a] -> [a] : String -> String unescapeHTML String xs | Just String xs <- String -> String -> Maybe String forall a. Eq a => [a] -> [a] -> Maybe [a] stripPrefix String "quot;" String xs = Char '\"' Char -> String -> String forall a. a -> [a] -> [a] : String -> String unescapeHTML String xs | Just String xs <- String -> String -> Maybe String forall a. Eq a => [a] -> [a] -> Maybe [a] stripPrefix String "#39;" String xs = Char '\'' Char -> String -> String forall a. a -> [a] -> [a] : String -> String unescapeHTML String xs unescapeHTML (Char x: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 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 Char '\"' = String "\\\"" f Char '\\' = String "\\\\" -- the spaces are technically optional, but we include them so the JSON is readable f Char '\b' = String "\\b" f Char '\f' = String "\\f" f Char '\n' = String "\\n" f Char '\r' = String "\\r" f Char '\t' = String "\\t" f Char x | Char -> Bool isControl Char x = String "\\u" String -> String -> String forall a. [a] -> [a] -> [a] ++ Int -> String -> String forall a. Int -> [a] -> [a] takeEnd Int 4 (String "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) String "") f 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 (Char '\\':Char x:String xs) | Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\"' = Char '\"' 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 '\\' = Char '\\' 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 '/' = Char '/' 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 'b' = Char '\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 == Char 'f' = Char '\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 == Char 'n' = Char '\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 == Char 'r' = Char '\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 == Char 't' = Char '\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 == Char 'u', let (String a,String b) = Int -> String -> (String, String) forall a. Int -> [a] -> ([a], [a]) splitAt Int 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 == Int 4, [(Int i, String "")] <- 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 (Char x: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 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` p -> t f = \p x -> let fx :: t fx = p -> t f p x in \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 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 (\a x -> let y :: b y = a -> b f a x in b y b -> (b, a) -> (b, a) `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 a -> b f [] = String -> a forall a. HasCallStack => String -> a error String "Data.List.Extra.maximumOn: empty list" maximumOn a -> b f (a x:[a] xs) = a -> b -> [a] -> a g a x (a -> b f a x) [a] xs where g :: a -> b -> [a] -> a g a v b mv [] = a v g a v b mv (a x:[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 a -> b f [] = String -> a forall a. HasCallStack => String -> a error String "Data.List.Extra.minimumOn: empty list" minimumOn a -> b f (a x:[a] xs) = a -> b -> [a] -> a g a x (a -> b f a x) [a] xs where g :: a -> b -> [a] -> a g a v b mv [] = a v g a v b mv (a x:[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 (\[(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 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 a -> a -> Ordering f = (a -> a -> Bool) -> [a] -> [[a]] forall a. (a -> a -> Bool) -> [a] -> [[a]] groupBy (\a a 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 -- | A strict version of 'sum'. -- Unlike 'sum' this function is always strict in the `Num` argument, -- whereas the standard version is only strict if the optimiser kicks in. -- -- > sum' [1, 2, 3] == 6 sum' :: (Num a) => [a] -> a sum' :: [a] -> a sum' = (a -> a -> a) -> a -> [a] -> a forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' a -> a -> a forall a. Num a => a -> a -> a (+) a 0 -- | A strict version of 'sum', using a custom valuation function. -- -- > sumOn' read ["1", "2", "3"] == 6 sumOn' :: (Num b) => (a -> b) -> [a] -> b sumOn' :: (a -> b) -> [a] -> b sumOn' a -> b f = (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (\b acc a x -> b acc b -> b -> b forall a. Num a => a -> a -> a + a -> b f a x) b 0 -- | A strict version of 'product'. -- -- > product' [1, 2, 4] == 8 product' :: (Num a) => [a] -> a product' :: [a] -> a product' = (a -> a -> a) -> a -> [a] -> a forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' a -> a -> a forall a. Num a => a -> a -> a (*) a 1 -- | A strict version of 'product', using a custom valuation function. -- -- > productOn' read ["1", "2", "4"] == 8 productOn' :: (Num b) => (a -> b) -> [a] -> b productOn' :: (a -> b) -> [a] -> b productOn' a -> b f = (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (\b acc a x -> b acc b -> b -> b forall a. Num a => a -> a -> a * a -> b f a x) b 1 -- | 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 a -> a -> Ordering f [a] xs [] = [a] xs mergeBy a -> a -> Ordering f [] [a] ys = [a] ys mergeBy a -> a -> Ordering f (a x:[a] xs) (a y:[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 [] [a] _ [a] _ = String -> [a] forall a. HasCallStack => String -> a error String "Extra.replace, first argument cannot be empty" replace [a] from [a] to [a] xs | Just [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 [a] from [a] to (a x:[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 [a] from [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 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 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 a -> Bool f [a] s = case (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] dropWhile a -> Bool f [a] s of [] -> [] a x:[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 ([a] w,[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 a -> Bool f [] = [] linesBy a -> Bool f [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 ([a] l, [a] s) -> ([a] l,) ([[a]] -> ([a], [[a]])) -> [[a]] -> ([a], [[a]]) forall a b. (a -> b) -> a -> b $ case [a] s of [] -> [] a _:[a] s -> (a -> Bool) -> [a] -> [[a]] forall a. (a -> Bool) -> [a] -> [[a]] linesBy a -> Bool f [a] s where cons :: (a, [a]) -> [a] cons ~(a h, [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 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 (a x:[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 (a x:[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 (\a z a -> [a] f 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 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 [a] needle [a] haystack | [a] needle [a] -> [a] -> Bool forall a. Eq a => [a] -> [a] -> Bool `isPrefixOf` [a] haystack = ([], [a] haystack) breakOn [a] needle [] = ([], []) breakOn [a] needle (a x:[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 [a] needle [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 [] [a] _ = String -> [[a]] forall a. HasCallStack => String -> a error String "splitOn, needle may not be empty" splitOn [a] _ [] = [[]] splitOn [a] needle [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] -> [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 a -> Bool f [] = [[]] split a -> Bool f (a x:[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 a -> Bool f (a x:[a] xs) | [a] y:[[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' a -> Bool p = (a -> [a] -> [a]) -> [a] -> [a] -> [a] forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (\a x [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] -> 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] -> 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] -> [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 [a] needle [a] haystack | Just [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 [a] needle [] = Maybe ([a], [a]) forall a. Maybe a Nothing stripInfix [a] needle (a x:[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 [a] needle [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 Int i [a] xs | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0 = String -> [[a]] forall a. HasCallStack => String -> a error (String -> [[a]]) -> String -> [[a]] forall a b. (a -> b) -> a -> b $ String "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 Int i [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 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 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 (a x1:a x2:[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 (a x:[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 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 a -> a -> Ordering cmp [a] xs = RB a -> [a] -> [a] f RB a forall a. RB a E [a] xs where f :: RB a -> [a] -> [a] f RB a seen [] = [] f RB a seen (a x:[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 a -> a -> Ordering cmp a x RB a s = case RB a -> RB a ins RB a s of T_R RB a a a z 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 RB a x -> RB a x where ins :: RB a -> RB a ins RB a 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 RB a a a y RB a b) = case a -> a -> Ordering cmp a x a y of Ordering 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 Ordering 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) Ordering EQ -> RB a s ins s :: RB a s@(T_R RB a a a y RB a b) = case a -> a -> Ordering cmp a x a y of Ordering 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 Ordering 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) Ordering EQ -> RB a s memberRB :: (a -> a -> Ordering) -> a -> RB a -> Bool memberRB :: (a -> a -> Ordering) -> a -> RB a -> Bool memberRB a -> a -> Ordering cmp a x RB a E = Bool False memberRB a -> a -> Ordering cmp a x (T_R RB a a a y RB a b) = case a -> a -> Ordering cmp a x a y of Ordering 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 Ordering 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 Ordering EQ -> Bool True memberRB a -> a -> Ordering cmp a x (T_B RB a a a y RB a b) = case a -> a -> Ordering cmp a x a y of Ordering 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 Ordering 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 Ordering 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 RB a a a x RB a b) a y (T_R RB a c a z 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 RB a a a x RB a b) a y RB a c) a z 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 RB a a a x (T_R RB a b a y RB a c)) a z 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 RB a a a x 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 RB a a a x RB a b) a y (T_R RB a c a z 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 RB a a a x (T_R RB a b a y (T_R RB a c a z 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 RB a a a x (T_R (T_R RB a b a y RB a c) a z 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 RB a a a x 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 Maybe a -> Maybe b -> c f [] [] = [] zipWithLongest Maybe a -> Maybe b -> c f (a x:[a] xs) (b y:[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 Maybe a -> Maybe b -> c f [] [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 Maybe a -> Maybe b -> c f [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 -- | 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 compareLength :: (Ord b, Num b, Foldable f) => f a -> b -> Ordering compareLength :: f a -> b -> Ordering compareLength = (a -> (b -> Ordering) -> b -> Ordering) -> (b -> Ordering) -> f a -> b -> Ordering forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (\a _ b -> Ordering acc b n -> if b n b -> b -> Bool forall a. Ord a => a -> a -> Bool > b 0 then b -> Ordering acc (b n b -> b -> b forall a. Num a => a -> a -> a - b 1) else Ordering GT) (b -> b -> Ordering forall a. Ord a => a -> a -> Ordering compare b 0) -- | Lazily compare the length of two 'Foldable's. -- > comparingLength [1,2,3] [False] == GT -- > comparingLength [1,2] "ab" == EQ -- > \(xs :: [Int]) (ys :: [Int]) -> comparingLength xs ys == Data.Ord.comparing length xs ys -- > comparingLength [1,2] (1:2:3:undefined) == LT -- > comparingLength (1:2:3:undefined) [1,2] == GT comparingLength :: (Foldable f1, Foldable f2) => f1 a -> f2 b -> Ordering comparingLength :: f1 a -> f2 b -> Ordering comparingLength f1 a x f2 b y = [a] -> [b] -> Ordering forall a a. [a] -> [a] -> Ordering go (f1 a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList f1 a x) (f2 b -> [b] forall (t :: * -> *) a. Foldable t => t a -> [a] toList f2 b y) where go :: [a] -> [a] -> Ordering go [] [] = Ordering EQ go [] (a _:[a] _) = Ordering LT go (a _:[a] _) [] = Ordering GT go (a _:[a] xs) (a _:[a] ys) = [a] -> [a] -> Ordering go [a] xs [a] ys