-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE BangPatterns #-}
module Util.Seq where
import           Prelude hiding (head, last, tail)
import qualified Data.Algorithm.Diff as Diff
import           Data.Bifunctor (first, second, Bifunctor(bimap))
import qualified Data.Char as Char
import qualified Data.Either as Either
import           Data.Function (on)
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.Ordered as Ordered
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Ord as Ord
import qualified Data.Set as Set

import qualified Util.Then as Then


-- | This is just a list, but is documentation that a return value will never
-- be null, or an argument should never be null.  This is for cases where
-- 'NonEmpty' is too annoying to work with.
type NonNull a = [a]

-- * enumeration

enumerate :: [a] -> [(Int, a)]
enumerate :: forall a. [a] -> [(Int, a)]
enumerate = [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]

-- | Enumerate an inclusive range.  Uses multiplication instead of successive
-- addition to avoid loss of precision.
--
-- Also it doesn't require an Enum instance.
range :: (Num a, Ord a) => a -> a -> a -> [a]
range :: forall a. (Num a, Ord a) => a -> a -> a -> [a]
range a
start a
end a
step = a -> [a]
go a
0
    where
    go :: a -> [a]
go a
i
        | a
step a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
end = []
        | a
step a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
end = []
        | Bool
otherwise = a
val a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1)
        where val :: a
val = a
start a -> a -> a
forall a. Num a => a -> a -> a
+ (a
ia -> a -> a
forall a. Num a => a -> a -> a
*a
step)
{-# INLINEABLE range #-}
{-# SPECIALIZE range :: Int -> Int -> Int -> [Int] #-}

-- | Enumerate a half-open range.
range' :: (Num a, Ord a) => a -> a -> a -> [a]
range' :: forall a. (Num a, Ord a) => a -> a -> a -> [a]
range' a
start a
end a
step = a -> [a]
go a
0
    where
    go :: a -> [a]
go a
i
        | a
step a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
end = []
        | a
step a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
end = []
        | Bool
otherwise = a
val a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1)
        where val :: a
val = a
start a -> a -> a
forall a. Num a => a -> a -> a
+ (a
ia -> a -> a
forall a. Num a => a -> a -> a
*a
step)
{-# INLINEABLE range' #-}
{-# SPECIALIZE range' :: Int -> Int -> Int -> [Int] #-}

-- | Like 'range', but always includes the end, even if it doesn't line up on
-- a step.
range_end :: (Num a, Ord a) => a -> a -> a -> [a]
range_end :: forall a. (Num a, Ord a) => a -> a -> a -> [a]
range_end a
start a
end a
step = a -> [a]
go a
0
    where
    go :: a -> [a]
go a
i
        | a
step a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
end = [a
end]
        | a
step a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
end = [a
end]
        | Bool
otherwise = a
val a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1)
        where val :: a
val = a
start a -> a -> a
forall a. Num a => a -> a -> a
+ (a
ia -> a -> a
forall a. Num a => a -> a -> a
*a
step)
{-# INLINEABLE range_end #-}
{-# SPECIALIZE range_end :: Int -> Int -> Int -> [Int] #-}

-- | Infinite range.
range_ :: Num a => a -> a -> [a]
range_ :: forall a. Num a => a -> a -> [a]
range_ a
start a
step = a -> [a]
go a
0
    where go :: a -> [a]
go a
i = a
start a -> a -> a
forall a. Num a => a -> a -> a
+ (a
ia -> a -> a
forall a. Num a => a -> a -> a
*a
step) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1)
{-# INLINEABLE range_ #-}
{-# SPECIALIZE range_ :: Int -> Int -> [Int] #-}

-- * transformation

key_on :: (a -> k) -> [a] -> [(k, a)]
key_on :: forall a k. (a -> k) -> [a] -> [(k, a)]
key_on a -> k
f [a]
xs = [k] -> [a] -> [(k, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> k) -> [a] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map a -> k
f [a]
xs) [a]
xs

key_on_snd :: (a -> k) -> [a] -> [(a, k)]
key_on_snd :: forall a k. (a -> k) -> [a] -> [(a, k)]
key_on_snd a -> k
f [a]
xs = [a] -> [k] -> [(a, k)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ((a -> k) -> [a] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map a -> k
f [a]
xs)

key_on_just :: (a -> Maybe k) -> [a] -> [(k, a)]
key_on_just :: forall a k. (a -> Maybe k) -> [a] -> [(k, a)]
key_on_just a -> Maybe k
f [a]
xs = [(k
k, a
a) | (Just k
k, a
a) <- (a -> Maybe k) -> [a] -> [(Maybe k, a)]
forall a k. (a -> k) -> [a] -> [(k, a)]
key_on a -> Maybe k
f [a]
xs]

-- | Apply a function to the first and last elements.  Middle elements are
-- unchanged.  A null or singleton list is also unchanged.
first_last :: (a -> a) -> (a -> a) -> [a] -> [a]
first_last :: forall a. (a -> a) -> (a -> a) -> [a] -> [a]
first_last a -> a
start a -> a
end [a]
xs = case [a]
xs of
    [] -> []
    [a
x] -> [a
x]
    a
x : [a]
xs -> a -> a
start a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs
    where
    go :: [a] -> [a]
go [] = []
    go [a
x] = [a -> a
end a
x]
    go (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs

-- | Filter on the fst values returning Just.
map_maybe_fst :: (a -> Maybe a2) -> [(a, b)] -> [(a2, b)]
map_maybe_fst :: forall a a2 b. (a -> Maybe a2) -> [(a, b)] -> [(a2, b)]
map_maybe_fst a -> Maybe a2
f [(a, b)]
xs = [(a2
a, b
b) | (Just a2
a, b
b) <- ((a, b) -> (Maybe a2, b)) -> [(a, b)] -> [(Maybe a2, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Maybe a2) -> (a, b) -> (Maybe a2, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> Maybe a2
f) [(a, b)]
xs]

-- | Filter on the snd values returning Just.
map_maybe_snd :: (b -> Maybe b2) -> [(a, b)] -> [(a, b2)]
map_maybe_snd :: forall b b2 a. (b -> Maybe b2) -> [(a, b)] -> [(a, b2)]
map_maybe_snd b -> Maybe b2
f [(a, b)]
xs = [(a
a, b2
b) | (a
a, Just b2
b) <- ((a, b) -> (a, Maybe b2)) -> [(a, b)] -> [(a, Maybe b2)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Maybe b2) -> (a, b) -> (a, Maybe b2)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> Maybe b2
f) [(a, b)]
xs]

map_head :: (a -> a) -> [a] -> [a]
map_head :: forall a. (a -> a) -> [a] -> [a]
map_head a -> a
_ [] = []
map_head a -> a
f (a
x:[a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

map_tail :: (a -> a) -> [a] -> [a]
map_tail :: forall a. (a -> a) -> [a] -> [a]
map_tail a -> a
f (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
xs
map_tail a -> a
_ [] = []

map_head_tail :: (a -> b) -> (a -> b) -> [a] -> [b]
map_head_tail :: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
map_head_tail a -> b
f a -> b
g (a
x : [a]
xs) = a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
g [a]
xs
map_head_tail a -> b
_ a -> b
_ [] = []

map_init :: (a -> a) -> [a] -> [a]
map_init :: forall a. (a -> a) -> [a] -> [a]
map_init a -> a
_ [] = []
map_init a -> a
_ [a
x] = [a
x]
map_init a -> a
f (a
x:[a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
forall a. (a -> a) -> [a] -> [a]
map_init a -> a
f [a]
xs

map_last :: (a -> a) -> [a] -> [a]
map_last :: forall a. (a -> a) -> [a] -> [a]
map_last a -> a
_ [] = []
map_last a -> a
f [a
x] = [a -> a
f a
x]
map_last a -> a
f (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
forall a. (a -> a) -> [a] -> [a]
map_last a -> a
f [a]
xs

-- | This is like 'scanl', but you can scan with a key function.  E.g. to
-- accumulate line lengths: @scanl_on length (+) 0@.
scanl_on :: (accum -> key -> accum) -> (a -> key) -> accum -> [a]
    -> [(accum, a)]
scanl_on :: forall accum key a.
(accum -> key -> accum)
-> (a -> key) -> accum -> [a] -> [(accum, a)]
scanl_on accum -> key -> accum
f a -> key
key accum
z [a]
xs = [accum] -> [a] -> [(accum, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((accum -> a -> accum) -> accum -> [a] -> [accum]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\accum
t -> accum -> key -> accum
f accum
t (key -> accum) -> (a -> key) -> a -> accum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> key
key) accum
z [a]
xs) [a]
xs

-- * permutations

-- | The cartesian product of a list of lists.  E.g.
-- @[[1, 2], [3, 4]]@ -> @[[1, 3], [1, 4], [2, 3], [2, 4]]@.
cartesian :: [[a]] -> [[a]]
cartesian :: forall a. [[a]] -> [[a]]
cartesian [] = []
cartesian [[a]
xs] = [[a
x] | a
x <- [a]
xs]
cartesian ([a]
xs:[[a]]
rest) = [a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ps | a
x <- [a]
xs, [a]
ps <- [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
cartesian [[a]]
rest]

-- * indexing lists

-- | Get @xs !! n@, but return Nothing if the index is out of range.
at :: [a] -> Int -> Maybe a
at :: forall a. [a] -> Int -> Maybe a
at [a]
xs Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = [a] -> Int -> Maybe a
forall {t} {a}. (Eq t, Num t) => [a] -> t -> Maybe a
go [a]
xs Int
n
    where
    go :: [a] -> t -> Maybe a
go [] t
_ = Maybe a
forall a. Maybe a
Nothing
    go (a
x:[a]
_) t
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    go (a
_:[a]
xs) t
n = [a] -> t -> Maybe a
go [a]
xs (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)

-- | Insert @x@ into @xs@ at index @i@.  If @i@ is out of range, insert at the
-- beginning or end of the list.
insert_at :: Int -> a -> [a] -> [a]
insert_at :: forall a. Int -> a -> [a] -> [a]
insert_at Int
i a
x [a]
xs = let ([a]
pre, [a]
post) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs in [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
post)

-- | Remove the element at the given index.  Do nothing if the index is out
-- of range.
remove_at :: Int -> [a] -> [a]
remove_at :: forall a. Int -> [a] -> [a]
remove_at Int
i [a]
xs = let ([a]
pre, [a]
post) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs in [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
post

-- | Like 'remove_at' but return the removed element as well.
take_at :: Int -> [a] -> Maybe (a, [a])
take_at :: forall a. Int -> [a] -> Maybe (a, [a])
take_at Int
i [a]
xs = case [a]
post of
        a
v : [a]
vs -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
v, [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
vs)
        [] -> Maybe (a, [a])
forall a. Maybe a
Nothing
    where ([a]
pre, [a]
post) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs

-- | Modify element at an index by applying a function to it.  If the index is
-- out of range, nothing happens.
modify_at :: Int -> (a -> a) -> [a] -> [a]
modify_at :: forall a. Int -> (a -> a) -> [a] -> [a]
modify_at Int
i a -> a
f [a]
xs = case [a]
post of
    [] -> [a]
pre
    a
elt : [a]
rest -> [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> a
f a
elt a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
    where ([a]
pre, [a]
post) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs

-- | Find an element, then change it.  Return Nothing if the element wasn't
-- found.
find_modify :: (a -> Bool) -> (a -> a) -> [a] -> Maybe [a]
find_modify :: forall a. (a -> Bool) -> (a -> a) -> [a] -> Maybe [a]
find_modify a -> Bool
match a -> a
modify = [a] -> Maybe [a]
go
    where
    go :: [a] -> Maybe [a]
go (a
x:[a]
xs)
        | a -> Bool
match a
x = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ a -> a
modify a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
        | Bool
otherwise = (a
x:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe [a]
go [a]
xs
    go [] = Maybe [a]
forall a. Maybe a
Nothing

-- | Similar to 'modify_at', but will insert an element for an out of range
-- positive index.  The list will be extended with @deflt@, and the modify
-- function passed a Nothing.
update_at :: a -> Int -> (Maybe a -> a) -> [a] -> [a]
update_at :: forall a. a -> Int -> (Maybe a -> a) -> [a] -> [a]
update_at a
deflt Int
i Maybe a -> a
f [a]
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [a]) -> [Char] -> [a]
forall a b. (a -> b) -> a -> b
$ [Char]
"Seq.update_at: negative index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
    | Bool
otherwise = Int -> [a] -> [a]
forall {t}. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [a]
xs
    where
    go :: t -> [a] -> [a]
go t
0 [] = [Maybe a -> a
f Maybe a
forall a. Maybe a
Nothing]
    go t
0 (a
x:[a]
xs) = Maybe a -> a
f (a -> Maybe a
forall a. a -> Maybe a
Just a
x) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    go t
i [] = a
deflt a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) []
    go t
i (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs

-- | Move an element from one index to another, or Nothing if the @from@
-- index was out of range.
move :: Int -> Int -> [a] -> Maybe [a]
move :: forall a. Int -> Int -> [a] -> Maybe [a]
move Int
from Int
to [a]
xs = do
    (a
x, [a]
dropped) <- Int -> [a] -> Maybe (a, [a])
forall a. Int -> [a] -> Maybe (a, [a])
take_at Int
from [a]
xs
    [a] -> Maybe [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
insert_at Int
to a
x [a]
dropped


-- * min / max

min_on :: Ord k => (a -> k) -> a -> a -> a
min_on :: forall k a. Ord k => (a -> k) -> a -> a -> a
min_on a -> k
key a
x a
y = if a -> k
key a
x k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> k
key a
y then a
x else a
y

max_on :: Ord k => (a -> k) -> a -> a -> a
max_on :: forall k a. Ord k => (a -> k) -> a -> a -> a
max_on a -> k
key a
x a
y = if a -> k
key a
x k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> k
key a
y then a
x else a
y

minimum_on :: Ord k => (a -> k) -> [a] -> Maybe a
minimum_on :: forall k a. Ord k => (a -> k) -> [a] -> Maybe a
minimum_on a -> k
_ [] = Maybe a
forall a. Maybe a
Nothing
minimum_on a -> k
key [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ((a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
List.foldl1' a -> a -> a
f [a]
xs)
    where f :: a -> a -> a
f a
low a
x = if a -> k
key a
x k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< a -> k
key a
low then a
x else a
low

maximum_on :: Ord k => (a -> k) -> [a] -> Maybe a
maximum_on :: forall k a. Ord k => (a -> k) -> [a] -> Maybe a
maximum_on a -> k
_ [] = Maybe a
forall a. Maybe a
Nothing
maximum_on a -> k
key [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ((a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
List.foldl1' a -> a -> a
f [a]
xs)
    where f :: a -> a -> a
f a
high a
x = if a -> k
key a
x k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> a -> k
key a
high then a
x else a
high

minimum :: Ord a => [a] -> Maybe a
minimum :: forall a. Ord a => [a] -> Maybe a
minimum [] = Maybe a
forall a. Maybe a
Nothing
minimum [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.minimum [a]
xs)

maximum :: Ord a => [a] -> Maybe a
maximum :: forall a. Ord a => [a] -> Maybe a
maximum [] = Maybe a
forall a. Maybe a
Nothing
maximum [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum [a]
xs)

ne_minimum :: Ord a => NonEmpty a -> a
ne_minimum :: forall a. Ord a => NonEmpty a -> a
ne_minimum (a
x :| [a]
xs) = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.minimum (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

ne_maximum :: Ord a => NonEmpty a -> a
ne_maximum :: forall a. Ord a => NonEmpty a -> a
ne_maximum (a
x :| [a]
xs) = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

-- * ordered lists

insert_on :: Ord k => (a -> k) -> a -> [a] -> [a]
insert_on :: forall k a. Ord k => (a -> k) -> a -> [a] -> [a]
insert_on a -> k
key = (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy (\a
a a
b -> k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> k
key a
a) (a -> k
key a
b))

-- | Stable sort on a cheap key function.  Different from 'List.sortOn', which
-- is for an expensive key function.
sort_on :: Ord k => (a -> k) -> [a] -> [a]
sort_on :: forall k a. Ord k => (a -> k) -> [a] -> [a]
sort_on = (a -> k) -> [a] -> [a]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Ordered.sortOn'

-- | Like 'sort_on', but sort highest-to-lowest.
reverse_sort_on :: Ord b => (a -> b) -> [a] -> [a]
reverse_sort_on :: forall k a. Ord k => (a -> k) -> [a] -> [a]
reverse_sort_on a -> b
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((a -> a -> Ordering) -> [a] -> [a])
-> (a -> a -> Ordering) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ \a
a a
b -> (a -> b) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing a -> b
f a
b a
a

-- | Merge sorted lists.  If two elements compare equal, the one from the left
-- list comes first.
merge :: Ord a => [a] -> [a] -> [a]
merge :: forall a. Ord a => [a] -> [a] -> [a]
merge = (a -> a) -> [a] -> [a] -> [a]
forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
merge_on a -> a
forall a. a -> a
id

merge_by :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
merge_by :: forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
merge_by = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
Ordered.mergeBy

merge_on :: Ord k => (a -> k) -> [a] -> [a] -> [a]
merge_on :: forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
merge_on a -> k
key = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
Ordered.mergeBy ((a -> k) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing a -> k
key)

merge_lists :: Ord k => (a -> k) -> [[a]] -> [a]
merge_lists :: forall k a. Ord k => (a -> k) -> [[a]] -> [a]
merge_lists a -> k
key = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> k) -> [a] -> [a] -> [a]
forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
merge_on a -> k
key) []

-- | If the heads of the sublists are also sorted I can be lazy in the list of
-- sublists too.  This version is optimized for minimal overlap.
merge_asc_lists :: Ord k => (a -> k) -> [[a]] -> [a]
merge_asc_lists :: forall k a. Ord k => (a -> k) -> [[a]] -> [a]
merge_asc_lists a -> k
key = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a] -> [a] -> [a]
go []
    where
    go :: [a] -> [a] -> [a]
go [] [a]
ys = [a]
ys
    go (a
x:[a]
xs) [a]
ys = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> k) -> [a] -> [a] -> [a]
forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
merge_on a -> k
key [a]
xs [a]
ys

-- * grouping

-- ** adjacent

-- Adjacent groups only group adjacent elements, just like 'List.group'.

-- | This is just 'List.groupBy' except with a key function.
group_adjacent :: Eq key => (a -> key) -> [a] -> [NonNull a]
group_adjacent :: forall key a. Eq key => (a -> key) -> [a] -> [[a]]
group_adjacent a -> key
key = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (key -> key -> Bool
forall a. Eq a => a -> a -> Bool
(==) (key -> key -> Bool) -> (a -> key) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> key
key)

-- | Like 'group_adjacent', but include the key.
keyed_group_adjacent :: Eq key => (a -> key) -> [a] -> [(key, NonNull a)]
keyed_group_adjacent :: forall key a. Eq key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_adjacent a -> key
key =
    (NonNull a -> key) -> [NonNull a] -> [(key, NonNull a)]
forall a k. (a -> k) -> [a] -> [(k, a)]
key_on (a -> key
key (a -> key) -> (NonNull a -> a) -> NonNull a -> key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNull a -> a
forall a. [a] -> a
List.head) ([NonNull a] -> [(key, NonNull a)])
-> (NonNull a -> [NonNull a]) -> NonNull a -> [(key, NonNull a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> NonNull a -> [NonNull a]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (key -> key -> Bool
forall a. Eq a => a -> a -> Bool
(==) (key -> key -> Bool) -> (a -> key) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> key
key)

group_adjacent_fst :: Eq a => [(a, b)] -> [(a, NonNull b)]
group_adjacent_fst :: forall a b. Eq a => [(a, b)] -> [(a, NonNull b)]
group_adjacent_fst [(a, b)]
xs =
    [(a
key, ((a, b) -> b) -> [(a, b)] -> NonNull b
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
group) | (a
key, [(a, b)]
group) <- ((a, b) -> a) -> [(a, b)] -> [(a, [(a, b)])]
forall key a. Eq key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_adjacent (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
xs]

group_adjacent_snd :: Eq b => [(a, b)] -> [(NonNull a, b)]
group_adjacent_snd :: forall b a. Eq b => [(a, b)] -> [(NonNull a, b)]
group_adjacent_snd [(a, b)]
xs =
    [(((a, b) -> a) -> [(a, b)] -> NonNull a
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
group, b
key) | (b
key, [(a, b)]
group) <- ((a, b) -> b) -> [(a, b)] -> [(b, [(a, b)])]
forall key a. Eq key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_adjacent (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
xs]

-- ** sort

-- Sort groups sort the input by the group key as a side-effect of grouping.

-- | Group the unsorted list into @(key x, xs)@ where all @xs@ compare equal
-- after @key@ is applied to them.
keyed_group_sort :: Ord key => (a -> key) -> [a] -> [(key, NonNull a)]
    -- ^ Sorted by key. The NonNull group is in the same order as the input.
keyed_group_sort :: forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_sort a -> key
key = Map key (NonNull a) -> [(key, NonNull a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map key (NonNull a) -> [(key, NonNull a)])
-> (NonNull a -> Map key (NonNull a))
-> NonNull a
-> [(key, NonNull a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Map key (NonNull a) -> Map key (NonNull a))
-> Map key (NonNull a) -> NonNull a -> Map key (NonNull a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Map key (NonNull a) -> Map key (NonNull a)
go Map key (NonNull a)
forall k a. Map k a
Map.empty
    where go :: a -> Map key (NonNull a) -> Map key (NonNull a)
go a
x = (Maybe (NonNull a) -> Maybe (NonNull a))
-> key -> Map key (NonNull a) -> Map key (NonNull a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (NonNull a -> Maybe (NonNull a)
forall a. a -> Maybe a
Just (NonNull a -> Maybe (NonNull a))
-> (Maybe (NonNull a) -> NonNull a)
-> Maybe (NonNull a)
-> Maybe (NonNull a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNull a
-> (NonNull a -> NonNull a) -> Maybe (NonNull a) -> NonNull a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a
x] (a
x:)) (a -> key
key a
x)

-- | Similar to 'keyed_group_sort', but key on the fst element, and strip the
-- key out of the groups.
group_fst :: Ord a => [(a, b)] -> [(a, NonNull b)]
group_fst :: forall a b. Ord a => [(a, b)] -> [(a, NonNull b)]
group_fst [(a, b)]
xs = [(a
key, ((a, b) -> b) -> [(a, b)] -> NonNull b
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
group) | (a
key, [(a, b)]
group) <- ((a, b) -> a) -> [(a, b)] -> [(a, [(a, b)])]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_sort (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
xs]

-- | Like 'group_fst', but group on the snd element.
group_snd :: Ord b => [(a, b)] -> [(NonNull a, b)]
group_snd :: forall b a. Ord b => [(a, b)] -> [(NonNull a, b)]
group_snd [(a, b)]
xs = [(((a, b) -> a) -> [(a, b)] -> NonNull a
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
group, b
key) | (b
key, [(a, b)]
group) <- ((a, b) -> b) -> [(a, b)] -> [(b, [(a, b)])]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_sort (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
xs]

-- | Like 'List.groupBy', but the list doesn't need to be sorted, and use a key
-- function instead of equality.  The list is sorted by the key, and the groups
-- appear in their original order in the input list.
group_sort :: Ord key => (a -> key) -> [a] -> [NonNull a]
group_sort :: forall key a. Ord key => (a -> key) -> [a] -> [[a]]
group_sort a -> key
key = ((key, NonNull a) -> NonNull a)
-> [(key, NonNull a)] -> [NonNull a]
forall a b. (a -> b) -> [a] -> [b]
map (key, NonNull a) -> NonNull a
forall a b. (a, b) -> b
snd ([(key, NonNull a)] -> [NonNull a])
-> (NonNull a -> [(key, NonNull a)]) -> NonNull a -> [NonNull a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> key) -> NonNull a -> [(key, NonNull a)]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_sort a -> key
key

-- ** stable

-- Stable groups preserve the original input order, in both the heads of the
-- groups, and within the groups themselves.

-- | Group each element with all the other elements that compare equal to it.
-- The heads of the groups appear in their original order.
group_stable_with :: (a -> a -> Bool) -> [a] -> [NonEmpty a]
group_stable_with :: forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
group_stable_with a -> a -> Bool
is_equal = [a] -> [NonEmpty a]
go
    where
    go :: [a] -> [NonEmpty a]
go [] = []
    go (a
x:[a]
xs) = (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
equal) NonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
: [a] -> [NonEmpty a]
go [a]
inequal
        where ([a]
equal, [a]
inequal) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (a -> a -> Bool
is_equal a
x) [a]
xs

-- | 'group_stable_with' but with a key function.
group_stable :: Eq key => (a -> key) -> [a] -> [NonEmpty a]
group_stable :: forall key a. Eq key => (a -> key) -> [a] -> [NonEmpty a]
group_stable a -> key
key = (a -> a -> Bool) -> [a] -> [NonEmpty a]
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
group_stable_with (\a
x a
y -> a -> key
key a
x key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== a -> key
key a
y)

keyed_group_stable :: Eq key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_stable :: forall key a. Eq key => (a -> key) -> [a] -> [(key, [a])]
keyed_group_stable a -> key
key = (NonEmpty a -> (key, [a])) -> [NonEmpty a] -> [(key, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
g :| [a]
gs) -> (a -> key
key a
g, a
ga -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
gs)) ([NonEmpty a] -> [(key, [a])])
-> ([a] -> [NonEmpty a]) -> [a] -> [(key, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> key) -> [a] -> [NonEmpty a]
forall key a. Eq key => (a -> key) -> [a] -> [NonEmpty a]
group_stable a -> key
key

-- * zipping

-- | Pair each element with the following element.  The last element is paired
-- with Nothing.  Like @zip xs (drop 1 xs ++ [Nothing])@ but only traverses
-- @xs@ once.
zip_next :: [a] -> [(a, Maybe a)]
zip_next :: forall a. [a] -> [(a, Maybe a)]
zip_next [] = []
zip_next [a
x] = [(a
x, Maybe a
forall a. Maybe a
Nothing)]
zip_next (a
x : xs :: [a]
xs@(a
y:[a]
_)) = (a
x, a -> Maybe a
forall a. a -> Maybe a
Just a
y) (a, Maybe a) -> [(a, Maybe a)] -> [(a, Maybe a)]
forall a. a -> [a] -> [a]
: [a] -> [(a, Maybe a)]
forall a. [a] -> [(a, Maybe a)]
zip_next [a]
xs

zip_nexts :: [a] -> [(a, [a])]
zip_nexts :: forall a. [a] -> [(a, [a])]
zip_nexts [a]
xs = [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs (Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
drop Int
1 ([a] -> [[a]]
forall a. [a] -> [[a]]
List.tails [a]
xs))

zip_prev :: [a] -> [(Maybe a, a)]
zip_prev :: forall a. [a] -> [(Maybe a, a)]
zip_prev [a]
xs = [Maybe a] -> [a] -> [(Maybe a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs) [a]
xs

-- | Like 'zip_next' but with both preceding and following elements.
zip_neighbors :: [a] -> [(Maybe a, a, Maybe a)]
zip_neighbors :: forall a. [a] -> [(Maybe a, a, Maybe a)]
zip_neighbors [] = []
zip_neighbors (a
x:[a]
xs) = (Maybe a
forall a. Maybe a
Nothing, a
x, [a] -> Maybe a
forall a. [a] -> Maybe a
head [a]
xs) (Maybe a, a, Maybe a)
-> [(Maybe a, a, Maybe a)] -> [(Maybe a, a, Maybe a)]
forall a. a -> [a] -> [a]
: a -> [a] -> [(Maybe a, a, Maybe a)]
forall {t}. t -> [t] -> [(Maybe t, t, Maybe t)]
go a
x [a]
xs
    where
    go :: t -> [t] -> [(Maybe t, t, Maybe t)]
go t
_ [] = []
    go t
prev [t
x] = [(t -> Maybe t
forall a. a -> Maybe a
Just t
prev, t
x, Maybe t
forall a. Maybe a
Nothing)]
    go t
prev (t
x : xs :: [t]
xs@(t
y:[t]
_)) = (t -> Maybe t
forall a. a -> Maybe a
Just t
prev, t
x, t -> Maybe t
forall a. a -> Maybe a
Just t
y) (Maybe t, t, Maybe t)
-> [(Maybe t, t, Maybe t)] -> [(Maybe t, t, Maybe t)]
forall a. a -> [a] -> [a]
: t -> [t] -> [(Maybe t, t, Maybe t)]
go t
x [t]
xs

-- | This is like 'zip', but it returns the remainder of the longer argument
-- instead of discarding it.
zip_remainder :: [a] -> [b] -> ([(a, b)], Either [a] [b])
zip_remainder :: forall a b. [a] -> [b] -> ([(a, b)], Either [a] [b])
zip_remainder (a
x:[a]
xs) (b
y:[b]
ys) = ([(a, b)] -> [(a, b)])
-> ([(a, b)], Either [a] [b]) -> ([(a, b)], Either [a] [b])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a
x, b
y) :) ([a] -> [b] -> ([(a, b)], Either [a] [b])
forall a b. [a] -> [b] -> ([(a, b)], Either [a] [b])
zip_remainder [a]
xs [b]
ys)
zip_remainder [] [b]
ys = ([], [b] -> Either [a] [b]
forall a b. b -> Either a b
Right [b]
ys)
zip_remainder [a]
xs [] = ([], [a] -> Either [a] [b]
forall a b. a -> Either a b
Left [a]
xs)

data Paired a b = First !a | Second !b | Both !a !b
    deriving (Int -> Paired a b -> [Char] -> [Char]
[Paired a b] -> [Char] -> [Char]
Paired a b -> [Char]
(Int -> Paired a b -> [Char] -> [Char])
-> (Paired a b -> [Char])
-> ([Paired a b] -> [Char] -> [Char])
-> Show (Paired a b)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
forall a b.
(Show a, Show b) =>
Int -> Paired a b -> [Char] -> [Char]
forall a b. (Show a, Show b) => [Paired a b] -> [Char] -> [Char]
forall a b. (Show a, Show b) => Paired a b -> [Char]
showList :: [Paired a b] -> [Char] -> [Char]
$cshowList :: forall a b. (Show a, Show b) => [Paired a b] -> [Char] -> [Char]
show :: Paired a b -> [Char]
$cshow :: forall a b. (Show a, Show b) => Paired a b -> [Char]
showsPrec :: Int -> Paired a b -> [Char] -> [Char]
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> Paired a b -> [Char] -> [Char]
Show, Paired a b -> Paired a b -> Bool
(Paired a b -> Paired a b -> Bool)
-> (Paired a b -> Paired a b -> Bool) -> Eq (Paired a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Paired a b -> Paired a b -> Bool
/= :: Paired a b -> Paired a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Paired a b -> Paired a b -> Bool
== :: Paired a b -> Paired a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Paired a b -> Paired a b -> Bool
Eq)

instance Bifunctor Paired where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Paired a c -> Paired b d
bimap a -> b
f c -> d
g Paired a c
paired = case Paired a c
paired of
        First a
a -> b -> Paired b d
forall a b. a -> Paired a b
First (a -> b
f a
a)
        Second c
b -> d -> Paired b d
forall a b. b -> Paired a b
Second (c -> d
g c
b)
        Both a
a c
b -> b -> d -> Paired b d
forall a b. a -> b -> Paired a b
Both (a -> b
f a
a) (c -> d
g c
b)

paired_second :: Paired a b -> Maybe b
paired_second :: forall a b. Paired a b -> Maybe b
paired_second (First a
_) = Maybe b
forall a. Maybe a
Nothing
paired_second (Second b
b) = b -> Maybe b
forall a. a -> Maybe a
Just b
b
paired_second (Both a
_ b
b) = b -> Maybe b
forall a. a -> Maybe a
Just b
b

paired_first :: Paired a b -> Maybe a
paired_first :: forall a b. Paired a b -> Maybe a
paired_first (First a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
paired_first (Second b
_) = Maybe a
forall a. Maybe a
Nothing
paired_first (Both a
a b
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

partition_paired :: [Paired a b] -> ([a], [b])
partition_paired :: forall a b. [Paired a b] -> ([a], [b])
partition_paired (Paired a b
pair : [Paired a b]
pairs) = case Paired a b
pair of
    Both a
a b
b -> (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as, b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs)
    First a
a -> (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as, [b]
bs)
    Second b
b -> ([a]
as, b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs)
    where ([a]
as, [b]
bs) = [Paired a b] -> ([a], [b])
forall a b. [Paired a b] -> ([a], [b])
partition_paired [Paired a b]
pairs
partition_paired [] = ([], [])

-- | Like 'zip', but emit 'First's or 'Second's if the list lengths are
-- unequal.
zip_padded :: [a] -> [b] -> [Paired a b]
zip_padded :: forall a b. [a] -> [b] -> [Paired a b]
zip_padded [] [] = []
zip_padded [] [b]
bs = (b -> Paired a b) -> [b] -> [Paired a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Paired a b
forall a b. b -> Paired a b
Second [b]
bs
zip_padded [a]
as [] = (a -> Paired a b) -> [a] -> [Paired a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Paired a b
forall a b. a -> Paired a b
First [a]
as
zip_padded (a
a:[a]
as) (b
b:[b]
bs) = a -> b -> Paired a b
forall a b. a -> b -> Paired a b
Both a
a b
b Paired a b -> [Paired a b] -> [Paired a b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [Paired a b]
forall a b. [a] -> [b] -> [Paired a b]
zip_padded [a]
as [b]
bs

-- | Like 'zip', but the first list is padded with Nothings.
zip_padded_fst :: [a] -> [b] -> [(Maybe a, b)]
zip_padded_fst :: forall a b. [a] -> [b] -> [(Maybe a, b)]
zip_padded_fst [a]
_ [] = []
zip_padded_fst (a
a:[a]
as) (b
b:[b]
bs) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
b) (Maybe a, b) -> [(Maybe a, b)] -> [(Maybe a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(Maybe a, b)]
forall a b. [a] -> [b] -> [(Maybe a, b)]
zip_padded_fst [a]
as [b]
bs
zip_padded_fst [] (b
b:[b]
bs) = (b -> (Maybe a, b)) -> [b] -> [(Maybe a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) Maybe a
forall a. Maybe a
Nothing) (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs)

-- | Like 'zip', but the second list is padded with Nothings.
zip_padded_snd :: [a] -> [b] -> [(a, Maybe b)]
zip_padded_snd :: forall a b. [a] -> [b] -> [(a, Maybe b)]
zip_padded_snd [] [b]
_ = []
zip_padded_snd (a
a:[a]
as) (b
b:[b]
bs) = (a
a, b -> Maybe b
forall a. a -> Maybe a
Just b
b) (a, Maybe b) -> [(a, Maybe b)] -> [(a, Maybe b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, Maybe b)]
forall a b. [a] -> [b] -> [(a, Maybe b)]
zip_padded_snd [a]
as [b]
bs
zip_padded_snd (a
a:[a]
as) [] = [(a
a, Maybe b
forall a. Maybe a
Nothing) | a
a <- a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as]

-- | Return the reversed inits paired with the tails.  This is like a zipper
-- moving focus along the input list.
zipper :: [a] -> [a] -> [([a], [a])]
zipper :: forall a. [a] -> [a] -> [([a], [a])]
zipper [a]
prev [] = [([a]
prev, [])]
zipper [a]
prev lst :: [a]
lst@(a
x:[a]
xs) = ([a]
prev, [a]
lst) ([a], [a]) -> [([a], [a])] -> [([a], [a])]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [([a], [a])]
forall a. [a] -> [a] -> [([a], [a])]
zipper (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
prev) [a]
xs

-- | Perform a Meyes diff.
diff :: (a -> b -> Bool) -> [a] -> [b] -> [Paired a b]
diff :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [Paired a b]
diff a -> b -> Bool
eq [a]
as [b]
bs = (PolyDiff a b -> Paired a b) -> [PolyDiff a b] -> [Paired a b]
forall a b. (a -> b) -> [a] -> [b]
map PolyDiff a b -> Paired a b
forall {a} {b}. PolyDiff a b -> Paired a b
convert ([PolyDiff a b] -> [Paired a b]) -> [PolyDiff a b] -> [Paired a b]
forall a b. (a -> b) -> a -> b
$ (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
Diff.getDiffBy a -> b -> Bool
eq [a]
as [b]
bs
    where
    convert :: PolyDiff a b -> Paired a b
convert PolyDiff a b
a = case PolyDiff a b
a of
        Diff.First a
a -> a -> Paired a b
forall a b. a -> Paired a b
First a
a
        Diff.Second b
b -> b -> Paired a b
forall a b. b -> Paired a b
Second b
b
        Diff.Both a
a b
b -> a -> b -> Paired a b
forall a b. a -> b -> Paired a b
Both a
a b
b

-- | Left if the val was in the left list but not the right, Right for the
-- converse.
diff_either :: (a -> b -> Bool) -> [a] -> [b] -> [Either a b]
diff_either :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [Either a b]
diff_either a -> b -> Bool
eq [a]
as [b]
bs = (Paired a b -> Maybe (Either a b)) -> [Paired a b] -> [Either a b]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Paired a b -> Maybe (Either a b)
forall {a} {b}. Paired a b -> Maybe (Either a b)
to_either ([Paired a b] -> [Either a b]) -> [Paired a b] -> [Either a b]
forall a b. (a -> b) -> a -> b
$ (a -> b -> Bool) -> [a] -> [b] -> [Paired a b]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [Paired a b]
diff a -> b -> Bool
eq [a]
as [b]
bs
    where
    to_either :: Paired a b -> Maybe (Either a b)
to_either (First a
a) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left a
a)
    to_either (Second b
a) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right b
a)
    to_either Paired a b
_ = Maybe (Either a b)
forall a. Maybe a
Nothing

-- | This is like 'diff', except that the index of each pair in the
-- /right/ list is included.  So the index is where you should delete or
-- add the element to turn as into bs:
--
-- * @(i, Second b)@, @i@ is the position of @b@ in @bs@.
--
-- * @(i, First a)@, @i@ is where @a@ was deleted from @bs@.
diff_index :: (a -> b -> Bool) -> [a] -> [b] -> [(Int, Paired a b)]
diff_index :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [(Int, Paired a b)]
diff_index a -> b -> Bool
eq [a]
as [b]
bs = [Int] -> [Paired a b] -> [(Int, Paired a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Paired a b] -> [Int]
forall {a} {b}. [Paired a b] -> [Int]
indexed [Paired a b]
pairs) [Paired a b]
pairs
    where
    pairs :: [Paired a b]
pairs = (a -> b -> Bool) -> [a] -> [b] -> [Paired a b]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [Paired a b]
diff a -> b -> Bool
eq [a]
as [b]
bs
    indexed :: [Paired a b] -> [Int]
indexed = (Int -> Paired a b -> Int) -> Int -> [Paired a b] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Paired a b -> Int
forall {p} {a} {b}. Num p => p -> Paired a b -> p
f Int
0
        where
        f :: p -> Paired a b -> p
f p
i (First a
_) = p
i
        f p
i Paired a b
_ = p
ip -> p -> p
forall a. Num a => a -> a -> a
+p
1

diff_index_on :: Eq k => (a -> k) -> [a] -> [a] -> [(Int, Paired a a)]
diff_index_on :: forall k a. Eq k => (a -> k) -> [a] -> [a] -> [(Int, Paired a a)]
diff_index_on a -> k
key = (a -> a -> Bool) -> [a] -> [a] -> [(Int, Paired a a)]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [(Int, Paired a b)]
diff_index (\a
a a
b -> a -> k
key a
a k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== a -> k
key a
b)

-- | Pair up two lists of sorted pairs by their first element.
pair_sorted :: Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted :: forall k a b. Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted [(k, a)]
xs [] = [(k
k, a -> Paired a b
forall a b. a -> Paired a b
First a
v) | (k
k, a
v) <- [(k, a)]
xs]
pair_sorted [] [(k, b)]
ys = [(k
k, b -> Paired a b
forall a b. b -> Paired a b
Second b
v) | (k
k, b
v) <- [(k, b)]
ys]
pair_sorted x :: [(k, a)]
x@((k
k0, a
v0) : [(k, a)]
xs) y :: [(k, b)]
y@((k
k1, b
v1) : [(k, b)]
ys)
    | k
k0 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k1 = (k
k0, a -> b -> Paired a b
forall a b. a -> b -> Paired a b
Both a
v0 b
v1) (k, Paired a b) -> [(k, Paired a b)] -> [(k, Paired a b)]
forall a. a -> [a] -> [a]
: [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
forall k a b. Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted [(k, a)]
xs [(k, b)]
ys
    | k
k0 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k1 = (k
k0, a -> Paired a b
forall a b. a -> Paired a b
First a
v0) (k, Paired a b) -> [(k, Paired a b)] -> [(k, Paired a b)]
forall a. a -> [a] -> [a]
: [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
forall k a b. Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted [(k, a)]
xs [(k, b)]
y
    | Bool
otherwise = (k
k1, b -> Paired a b
forall a b. b -> Paired a b
Second b
v1) (k, Paired a b) -> [(k, Paired a b)] -> [(k, Paired a b)]
forall a. a -> [a] -> [a]
: [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
forall k a b. Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted [(k, a)]
x [(k, b)]
ys

-- | Like 'pair_sorted', but use a key function, and omit the extracted key.
pair_sorted_on1 :: Ord k => (a -> k) -> [a] -> [a] -> [Paired a a]
pair_sorted_on1 :: forall k a. Ord k => (a -> k) -> [a] -> [a] -> [Paired a a]
pair_sorted_on1 a -> k
key = (a -> k) -> (a -> k) -> [a] -> [a] -> [Paired a a]
forall k a b.
Ord k =>
(a -> k) -> (b -> k) -> [a] -> [b] -> [Paired a b]
pair_sorted_on a -> k
key a -> k
key

-- | Like 'pair_sorted', but use a key function, and omit the extracted key.
pair_sorted_on :: Ord k => (a -> k) -> (b -> k) -> [a] -> [b] -> [Paired a b]
pair_sorted_on :: forall k a b.
Ord k =>
(a -> k) -> (b -> k) -> [a] -> [b] -> [Paired a b]
pair_sorted_on a -> k
key1 b -> k
key2 [a]
xs [b]
ys =
    ((k, Paired a b) -> Paired a b)
-> [(k, Paired a b)] -> [Paired a b]
forall a b. (a -> b) -> [a] -> [b]
map (k, Paired a b) -> Paired a b
forall a b. (a, b) -> b
snd ([(k, Paired a b)] -> [Paired a b])
-> [(k, Paired a b)] -> [Paired a b]
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
forall k a b. Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted ((a -> k) -> [a] -> [(k, a)]
forall a k. (a -> k) -> [a] -> [(k, a)]
key_on a -> k
key1 [a]
xs) ((b -> k) -> [b] -> [(k, b)]
forall a k. (a -> k) -> [a] -> [(k, a)]
key_on b -> k
key2 [b]
ys)

-- | Sort the lists on with the key functions, then pair them up.
pair_on :: Ord k => (a -> k) -> (b -> k) -> [a] -> [b] -> [Paired a b]
pair_on :: forall k a b.
Ord k =>
(a -> k) -> (b -> k) -> [a] -> [b] -> [Paired a b]
pair_on a -> k
k1 b -> k
k2 [a]
xs [b]
ys = ((k, Paired a b) -> Paired a b)
-> [(k, Paired a b)] -> [Paired a b]
forall a b. (a -> b) -> [a] -> [b]
map (k, Paired a b) -> Paired a b
forall a b. (a, b) -> b
snd ([(k, Paired a b)] -> [Paired a b])
-> [(k, Paired a b)] -> [Paired a b]
forall a b. (a -> b) -> a -> b
$
    [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
forall k a b. Ord k => [(k, a)] -> [(k, b)] -> [(k, Paired a b)]
pair_sorted (((k, a) -> k) -> [(k, a)] -> [(k, a)]
forall k a. Ord k => (a -> k) -> [a] -> [a]
sort_on (k, a) -> k
forall a b. (a, b) -> a
fst ((a -> k) -> [a] -> [(k, a)]
forall a k. (a -> k) -> [a] -> [(k, a)]
key_on a -> k
k1 [a]
xs)) (((k, b) -> k) -> [(k, b)] -> [(k, b)]
forall k a. Ord k => (a -> k) -> [a] -> [a]
sort_on (k, b) -> k
forall a b. (a, b) -> a
fst ((b -> k) -> [b] -> [(k, b)]
forall a k. (a -> k) -> [a] -> [(k, a)]
key_on b -> k
k2 [b]
ys))

-- | Like 'pair_on', but when the lists have the same type.
pair_on1 :: Ord k => (a -> k) -> [a] -> [a] -> [Paired a a]
pair_on1 :: forall k a. Ord k => (a -> k) -> [a] -> [a] -> [Paired a a]
pair_on1 a -> k
k = (a -> k) -> (a -> k) -> [a] -> [a] -> [Paired a a]
forall k a b.
Ord k =>
(a -> k) -> (b -> k) -> [a] -> [b] -> [Paired a b]
pair_on a -> k
k a -> k
k

-- * partition

-- | Like 'List.partition', but partition by two functions consecutively.
partition2 :: (a -> Bool) -> (a -> Bool) -> [a] -> ([a], [a], [a])
partition2 :: forall a. (a -> Bool) -> (a -> Bool) -> [a] -> ([a], [a], [a])
partition2 a -> Bool
f1 a -> Bool
f2 [a]
xs = ([a]
as, [a]
bs, [a]
xs3)
    where
    ([a]
as, [a]
xs2) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition a -> Bool
f1 [a]
xs
    ([a]
bs, [a]
xs3) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition a -> Bool
f2 [a]
xs2

-- | Partition and transform at the same time.
partition_on :: (a -> Maybe b) -> [a] -> ([b], [a])
partition_on :: forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
partition_on a -> Maybe b
f = [a] -> ([b], [a])
go
    where
    go :: [a] -> ([b], [a])
go [] = ([], [])
    go (a
x:[a]
xs) = case a -> Maybe b
f a
x of
        Just b
b -> (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs, [a]
as)
        Maybe b
Nothing -> ([b]
bs, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)
        where ([b]
bs, [a]
as) = [a] -> ([b], [a])
go [a]
xs

-- * sublists

-- | Split into groups of a certain size.
chunked :: Int -> [a] -> [[a]]
chunked :: forall a. Int -> [a] -> [[a]]
chunked Int
n [a]
xs = case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs of
    ([], []) -> []
    ([a]
pre, []) -> [[a]
pre]
    ([a]
pre, [a]
post) -> [a]
pre [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunked Int
n [a]
post


-- | Take a list of rows to a list of columns.  This is like a zip except
-- for variable-length lists.  Similar to zip, the result is trimmed to the
-- length of the shortest row.
--
-- 'List.transpose' is similar, but it skips missing elements, instead of
-- truncating all to the shortest.  Skipping means you lose what column the
-- element came from.
rotate :: [[a]] -> [[a]]
rotate :: forall a. [[a]] -> [[a]]
rotate [] = []
rotate [[a]]
xs = [[a]] -> ([a] -> [[a]]) -> Maybe [a] -> [[a]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
rotate (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
List.tail [[a]]
xs)) (([a] -> Maybe a) -> [[a]] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [a] -> Maybe a
forall a. [a] -> Maybe a
head [[a]]
xs)

-- | Similar to 'rotate', except that the result is the length of the longest
-- row and missing columns are Nothing.  Analogous to 'zip_padded'.
rotate2 :: [[a]] -> [[Maybe a]]
rotate2 :: forall a. [[a]] -> [[Maybe a]]
rotate2 [[a]]
xs
    | (Maybe a -> Bool) -> [Maybe a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing [Maybe a]
heads = []
    | Bool
otherwise = [Maybe a]
heads [Maybe a] -> [[Maybe a]] -> [[Maybe a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[Maybe a]]
forall a. [[a]] -> [[Maybe a]]
rotate2 (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1) [[a]]
xs)
    where heads :: [Maybe a]
heads = ([a] -> Maybe a) -> [[a]] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Maybe a
forall a. [a] -> Maybe a
head [[a]]
xs


-- ** extracting sublists

-- | Total variants of unsafe list operations.
head, last :: [a] -> Maybe a
head :: forall a. [a] -> Maybe a
head [] = Maybe a
forall a. Maybe a
Nothing
head (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
last :: forall a. [a] -> Maybe a
last [] = Maybe a
forall a. Maybe a
Nothing
last [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall a. [a] -> a
List.last [a]
xs)

tail :: [a] -> Maybe [a]
tail :: forall a. [a] -> Maybe [a]
tail [] = Maybe [a]
forall a. Maybe a
Nothing
tail (a
_:[a]
xs) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs

-- | Drop until the last element before or equal to the given element.
drop_before :: Ord key => (a -> key) -> key -> [a] -> [a]
drop_before :: forall key a. Ord key => (a -> key) -> key -> [a] -> [a]
drop_before a -> key
key key
p = [a] -> [a]
go
    where
    go :: [a] -> [a]
go [] = []
    go (a
x0 : [a]
xs)
        | key
p key -> key -> Bool
forall a. Ord a => a -> a -> Bool
< a -> key
key a
x0 = a
x0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
        | Bool
otherwise = case [a]
xs of
            a
x1 : [a]
_ | key
p key -> key -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> key
key a
x1 -> [a] -> [a]
go [a]
xs
            [a]
_ -> a
x0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- | takeWhile with state.
takeWhileS :: state -> (state -> a -> Maybe state) -> [a] -> [a]
takeWhileS :: forall state a. state -> (state -> a -> Maybe state) -> [a] -> [a]
takeWhileS state
state state -> a -> Maybe state
f = state -> [a] -> [a]
go state
state
    where
    go :: state -> [a] -> [a]
go state
_ [] = []
    go !state
state0 (a
x : [a]
xs) = [a] -> (state -> [a]) -> Maybe state -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\state
state1 -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: state -> [a] -> [a]
go state
state1 [a]
xs) (state -> a -> Maybe state
f state
state0 a
x)

-- ** duplicates

-- | Drop adjacent elts if they are equal after applying the key function.
-- The first elt is kept.
drop_dups :: Eq k => (a -> k) -> [a] -> [a]
drop_dups :: forall k a. Eq k => (a -> k) -> [a] -> [a]
drop_dups a -> k
_ [] = []
drop_dups a -> k
key (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd (((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((a, a) -> Bool) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> Bool
equal) ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
xs))
    where equal :: (a, a) -> Bool
equal (a
a, a
b) = a -> k
key a
a k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== a -> k
key a
b

-- | Filter out elts when the predicate is true for adjacent elts.  The first
-- elt is kept, and the later ones are dropped.  This is like 'drop_dups'
-- except it can compare two elements.  E.g. @drop_with (>=)@ will ensure the
-- sequence is increasing.
drop_with :: (a -> a -> Bool) -> [a] -> [a]
drop_with :: forall a. (a -> a -> Bool) -> [a] -> [a]
drop_with a -> a -> Bool
_ [] = []
drop_with a -> a -> Bool
_ [a
x] = [a
x]
drop_with a -> a -> Bool
f (a
x:a
y:[a]
xs)
    | a -> a -> Bool
f a
x a
y = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
drop_with a -> a -> Bool
f (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
drop_with a -> a -> Bool
f (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

-- | Sort the input by the key, extract unique values, and also return the
-- duplicates.
partition_dups :: Ord k => (a -> k) -> [a] -> ([a], [(a, NonNull a)])
    -- ^ ([unique], [(used_for_unique, [dups])])
partition_dups :: forall k a. Ord k => (a -> k) -> [a] -> ([a], [(a, [a])])
partition_dups a -> k
key [a]
xs =
    [Either a (a, [a])] -> ([a], [(a, [a])])
forall a b. [Either a b] -> ([a], [b])
Either.partitionEithers ([Either a (a, [a])] -> ([a], [(a, [a])]))
-> [Either a (a, [a])] -> ([a], [(a, [a])])
forall a b. (a -> b) -> a -> b
$ ([a] -> [Either a (a, [a])]) -> [[a]] -> [Either a (a, [a])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [a] -> [Either a (a, [a])]
forall {a}. [a] -> [Either a (a, [a])]
extract ((a -> k) -> [a] -> [[a]]
forall key a. Ord key => (a -> key) -> [a] -> [[a]]
group_sort a -> k
key [a]
xs)
    where
    extract :: [a] -> [Either a (a, [a])]
extract [] = []
    extract [a
x] = [a -> Either a (a, [a])
forall a b. a -> Either a b
Left a
x]
    extract (a
x:[a]
xs) = [a -> Either a (a, [a])
forall a b. a -> Either a b
Left a
x, (a, [a]) -> Either a (a, [a])
forall a b. b -> Either a b
Right (a
x, [a]
xs)]

-- | Find duplicate values.  There are always at least 2 of each output.
find_dups :: Ord k => (a -> k) -> [a] -> [(a, NonEmpty a)]
find_dups :: forall k a. Ord k => (a -> k) -> [a] -> [(a, NonEmpty a)]
find_dups a -> k
key = ([a] -> Maybe (a, NonEmpty a)) -> [[a]] -> [(a, NonEmpty a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe [a] -> Maybe (a, NonEmpty a)
forall {a}. [a] -> Maybe (a, NonEmpty a)
extract ([[a]] -> [(a, NonEmpty a)])
-> ([a] -> [[a]]) -> [a] -> [(a, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> [a] -> [[a]]
forall key a. Ord key => (a -> key) -> [a] -> [[a]]
group_sort a -> k
key
    where
    extract :: [a] -> Maybe (a, NonEmpty a)
extract [] = Maybe (a, NonEmpty a)
forall a. Maybe a
Nothing
    extract [a
_] = Maybe (a, NonEmpty a)
forall a. Maybe a
Nothing
    extract (a
x1:a
x2:[a]
xs) = (a, NonEmpty a) -> Maybe (a, NonEmpty a)
forall a. a -> Maybe a
Just (a
x1, a
x2 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)

-- | Like 'drop_dups', but keep the last adjacent equal elt instead of the
-- first.
drop_initial_dups :: Eq k => (a -> k) -> [a] -> [a]
drop_initial_dups :: forall k a. Eq k => (a -> k) -> [a] -> [a]
drop_initial_dups a -> k
_ [] = []
drop_initial_dups a -> k
_ [a
x] = [a
x]
drop_initial_dups a -> k
key (a
x:xs :: [a]
xs@(a
next:[a]
_))
    | a -> k
key a
x k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== a -> k
key a
next = [a]
rest
    | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest
    where rest :: [a]
rest = (a -> k) -> [a] -> [a]
forall k a. Eq k => (a -> k) -> [a] -> [a]
drop_initial_dups a -> k
key [a]
xs

unique :: Ord a => [a] -> [a]
unique :: forall a. Ord a => [a] -> [a]
unique = (a -> a) -> [a] -> [a]
forall k a. Ord k => (a -> k) -> [a] -> [a]
unique_on a -> a
forall a. a -> a
id

-- | This is like 'drop_dups', except that it's not limited to just adjacent
-- elts.  The output list is in the same order as the input.
unique_on :: Ord k => (a -> k) -> [a] -> [a]
unique_on :: forall k a. Ord k => (a -> k) -> [a] -> [a]
unique_on a -> k
f [a]
xs = Set k -> [a] -> [a]
go Set k
forall a. Set a
Set.empty [a]
xs
    where
    go :: Set k -> [a] -> [a]
go Set k
_set [] = []
    go Set k
set (a
x:[a]
xs)
        | k
k k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set k
set = Set k -> [a] -> [a]
go Set k
set [a]
xs
        | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set k -> [a] -> [a]
go (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
set) [a]
xs
        where k :: k
k = a -> k
f a
x

-- | Like 'unique', but sort the list, and should be more efficient.
unique_sort :: Ord a => [a] -> [a]
unique_sort :: forall a. Ord a => [a] -> [a]
unique_sort = Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

-- ** right variants

rtake :: Int -> [a] -> [a]
rtake :: forall a. Int -> [a] -> [a]
rtake Int
n = (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Int, [a]) -> [a]) -> ([a] -> (Int, [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Int, [a]) -> (Int, [a])) -> (Int, [a]) -> [a] -> (Int, [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Int, [a]) -> (Int, [a])
forall {a} {a}. (Ord a, Num a) => a -> (a, [a]) -> (a, [a])
go (Int
n, [])
    where
    go :: a -> (a, [a]) -> (a, [a])
go a
x (a
n, [a]
xs)
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = (a
0, [a]
xs)
        | Bool
otherwise = (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

rtake_while :: (a -> Bool) -> [a] -> [a]
rtake_while :: forall a. (a -> Bool) -> [a] -> [a]
rtake_while a -> Bool
f = ([a] -> [a]) -> ([a] -> [a]) -> Either [a] [a] -> [a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [a] -> [a]
forall a. a -> a
id ([a] -> [a] -> [a]
forall a b. a -> b -> a
const []) (Either [a] [a] -> [a]) -> ([a] -> Either [a] [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either [a] [a] -> Either [a] [a])
-> Either [a] [a] -> [a] -> Either [a] [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Either [a] [a] -> Either [a] [a]
go ([a] -> Either [a] [a]
forall a b. b -> Either a b
Right [])
    where
    -- Left means I'm done taking.
    go :: a -> Either [a] [a] -> Either [a] [a]
go a
_ (Left [a]
xs) = [a] -> Either [a] [a]
forall a b. a -> Either a b
Left [a]
xs
    go a
x (Right [a]
xs)
        | a -> Bool
f a
x = [a] -> Either [a] [a]
forall a b. b -> Either a b
Right (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
        | Bool
otherwise = [a] -> Either [a] [a]
forall a b. a -> Either a b
Left [a]
xs

rdrop :: Int -> [a] -> [a]
rdrop :: forall a. Int -> [a] -> [a]
rdrop Int
n = ([a] -> [a]) -> (Int -> [a]) -> Either [a] Int -> [a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [a] -> [a]
forall a. a -> a
id ([a] -> Int -> [a]
forall a b. a -> b -> a
const []) (Either [a] Int -> [a]) -> ([a] -> Either [a] Int) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either [a] Int -> Either [a] Int)
-> Either [a] Int -> [a] -> Either [a] Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Either [a] Int -> Either [a] Int
forall {b} {a}. (Ord b, Num b) => a -> Either [a] b -> Either [a] b
f (Int -> Either [a] Int
forall a b. b -> Either a b
Right Int
n)
    where
    f :: a -> Either [a] b -> Either [a] b
f a
x (Right b
n)
        | b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 = [a] -> Either [a] b
forall a b. a -> Either a b
Left [a
x]
        | Bool
otherwise = b -> Either [a] b
forall a b. b -> Either a b
Right (b
nb -> b -> b
forall a. Num a => a -> a -> a
-b
1)
    f a
x (Left [a]
xs) = [a] -> Either [a] b
forall a b. a -> Either a b
Left (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

-- | The same as 'List.dropWhileEnd` except I also have all the other from-end
-- variants.
rdrop_while :: (a -> Bool) -> [a] -> [a]
rdrop_while :: forall a. (a -> Bool) -> [a] -> [a]
rdrop_while = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd

lstrip, rstrip, strip :: String -> String
lstrip :: [Char] -> [Char]
lstrip = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace
rstrip :: [Char] -> [Char]
rstrip = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
rdrop_while Char -> Bool
Char.isSpace
strip :: [Char] -> [Char]
strip = [Char] -> [Char]
rstrip ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
lstrip

-- | If the list doesn't have the given prefix, return the original list and
-- False.  Otherwise, strip it off and return True.  'List.stripPrefix' is an
-- alternate version.
drop_prefix :: Eq a => [a] -> [a] -> ([a], Bool)
drop_prefix :: forall a. Eq a => [a] -> [a] -> ([a], Bool)
drop_prefix [a]
pref [a]
list = [a] -> [a] -> ([a], Bool)
go [a]
pref [a]
list
    where
    go :: [a] -> [a] -> ([a], Bool)
go [] [a]
xs = ([a]
xs, Bool
True)
    go [a]
_ [] = ([a]
list, Bool
False)
    go (a
p:[a]
ps) (a
x:[a]
xs)
        | a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = [a] -> [a] -> ([a], Bool)
go [a]
ps [a]
xs
        | Bool
otherwise = ([a]
list, Bool
False)

drop_suffix :: Eq a => [a] -> [a] -> ([a], Bool)
drop_suffix :: forall a. Eq a => [a] -> [a] -> ([a], Bool)
drop_suffix [a]
suffix [a]
list
    | [a]
post [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
suffix = ([a]
pre, Bool
True)
    | Bool
otherwise = ([a]
list, Bool
False)
    where ([a]
pre, [a]
post) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
suffix) [a]
list

-- ** span and break

-- | Like 'break', but the called function has access to the entire tail.
break_tails :: ([a] -> Bool) -> [a] -> ([a], [a])
break_tails :: forall a. ([a] -> Bool) -> [a] -> ([a], [a])
break_tails [a] -> Bool
_ [] = ([], [])
break_tails [a] -> Bool
f lst :: [a]
lst@(a
x:[a]
xs)
    | [a] -> Bool
f [a]
lst = ([], [a]
lst)
    | Bool
otherwise = let ([a]
pre, [a]
post) = ([a] -> Bool) -> [a] -> ([a], [a])
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
break_tails [a] -> Bool
f [a]
xs in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pre, [a]
post)

-- | 'List.span' from the end of the list.
span_end :: (a -> Bool) -> [a] -> ([a], [a])
span_end :: forall a. (a -> Bool) -> [a] -> ([a], [a])
span_end a -> Bool
f [a]
xs = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
post, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
pre)
    where ([a]
pre, [a]
post) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
f ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)

-- | Like 'span', but it can transform the spanned sublist.
span_while :: (a -> Maybe b) -> [a] -> ([b], [a])
span_while :: forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
span_while a -> Maybe b
f = [a] -> ([b], [a])
go
    where
    go :: [a] -> ([b], [a])
go [] = ([], [])
    go (a
a:[a]
as) = case a -> Maybe b
f a
a of
        Just b
b -> ([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (b
b:) ([a] -> ([b], [a])
go [a]
as)
        Maybe b
Nothing -> ([], a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)

-- | 'span_while' from the end of the list.
span_end_while :: (a -> Maybe b) -> [a] -> ([a], [b])
span_end_while :: forall a b. (a -> Maybe b) -> [a] -> ([a], [b])
span_end_while a -> Maybe b
f [a]
xs = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
post, [b] -> [b]
forall a. [a] -> [a]
reverse [b]
pre)
    where ([b]
pre, [a]
post) = (a -> Maybe b) -> [a] -> ([b], [a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
span_while a -> Maybe b
f ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)

-- | List initial and final element, if any.
viewr :: [a] -> Maybe ([a], a)
viewr :: forall a. [a] -> Maybe ([a], a)
viewr [] = Maybe ([a], a)
forall a. Maybe a
Nothing
viewr (a
x:[a]
xs) = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a)) -> ([a], a) -> Maybe ([a], a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> ([a], a)
forall {a}. a -> [a] -> ([a], a)
go a
x [a]
xs
    where
    go :: a -> [a] -> ([a], a)
go a
x0 [] = ([], a
x0)
    go a
x0 (a
x:[a]
xs) = let ([a]
pre, a
post) = a -> [a] -> ([a], a)
go a
x [a]
xs in (a
x0a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pre, a
post)

ne_viewr :: NonEmpty a -> ([a], a)
ne_viewr :: forall a. NonEmpty a -> ([a], a)
ne_viewr (a
x :| [a]
xs) =
    ([a], a) -> Maybe ([a], a) -> ([a], a)
forall a. a -> Maybe a -> a
Maybe.fromMaybe ([Char] -> ([a], a)
forall a. HasCallStack => [Char] -> a
error [Char]
"ne_viewr: not reached") ([a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
viewr (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs))

-- ** split and join

-- | Split before places where the function matches.
--
-- > > split_before (==1) [1, 2, 1]
-- > [[], [1, 2], [1]]
split_before :: (a -> Bool) -> [a] -> [[a]]
split_before :: forall a. (a -> Bool) -> [a] -> [[a]]
split_before a -> Bool
f = [a] -> [[a]]
go
    where
    go :: [a] -> [[a]]
go [] = []
    go [a]
xs0 = [a]
pre [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
post of
        a
x : [a]
xs -> a -> [[a]] -> [[a]]
forall {a}. a -> [[a]] -> [[a]]
cons1 a
x ([a] -> [[a]]
go [a]
xs)
        [] -> []
        where ([a]
pre, [a]
post) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f [a]
xs0
    cons1 :: a -> [[a]] -> [[a]]
cons1 a
x [] = [[a
x]]
    cons1 a
x ([a]
g:[[a]]
gs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
g) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
gs

-- | Like 'split_before', but express the NonEmpty parts in the type.
--
-- > > split_before_ne (==1) [1, 2, 1]
-- > ([], [1 :| [2], 1 :| []])
split_before_ne :: (a -> Bool) -> [a] -> ([a], [NonEmpty a])
split_before_ne :: forall a. (a -> Bool) -> [a] -> ([a], [NonEmpty a])
split_before_ne a -> Bool
f = ([a] -> [NonEmpty a]) -> ([a], [a]) -> ([a], [NonEmpty a])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [a] -> [NonEmpty a]
go (([a], [a]) -> ([a], [NonEmpty a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [NonEmpty 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
    where
    go :: [a] -> [NonEmpty a]
go [] = []
    go (a
x : [a]
xs) = (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
pre) NonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
: [a] -> [NonEmpty a]
go [a]
post
        where ([a]
pre, [a]
post) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f [a]
xs

-- | Split after places where the function matches.
split_after :: (a -> Bool) -> [a] -> [[a]]
split_after :: forall a. (a -> Bool) -> [a] -> [[a]]
split_after a -> Bool
f = [a] -> [[a]]
go
    where
    go :: [a] -> [[a]]
go [] = []
    go [a]
xs = [a]
pre [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
go [a]
post
        where ([a]
pre, [a]
post) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Then.break1 a -> Bool
f [a]
xs

-- | Split @xs@ on @sep@, dropping @sep@ from the result.
split :: Eq a => NonNull a -> [a] -> NonNull [a]
split :: forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
split [] = [Char] -> [a] -> NonNull [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"Util.Seq.split: empty separator"
split [a]
sep = [a] -> NonNull [a]
go
    where
    go :: [a] -> NonNull [a]
go [a]
xs
        | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
post = [[a]
pre]
        | Bool
otherwise = [a]
pre [a] -> NonNull [a] -> NonNull [a]
forall a. a -> [a] -> [a]
: [a] -> NonNull [a]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
sep) [a]
post)
        where ([a]
pre, [a]
post) = ([a] -> Bool) -> [a] -> ([a], [a])
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
break_tails ([a]
sep `List.isPrefixOf`) [a]
xs

-- | Like 'split', but it returns [] if the input was null.
split_null :: Eq a => NonNull a -> [a] -> [[a]]
split_null :: forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
split_null NonNull a
_ [] = []
split_null NonNull a
sep NonNull a
xs = NonNull a -> NonNull a -> [NonNull a]
forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
split NonNull a
sep NonNull a
xs

-- | Like 'split', but split on a single element.
split1 :: Eq a => a -> [a] -> [[a]]
split1 :: forall a. Eq a => a -> [a] -> [[a]]
split1 a
sep = [a] -> [[a]]
go
    where
    go :: [a] -> [[a]]
go [a]
xs
        | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
post = [[a]
pre]
        | Bool
otherwise = [a]
pre [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
post)
        where ([a]
pre, [a]
post) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
sep) [a]
xs

-- | Interspense a separator and concat.
join :: Monoid a => a -> [a] -> a
join :: forall a. Monoid a => a -> [a] -> a
join a
sep = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. a -> [a] -> [a]
List.intersperse a
sep

-- | Binary join, but the separator is only used if both joinees are non-empty.
join2 :: (Monoid a, Eq a) => a -> a -> a -> a
join2 :: forall a. (Monoid a, Eq a) => a -> a -> a -> a
join2 a
sep a
x a
y
    | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = a
x
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = a
y
    | Bool
otherwise = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
sep a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y

-- | Split the list on the points where the given function returns true.
--
-- This is similar to 'groupBy', except this is defined to compare adjacent
-- elements.  'groupBy' actually compares to the first element of each group.
-- E.g. you can't group numeric runs with @groupBy (\a b -> b > a+1)@.
split_between :: (a -> a -> Bool) -> [a] -> [[a]]
split_between :: forall a. (a -> a -> Bool) -> [a] -> [[a]]
split_between a -> a -> Bool
_ [] = []
split_between a -> a -> Bool
f [a]
xs = [a]
pre [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
split_between a -> a -> Bool
f [a]
post
    where ([a]
pre, [a]
post) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
break_between a -> a -> Bool
f [a]
xs

break_between :: (a -> a -> Bool) -> [a] -> ([a], [a])
break_between :: forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
break_between a -> a -> Bool
f (a
x1 : xs :: [a]
xs@(a
x2:[a]
_))
    | a -> a -> Bool
f a
x1 a
x2 = ([a
x1], [a]
xs)
    | Bool
otherwise = let ([a]
pre, [a]
post) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
break_between a -> a -> Bool
f [a]
xs in (a
x1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
pre, [a]
post)
break_between a -> a -> Bool
_ [a]
xs = ([a]
xs, [])


-- * replace

-- | Replace sublist @from@ with @to@ in the given list.
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace :: forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
from [a]
to = [a] -> [a]
go
    where
    len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
from
    go :: [a] -> [a]
go [] = []
    go lst :: [a]
lst@(a
x:[a]
xs)
        | [a]
from [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [a]
lst = [a]
to [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
len [a]
lst)
        | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs

-- | Replace occurrances of an element with zero or more other elements.
replace1 :: Eq a => a -> [a] -> [a] -> [a]
replace1 :: forall a. Eq a => a -> [a] -> [a] -> [a]
replace1 a
from [a]
to = (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
v -> if a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
from then [a]
to else [a
v])


-- * search

count :: Foldable t => (a -> Bool) -> t a -> Int
count :: forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Int
count a -> Bool
f = (Int -> a -> Int) -> Int -> t a -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Int
n a
c -> if a -> Bool
f a
c then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n) Int
0


-- * monadic

-- | Like 'List.mapAccumL', but monadic.  Strict in the accumulator.
mapAccumLM :: Monad m => (state -> x -> m (state, y)) -> state -> [x]
    -> m (state, [y])
mapAccumLM :: forall (m :: * -> *) state x y.
Monad m =>
(state -> x -> m (state, y)) -> state -> [x] -> m (state, [y])
mapAccumLM state -> x -> m (state, y)
f = state -> [x] -> m (state, [y])
go
    where
    go :: state -> [x] -> m (state, [y])
go !state
state [] = (state, [y]) -> m (state, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (state
state, [])
    go !state
state (x
x:[x]
xs) = do
        (state
state, y
y) <- state -> x -> m (state, y)
f state
state x
x
        (state
state, [y]
ys) <- state -> [x] -> m (state, [y])
go state
state [x]
xs
        (state, [y]) -> m (state, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (state
state, y
y y -> [y] -> [y]
forall a. a -> [a] -> [a]
: [y]
ys)