-- | List functions.
module Music.Theory.List where

import Data.Bifunctor {- base -}
import Data.Function {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ord {- base -}

import qualified Data.IntMap as Map {- containers -}
import qualified Data.List.Ordered as O {- data-ordlist -}
import qualified Data.List.Split as S {- split -}
import qualified Data.Tree as Tree {- containers -}

import qualified Music.Theory.Either as T {- hmt-base -}

-- | 'Data.Vector.slice', ie. starting index (zero-indexed) and number of elements.
--
-- > slice 4 5 [1..] == [5,6,7,8,9]
slice :: Int -> Int -> [a] -> [a]
slice :: forall a. Int -> Int -> [a] -> [a]
slice Int
i Int
n = forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
i

-- | Variant of slice with start and end indices (zero-indexed).
--
-- > section 4 8 [1..] == [5,6,7,8,9]
section :: Int -> Int -> [a] -> [a]
section :: forall a. Int -> Int -> [a] -> [a]
section Int
l Int
r = forall a. Int -> [a] -> [a]
take (Int
r forall a. Num a => a -> a -> a
- Int
l forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
l

-- | Bracket sequence with left and right values.
--
-- > bracket ('<','>') "1,2,3" == "<1,2,3>"
bracket :: (a,a) -> [a] -> [a]
bracket :: forall a. (a, a) -> [a] -> [a]
bracket (a
l,a
r) [a]
x = a
l forall a. a -> [a] -> [a]
: [a]
x forall a. [a] -> [a] -> [a]
++ [a
r]

-- | Variant where brackets are sequences.
--
-- > bracket_l ("<:",":>") "1,2,3" == "<:1,2,3:>"
bracket_l :: ([a],[a]) -> [a] -> [a]
bracket_l :: forall a. ([a], [a]) -> [a] -> [a]
bracket_l ([a]
l,[a]
r) [a]
s = [a]
l forall a. [a] -> [a] -> [a]
++ [a]
s forall a. [a] -> [a] -> [a]
++ [a]
r

-- | The first & middle & last elements of a list.
--
-- > map unbracket_el ["","{12}"] == [(Nothing,"",Nothing),(Just '{',"12",Just '}')]
unbracket_el :: [a] -> (Maybe a,[a],Maybe a)
unbracket_el :: forall a. [a] -> (Maybe a, [a], Maybe a)
unbracket_el [a]
x =
    case [a]
x of
      [] -> (forall a. Maybe a
Nothing,[],forall a. Maybe a
Nothing)
      a
l:[a]
x' -> let ([a]
m,Maybe a
r) = forall a. [a] -> ([a], Maybe a)
separate_last' [a]
x' in (forall a. a -> Maybe a
Just a
l,[a]
m,Maybe a
r)

-- | The first & middle & last elements of a list.
--
-- > map unbracket ["","{12}"] == [Nothing,Just ('{',"12",'}')]
unbracket :: [t] -> Maybe (t,[t],t)
unbracket :: forall t. [t] -> Maybe (t, [t], t)
unbracket [t]
x =
    case forall a. [a] -> (Maybe a, [a], Maybe a)
unbracket_el [t]
x of
      (Just t
l,[t]
m,Just t
r) -> forall a. a -> Maybe a
Just (t
l,[t]
m,t
r)
      (Maybe t, [t], Maybe t)
_ -> forall a. Maybe a
Nothing

-- | Erroring variant.
unbracket_err :: [t] -> (t,[t],t)
unbracket_err :: forall t. [t] -> (t, [t], t)
unbracket_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"unbracket") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. [t] -> Maybe (t, [t], t)
unbracket

-- * Split

-- | Relative of 'S.splitOn', but only makes first separation.
--
-- > splitOn "//" "lhs//rhs//rem" == ["lhs","rhs","rem"]
-- > separate_at "//" "lhs//rhs//rem" == Just ("lhs","rhs//rem")
separate_at :: Eq a => [a] -> [a] -> Maybe ([a],[a])
separate_at :: forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
separate_at [a]
x =
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x
        f :: [a] -> [a] -> Maybe ([a], [a])
f [a]
lhs [a]
rhs =
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
rhs
            then forall a. Maybe a
Nothing
            else if [a]
x forall a. Eq a => a -> a -> Bool
== forall a. Int -> [a] -> [a]
take Int
n [a]
rhs
                 then forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse [a]
lhs,forall a. Int -> [a] -> [a]
drop Int
n [a]
rhs)
                 else [a] -> [a] -> Maybe ([a], [a])
f (forall a. [a] -> a
head [a]
rhs forall a. a -> [a] -> [a]
: [a]
lhs) (forall a. [a] -> [a]
tail [a]
rhs)
    in [a] -> [a] -> Maybe ([a], [a])
f []

-- | Variant of 'S.splitWhen' that keeps delimiters at left.
--
-- > split_when_keeping_left (== 'r') "rab rcd re rf r" == ["","rab ","rcd ","re ","rf ","r"]
split_when_keeping_left :: (a -> Bool) -> [a] -> [[a]]
split_when_keeping_left :: forall a. (a -> Bool) -> [a] -> [[a]]
split_when_keeping_left = forall a. Splitter a -> [a] -> [[a]]
S.split forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Splitter a -> Splitter a
S.keepDelimsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Splitter a
S.whenElt

{- | Split before the indicated element, keeping it at the left of the sub-sequence it begins.
     'split_when_keeping_left' of '=='

> split_before 'x' "axbcxdefx" == ["a","xbc","xdef","x"]
> split_before 'x' "xa" == ["","xa"]

> map (flip split_before "abcde") "ae_" == [["","abcde"],["abcd","e"],["abcde"]]
> map (flip break "abcde" . (==)) "ae_" == [("","abcde"),("abcd","e"),("abcde","")]

> split_before 'r' "rab rcd re rf r" == ["","rab ","rcd ","re ","rf ","r"]
-}
split_before :: Eq a => a -> [a] -> [[a]]
split_before :: forall a. Eq a => a -> [a] -> [[a]]
split_before a
x = forall a. (a -> Bool) -> [a] -> [[a]]
split_when_keeping_left (forall a. Eq a => a -> a -> Bool
== a
x)

-- | Split before any of the indicated set of delimiters.
--
-- > split_before_any ",;" ";a,b,c;d;" == ["",";a",",b",",c",";d",";"]
split_before_any :: Eq a => [a] -> [a] -> [[a]]
split_before_any :: forall a. Eq a => [a] -> [a] -> [[a]]
split_before_any = forall a. Splitter a -> [a] -> [[a]]
S.split forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Splitter a -> Splitter a
S.keepDelimsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> Splitter a
S.oneOf

-- | Singleton variant of 'S.splitOn'.
--
-- > split_on_1 ":" "graph:layout" == Just ("graph","layout")
split_on_1 :: Eq t => [t] -> [t] -> Maybe ([t],[t])
split_on_1 :: forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
split_on_1 [t]
e [t]
l =
    case forall a. Eq a => [a] -> [a] -> [[a]]
S.splitOn [t]
e [t]
l of
      [[t]
p,[t]
q] -> forall a. a -> Maybe a
Just ([t]
p,[t]
q)
      [[t]]
_ -> forall a. Maybe a
Nothing

-- | Erroring variant.
split_on_1_err :: Eq t => [t] -> [t] -> ([t],[t])
split_on_1_err :: forall t. Eq t => [t] -> [t] -> ([t], [t])
split_on_1_err [t]
e = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"split_on_1") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
split_on_1 [t]
e

-- | Split function that splits only once, ie. a variant of 'break'.
--
-- > split1 ' ' "three word sentence" == Just ("three","word sentence")
split1 :: Eq a => a -> [a] -> Maybe ([a],[a])
split1 :: forall a. Eq a => a -> [a] -> Maybe ([a], [a])
split1 a
c [a]
l =
    case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
c) [a]
l of
      ([a]
lhs,a
_:[a]
rhs) -> forall a. a -> Maybe a
Just ([a]
lhs,[a]
rhs)
      ([a], [a])
_ -> forall a. Maybe a
Nothing

-- | Erroring variant.
split1_err :: (Eq a, Show a) => a -> [a] -> ([a], [a])
split1_err :: forall a. (Eq a, Show a) => a -> [a] -> ([a], [a])
split1_err a
e [a]
s = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show ([Char]
"split1",a
e,[a]
s))) (forall a. Eq a => a -> [a] -> Maybe ([a], [a])
split1 a
e [a]
s)

{- | If length is not even the second "half" is longer.

> split_into_halves [] == ([],[])
> split_into_halves [1] == ([],[1])
> split_into_halves [1 .. 2] == ([1],[2])
> split_into_halves [1 .. 8] == ([1,2,3,4],[5,6,7,8])
> split_into_halves [1 .. 9] == ([1,2,3,4],[5,6,7,8,9])
-}
split_into_halves :: [t] -> ([t], [t])
split_into_halves :: forall t. [t] -> ([t], [t])
split_into_halves [t]
l =
  let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
l forall a. Integral a => a -> a -> a
`div` Int
2
      m :: Int
m = if Int
n forall a. Eq a => a -> a -> Bool
== Int
1 then Int
1 else Int
n forall a. Num a => a -> a -> a
+ (Int
n forall a. Integral a => a -> a -> a
`mod` Int
2) -- the two element list is a special case
  in (forall a. Int -> [a] -> [a]
take Int
m [t]
l, forall a. Int -> [a] -> [a]
drop Int
m [t]
l)

-- * Rotate

-- | Generic form of 'rotate_left'.
genericRotate_left :: Integral i => i -> [a] -> [a]
genericRotate_left :: forall i a. Integral i => i -> [a] -> [a]
genericRotate_left i
n =
    let f :: ([a], [a]) -> [a]
f ([a]
p,[a]
q) = [a]
q forall a. [a] -> [a] -> [a]
++ [a]
p
    in forall {a}. ([a], [a]) -> [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt i
n

-- | Left rotation.
--
-- > rotate_left 1 [1..3] == [2,3,1]
-- > rotate_left 3 [1..5] == [4,5,1,2,3]
rotate_left :: Int -> [a] -> [a]
rotate_left :: forall a. Int -> [a] -> [a]
rotate_left = forall i a. Integral i => i -> [a] -> [a]
genericRotate_left

-- | Generic form of 'rotate_right'.
genericRotate_right :: Integral n => n -> [a] -> [a]
genericRotate_right :: forall i a. Integral i => i -> [a] -> [a]
genericRotate_right n
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Integral i => i -> [a] -> [a]
genericRotate_left n
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Right rotation.
--
-- > rotate_right 1 [1..3] == [3,1,2]
rotate_right :: Int -> [a] -> [a]
rotate_right :: forall a. Int -> [a] -> [a]
rotate_right = forall i a. Integral i => i -> [a] -> [a]
genericRotate_right

{- | Rotate left by /n/ 'mod' /#p/ places.  Therefore negative n rotate right.

> rotate 1 [1..3] == [2,3,1]
> rotate 8 [1..5] == [4,5,1,2,3]
> (rotate (-1) "ABCD",rotate 1 "ABCD") == ("DABC","BCDA")
-}
rotate :: (Integral n) => n -> [a] -> [a]
rotate :: forall i a. Integral i => i -> [a] -> [a]
rotate n
n [a]
p =
    let m :: n
m = n
n forall a. Integral a => a -> a -> a
`mod` forall i a. Num i => [a] -> i
genericLength [a]
p
    in forall i a. Integral i => i -> [a] -> [a]
genericRotate_left n
m [a]
p

-- | Rotate right by /n/ places.
--
-- > rotate_r 8 [1..5] == [3,4,5,1,2]
rotate_r :: (Integral n) => n -> [a] -> [a]
rotate_r :: forall i a. Integral i => i -> [a] -> [a]
rotate_r = forall i a. Integral i => i -> [a] -> [a]
rotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate

-- | All rotations.
--
-- > rotations [0,1,3] == [[0,1,3],[1,3,0],[3,0,1]]
rotations :: [a] -> [[a]]
rotations :: forall a. [a] -> [[a]]
rotations [a]
p = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
`rotate_left` [a]
p) [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p forall a. Num a => a -> a -> a
- Int
1]

-- | Rotate list so that is starts at indicated element.
--
-- > rotate_starting_from 'c' "abcde" == Just "cdeab"
-- > rotate_starting_from '_' "abc" == Nothing
rotate_starting_from :: Eq a => a -> [a] -> Maybe [a]
rotate_starting_from :: forall a. Eq a => a -> [a] -> Maybe [a]
rotate_starting_from a
x [a]
l =
    case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
x) [a]
l of
      ([a]
_,[]) -> forall a. Maybe a
Nothing
      ([a]
lhs,[a]
rhs) -> forall a. a -> Maybe a
Just ([a]
rhs forall a. [a] -> [a] -> [a]
++ [a]
lhs)

-- | Erroring variant.
rotate_starting_from_err :: Eq a => a -> [a] -> [a]
rotate_starting_from_err :: forall a. Eq a => a -> [a] -> [a]
rotate_starting_from_err a
x =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"rotate_starting_from: non-element") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. Eq a => a -> [a] -> Maybe [a]
rotate_starting_from a
x

-- | Sequence of /n/ adjacent elements, moving forward by /k/ places.
-- The last element may have fewer than /n/ places, but will reach the
-- end of the input sequence.
--
-- > adj 3 2 "adjacent" == ["adj","jac","cen","nt"]
adj :: Int -> Int -> [a] -> [[a]]
adj :: forall a. Int -> Int -> [a] -> [[a]]
adj Int
n Int
k [a]
l =
    case forall a. Int -> [a] -> [a]
take Int
n [a]
l of
      [] -> []
      [a]
r -> [a]
r forall a. a -> [a] -> [a]
: forall a. Int -> Int -> [a] -> [[a]]
adj Int
n Int
k (forall a. Int -> [a] -> [a]
drop Int
k [a]
l)

-- | Variant of 'adj' where the last element has /n/ places but may
-- not reach the end of the input sequence.
--
-- > adj_trunc 4 1 "adjacent" == ["adja","djac","jace","acen","cent"]
-- > adj_trunc 3 2 "adjacent" == ["adj","jac","cen"]
adj_trunc :: Int -> Int -> [a] -> [[a]]
adj_trunc :: forall a. Int -> Int -> [a] -> [[a]]
adj_trunc Int
n Int
k [a]
l =
    let r :: [a]
r = forall a. Int -> [a] -> [a]
take Int
n [a]
l
    in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
r forall a. Eq a => a -> a -> Bool
== Int
n then [a]
r forall a. a -> [a] -> [a]
: forall a. Int -> Int -> [a] -> [[a]]
adj_trunc Int
n Int
k (forall a. Int -> [a] -> [a]
drop Int
k [a]
l) else []

-- | 'adj_trunc' of 'close' by /n/-1.
--
-- > adj_cyclic_trunc 3 1 "adjacent" == ["adj","dja","jac","ace","cen","ent","nta","tad"]
adj_cyclic_trunc :: Int -> Int -> [a] -> [[a]]
adj_cyclic_trunc :: forall a. Int -> Int -> [a] -> [[a]]
adj_cyclic_trunc Int
n Int
k = forall a. Int -> Int -> [a] -> [[a]]
adj_trunc Int
n Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
close (Int
n forall a. Num a => a -> a -> a
- Int
1)

-- | Generic form of 'adj2'.
genericAdj2 :: (Integral n) => n -> [t] -> [(t,t)]
genericAdj2 :: forall n t. Integral n => n -> [t] -> [(t, t)]
genericAdj2 n
n [t]
l =
    case [t]
l of
      t
p:t
q:[t]
_ -> (t
p,t
q) forall a. a -> [a] -> [a]
: forall n t. Integral n => n -> [t] -> [(t, t)]
genericAdj2 n
n (forall i a. Integral i => i -> [a] -> [a]
genericDrop n
n [t]
l)
      [t]
_ -> []

-- | Adjacent elements of list, at indicated distance, as pairs.
--
-- > adj2 1 [1..5] == [(1,2),(2,3),(3,4),(4,5)]
-- > let l = [1..5] in zip l (tail l) == adj2 1 l
-- > adj2 2 [1..4] == [(1,2),(3,4)]
-- > adj2 3 [1..5] == [(1,2),(4,5)]
adj2 :: Int -> [t] -> [(t,t)]
adj2 :: forall t. Int -> [t] -> [(t, t)]
adj2 = forall n t. Integral n => n -> [t] -> [(t, t)]
genericAdj2

-- | Append first /n/-elements to end of list.
--
-- > close 1 [1..3] == [1,2,3,1]
close :: Int -> [a] -> [a]
close :: forall a. Int -> [a] -> [a]
close Int
k [a]
x = [a]
x forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
k [a]
x

-- | 'adj2' '.' 'close' 1.
--
-- > adj2_cyclic 1 [1..3] == [(1,2),(2,3),(3,1)]
adj2_cyclic :: Int -> [t] -> [(t,t)]
adj2_cyclic :: forall t. Int -> [t] -> [(t, t)]
adj2_cyclic Int
n = forall t. Int -> [t] -> [(t, t)]
adj2 Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
close Int
1

-- | Adjacent triples.
--
-- > adj3 3 [1..6] == [(1,2,3),(4,5,6)]
adj3 :: Int -> [t] -> [(t,t,t)]
adj3 :: forall t. Int -> [t] -> [(t, t, t)]
adj3 Int
n [t]
l =
  case [t]
l of
      t
p:t
q:t
r:[t]
_ -> (t
p,t
q,t
r) forall a. a -> [a] -> [a]
: forall t. Int -> [t] -> [(t, t, t)]
adj3 Int
n (forall a. Int -> [a] -> [a]
drop Int
n [t]
l)
      [t]
_ -> []

-- | 'adj3' '.' 'close' 2.
--
-- > adj3_cyclic 1 [1..4] == [(1,2,3),(2,3,4),(3,4,1),(4,1,2)]
adj3_cyclic :: Int -> [t] -> [(t,t,t)]
adj3_cyclic :: forall t. Int -> [t] -> [(t, t, t)]
adj3_cyclic Int
n = forall t. Int -> [t] -> [(t, t, t)]
adj3 Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
close Int
2

{- | Adjacent quadruples.

> adj4 2 [1..8] == [(1,2,3,4),(3,4,5,6),(5,6,7,8)]
> adj4 4 [1..8] == [(1,2,3,4),(5,6,7,8)]
-}
adj4 :: Int -> [t] -> [(t,t,t,t)]
adj4 :: forall t. Int -> [t] -> [(t, t, t, t)]
adj4 Int
n [t]
l =
  case [t]
l of
      t
p:t
q:t
r:t
s:[t]
_ -> (t
p,t
q,t
r,t
s) forall a. a -> [a] -> [a]
: forall t. Int -> [t] -> [(t, t, t, t)]
adj4 Int
n (forall a. Int -> [a] -> [a]
drop Int
n [t]
l)
      [t]
_ -> []

-- | Interleave elements of /p/ and /q/.  If not of equal length elements are discarded.
--
-- > interleave [1..3] [4..6] == [1,4,2,5,3,6]
-- > interleave ".+-" "abc" == ".a+b-c"
-- > interleave [1..3] [] == []
interleave :: [a] -> [a] -> [a]
interleave :: forall a. [a] -> [a] -> [a]
interleave [a]
p = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
i a
j -> [a
i, a
j]) [a]
p -- concatMap (\(i, j) -> [i, j]) . zip p

-- | Interleave list of lists.  Allows lists to be of non-equal lenghts.
--
-- > interleave_set ["abcd","efgh","ijkl"] == "aeibfjcgkdhl"
-- > interleave_set ["abc","defg","hijkl"] == "adhbeicfjgkl"
interleave_set :: [[a]] -> [a]
interleave_set :: forall a. [[a]] -> [a]
interleave_set = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose

{-
import Safe {- safe -}

interleave_set l =
    case mapMaybe headMay l of
      [] -> []
      r -> r ++ interleave_set (mapMaybe tailMay l)
-}

-- | De-interleave /n/ lists.
--
-- > deinterleave 2 ".a+b-c" == [".+-","abc"]
-- > deinterleave 3 "aeibfjcgkdhl" == ["abcd","efgh","ijkl"]
deinterleave :: Int -> [a] -> [[a]]
deinterleave :: forall a. Int -> [a] -> [[a]]
deinterleave Int
n = forall a. [[a]] -> [[a]]
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
S.chunksOf Int
n

-- | Special case for two-part deinterleaving.
--
-- > deinterleave2 ".a+b-c" == (".+-","abc")
deinterleave2 :: [t] -> ([t], [t])
deinterleave2 :: forall t. [t] -> ([t], [t])
deinterleave2 =
    let f :: [b] -> [(b, b)]
f [b]
l =
            case [b]
l of
              b
p:b
q:[b]
l' -> (b
p,b
q) forall a. a -> [a] -> [a]
: [b] -> [(b, b)]
f [b]
l'
              [b]
_ -> []
    in forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [b] -> [(b, b)]
f

{-
deinterleave2 =
    let f p q l =
            case l of
              [] -> (reverse p,reverse q)
              [a] -> (reverse (a:p),reverse q)
              a:b:l' -> rec (a:p) (b:q) l'
    in f [] []
-}

-- | Variant that continues with the longer input.
--
-- > interleave_continue ".+-" "abc" == ".a+b-c"
-- > interleave_continue [1..3] [] == [1..3]
-- > interleave_continue [] [1..3] == [1..3]
interleave_continue :: [a] -> [a] -> [a]
interleave_continue :: forall a. [a] -> [a] -> [a]
interleave_continue [a]
p [a]
q =
    case ([a]
p,[a]
q) of
      ([],[a]
_) -> [a]
q
      ([a]
_,[]) -> [a]
p
      (a
i:[a]
p',a
j:[a]
q') -> a
i forall a. a -> [a] -> [a]
: a
j forall a. a -> [a] -> [a]
: forall a. [a] -> [a] -> [a]
interleave_continue [a]
p' [a]
q'

-- | 'interleave' of 'rotate_left' by /i/ and /j/.
--
-- > interleave_rotations 9 3 [1..13] == [10,4,11,5,12,6,13,7,1,8,2,9,3,10,4,11,5,12,6,13,7,1,8,2,9,3]
interleave_rotations :: Int -> Int -> [b] -> [b]
interleave_rotations :: forall a. Int -> Int -> [a] -> [a]
interleave_rotations Int
i Int
j [b]
s = forall a. [a] -> [a] -> [a]
interleave (forall a. Int -> [a] -> [a]
rotate_left Int
i [b]
s) (forall a. Int -> [a] -> [a]
rotate_left Int
j [b]
s)

-- | 'unzip', apply /f1/ and /f2/ and 'zip'.
rezip :: ([t] -> [u]) -> ([v] -> [w]) -> [(t,v)] -> [(u,w)]
rezip :: forall t u v w.
([t] -> [u]) -> ([v] -> [w]) -> [(t, v)] -> [(u, w)]
rezip [t] -> [u]
f1 [v] -> [w]
f2 [(t, v)]
l = let ([t]
p,[v]
q) = forall a b. [(a, b)] -> ([a], [b])
unzip [(t, v)]
l in forall a b. [a] -> [b] -> [(a, b)]
zip ([t] -> [u]
f1 [t]
p) ([v] -> [w]
f2 [v]
q)

-- | Generalised histogram, with equality function for grouping and comparison function for sorting.
generic_histogram_by :: Integral i => (a -> a-> Bool) -> Maybe (a -> a-> Ordering) -> [a] -> [(a,i)]
generic_histogram_by :: forall i a.
Integral i =>
(a -> a -> Bool) -> Maybe (a -> a -> Ordering) -> [a] -> [(a, i)]
generic_histogram_by a -> a -> Bool
eq_f Maybe (a -> a -> Ordering)
cmp_f [a]
x =
    let g :: [[a]]
g = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
eq_f (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
x (forall a. (a -> a -> Ordering) -> [a] -> [a]
`sortBy` [a]
x) Maybe (a -> a -> Ordering)
cmp_f)
    in forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head [[a]]
g) (forall a b. (a -> b) -> [a] -> [b]
map forall i a. Num i => [a] -> i
genericLength [[a]]
g)

-- | Type specialised 'generic_histogram_by'.
histogram_by :: (a -> a-> Bool) -> Maybe (a -> a-> Ordering) -> [a] -> [(a,Int)]
histogram_by :: forall a.
(a -> a -> Bool) -> Maybe (a -> a -> Ordering) -> [a] -> [(a, Int)]
histogram_by = forall i a.
Integral i =>
(a -> a -> Bool) -> Maybe (a -> a -> Ordering) -> [a] -> [(a, i)]
generic_histogram_by

-- | Count occurences of elements in list, 'histogram_by' of '==' and 'compare'.
generic_histogram :: (Ord a,Integral i) => [a] -> [(a,i)]
generic_histogram :: forall a i. (Ord a, Integral i) => [a] -> [(a, i)]
generic_histogram = forall i a.
Integral i =>
(a -> a -> Bool) -> Maybe (a -> a -> Ordering) -> [a] -> [(a, i)]
generic_histogram_by forall a. Eq a => a -> a -> Bool
(==) (forall a. a -> Maybe a
Just forall a. Ord a => a -> a -> Ordering
compare)

-- | Type specialised 'generic_histogram'.  Elements will be in ascending order.
--
-- > map histogram ["","hohoh","yxx"] == [[],[('h',3),('o',2)],[('x',2),('y',1)]]
histogram :: Ord a => [a] -> [(a,Int)]
histogram :: forall a. Ord a => [a] -> [(a, Int)]
histogram = forall a i. (Ord a, Integral i) => [a] -> [(a, i)]
generic_histogram

-- | Join two histograms, which must be sorted.
--
-- > histogram_join (zip "ab" [1,1]) (zip "bc" [1,1]) == zip "abc" [1,2,1]
histogram_join :: Ord a => [(a,Int)] -> [(a,Int)] -> [(a,Int)]
histogram_join :: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, Int)]
histogram_join [(a, Int)]
p [(a, Int)]
q =
  let f :: (a, b) -> (a, b) -> Maybe (a, b)
f (a
e1,b
n1) (a
e2,b
n2) = if a
e1 forall a. Eq a => a -> a -> Bool
== a
e2 then forall a. a -> Maybe a
Just (a
e1,b
n1 forall a. Num a => a -> a -> a
+ b
n2) else forall a. Maybe a
Nothing
  in case ([(a, Int)]
p,[(a, Int)]
q) of
       ([(a, Int)]
_,[]) -> [(a, Int)]
p
       ([],[(a, Int)]
_) -> [(a, Int)]
q
       ((a, Int)
p1:[(a, Int)]
p',(a, Int)
q1:[(a, Int)]
q') -> case forall {a} {b}. (Eq a, Num b) => (a, b) -> (a, b) -> Maybe (a, b)
f (a, Int)
p1 (a, Int)
q1 of
                          Just (a, Int)
r -> (a, Int)
r forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, Int)]
histogram_join [(a, Int)]
p' [(a, Int)]
q'
                          Maybe (a, Int)
Nothing -> if (a, Int)
p1 forall a. Ord a => a -> a -> Bool
< (a, Int)
q1
                                     then (a, Int)
p1 forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, Int)]
histogram_join [(a, Int)]
p' [(a, Int)]
q
                                     else (a, Int)
q1 forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, Int)]
histogram_join [(a, Int)]
p [(a, Int)]
q'

-- | 'foldr' of 'histogram_join'.
--
-- > let f x = zip x (repeat 1) in histogram_merge (map f ["ab","bcd","de"]) == zip "abcde" [1,2,1,2,1]
histogram_merge :: Ord a => [[(a,Int)]] -> [(a,Int)]
histogram_merge :: forall a. Ord a => [[(a, Int)]] -> [(a, Int)]
histogram_merge = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, Int)]
histogram_join []

-- | Given (k,#) histogram where k is enumerable generate filled histogram with 0 for empty k.
--
-- > histogram_fill (histogram "histogram") == zip ['a'..'t'] [1,0,0,0,0,0,1,1,1,0,0,0,1,0,1,0,0,1,1,1]
histogram_fill :: (Ord a, Enum a) => [(a,Int)] -> [(a,Int)]
histogram_fill :: forall a. (Ord a, Enum a) => [(a, Int)] -> [(a, Int)]
histogram_fill [(a, Int)]
h =
  let k :: [a]
k = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, Int)]
h
      e :: [a]
e = [forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [a]
k .. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
k]
      f :: a -> Int
f a
x = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, Int)]
h)
  in forall a b. [a] -> [b] -> [(a, b)]
zip [a]
e (forall a b. (a -> b) -> [a] -> [b]
map a -> Int
f [a]
e)

{- | Given two histograms p & q (sorted by key) make composite
histogram giving for all keys the counts for (p,q).

> r = zip "ABCDE" (zip [4,3,2,1,0] [2,3,4,0,5])
> histogram_composite (zip "ABCD" [4,3,2,1]) (zip "ABCE" [2,3,4,5]) == r
-}
histogram_composite :: Ord a => [(a,Int)] -> [(a,Int)] -> [(a,(Int,Int))]
histogram_composite :: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, (Int, Int))]
histogram_composite [(a, Int)]
p [(a, Int)]
q =
  case ([(a, Int)]
p,[(a, Int)]
q) of
    ([],[(a, Int)]
_) -> forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,Int
n) -> (a
k,(Int
0,Int
n))) [(a, Int)]
q
    ([(a, Int)]
_,[]) -> forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,Int
n) -> (a
k,(Int
n,Int
0))) [(a, Int)]
p
    ((a
k1,Int
n1):[(a, Int)]
p',(a
k2,Int
n2):[(a, Int)]
q') -> case forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
                                 Ordering
LT -> (a
k1,(Int
n1,Int
0)) forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, (Int, Int))]
histogram_composite [(a, Int)]
p' [(a, Int)]
q
                                 Ordering
EQ -> (a
k1,(Int
n1,Int
n2)) forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, (Int, Int))]
histogram_composite [(a, Int)]
p' [(a, Int)]
q'
                                 Ordering
GT -> (a
k2,(Int
0,Int
n2)) forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, (Int, Int))]
histogram_composite [(a, Int)]
p [(a, Int)]
q'

{- | Apply '-' at count of 'histogram_composite', ie. 0 indicates
equal number at p and q, negative indicates more elements at p than
q and positive more elements at q than p.

> histogram_diff (zip "ABCD" [4,3,2,1]) (zip "ABCE" [2,3,4,5]) == zip "ABCDE" [-2,0,2,-1,5]
-}
histogram_diff :: Ord a => [(a,Int)] -> [(a,Int)] -> [(a,Int)]
histogram_diff :: forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, Int)]
histogram_diff [(a, Int)]
p = forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,(Int
n,Int
m)) -> (a
k,Int
m forall a. Num a => a -> a -> a
- Int
n)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [(a, Int)] -> [(a, Int)] -> [(a, (Int, Int))]
histogram_composite [(a, Int)]
p

-- | Elements that appear more than once in the input given equality predicate.
duplicates_by :: Ord a => (a -> a -> Bool) -> [a] -> [a]
duplicates_by :: forall a. Ord a => (a -> a -> Bool) -> [a] -> [a]
duplicates_by a -> a -> Bool
f = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_,Int
n) -> Int
n forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> a -> Bool) -> Maybe (a -> a -> Ordering) -> [a] -> [(a, Int)]
histogram_by a -> a -> Bool
f (forall a. a -> Maybe a
Just forall a. Ord a => a -> a -> Ordering
compare)

-- | 'duplicates_by' of '=='.
--
-- > map duplicates ["duplicates","redundant"] == ["","dn"]
duplicates :: Ord a => [a] -> [a]
duplicates :: forall a. Ord a => [a] -> [a]
duplicates = forall a. Ord a => (a -> a -> Bool) -> [a] -> [a]
duplicates_by forall a. Eq a => a -> a -> Bool
(==)

-- | List segments of length /i/ at distance /j/.
--
-- > segments 2 1 [1..5] == [[1,2],[2,3],[3,4],[4,5]]
-- > segments 2 2 [1..5] == [[1,2],[3,4]]
segments :: Int -> Int -> [a] -> [[a]]
segments :: forall a. Int -> Int -> [a] -> [[a]]
segments Int
i Int
j [a]
p =
    let q :: [a]
q = forall a. Int -> [a] -> [a]
take Int
i [a]
p
        p' :: [a]
p' = forall a. Int -> [a] -> [a]
drop Int
j [a]
p
    in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
q forall a. Eq a => a -> a -> Bool
/= Int
i then [] else [a]
q forall a. a -> [a] -> [a]
: forall a. Int -> Int -> [a] -> [[a]]
segments Int
i Int
j [a]
p'

-- | 'foldl1' 'intersect'.
--
-- > intersect_l [[1,2],[1,2,3],[1,2,3,4]] == [1,2]
intersect_l :: Eq a => [[a]] -> [a]
intersect_l :: forall a. Eq a => [[a]] -> [a]
intersect_l = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Eq a => [a] -> [a] -> [a]
intersect

-- | 'foldl1' 'union'.
--
-- > sort (union_l [[1,3],[2,3],[3]]) == [1,2,3]
union_l :: Eq a => [[a]] -> [a]
union_l :: forall a. Eq a => [[a]] -> [a]
union_l = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Eq a => [a] -> [a] -> [a]
union

-- | Intersection of adjacent elements of list at distance /n/.
--
-- > adj_intersect 1 [[1,2],[1,2,3],[1,2,3,4]] == [[1,2],[1,2,3]]
adj_intersect :: Eq a => Int -> [[a]] -> [[a]]
adj_intersect :: forall a. Eq a => Int -> [[a]] -> [[a]]
adj_intersect Int
n = forall a b. (a -> b) -> [a] -> [b]
map forall a. Eq a => [[a]] -> [a]
intersect_l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Int -> [a] -> [[a]]
segments Int
2 Int
n

-- | List of cycles at distance /n/.
--
-- > cycles 2 [1..6] == [[1,3,5],[2,4,6]]
-- > cycles 3 [1..9] == [[1,4,7],[2,5,8],[3,6,9]]
-- > cycles 4 [1..8] == [[1,5],[2,6],[3,7],[4,8]]
cycles :: Int -> [a] -> [[a]]
cycles :: forall a. Int -> [a] -> [[a]]
cycles Int
n = forall a. [[a]] -> [[a]]
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
S.chunksOf Int
n

-- | Variant of 'filter' that has a predicate to halt processing,
-- ie. 'filter' of 'takeWhile'.
--
-- > filter_halt (even . fst) ((< 5) . snd) (zip [1..] [0..])
filter_halt :: (a -> Bool) -> (a -> Bool) -> [a] -> [a]
filter_halt :: forall a. (a -> Bool) -> (a -> Bool) -> [a] -> [a]
filter_halt a -> Bool
sel a -> Bool
end = forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
sel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
end

-- | Variant of 'Data.List.filter' that retains 'Nothing' as a
-- placeholder for removed elements.
--
-- > filter_maybe even [1..4] == [Nothing,Just 2,Nothing,Just 4]
filter_maybe :: (a -> Bool) -> [a] -> [Maybe a]
filter_maybe :: forall a. (a -> Bool) -> [a] -> [Maybe a]
filter_maybe a -> Bool
f = forall a b. (a -> b) -> [a] -> [b]
map (\a
e -> if a -> Bool
f a
e then forall a. a -> Maybe a
Just a
e else forall a. Maybe a
Nothing)

{- | Select only the elements from the list that lie in the indicated range, which is (inclusive, exclusive).

> filterInRange (3, 5) [1, 1.5 .. 9] == [3.0,3.5,4.0,4.5]
-}
filterInRange :: Ord a => (a, a) -> [a] -> [a]
filterInRange :: forall a. Ord a => (a, a) -> [a] -> [a]
filterInRange (a
lhs, a
rhs) = forall a. (a -> Bool) -> [a] -> [a]
filter (\a
n -> a
n forall a. Ord a => a -> a -> Bool
>= a
lhs Bool -> Bool -> Bool
&& a
n forall a. Ord a => a -> a -> Bool
< a
rhs)

-- | Replace all /p/ with /q/ in /s/.
--
-- > replace "_x_" "-X-" "an _x_ string" == "an -X- string"
-- > replace "ab" "cd" "ab ab cd ab" == "cd cd cd cd"
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace :: forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
p [a]
q [a]
s =
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p
    in case [a]
s of
         [] -> []
         a
c:[a]
s' -> if [a]
p forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
s
                 then [a]
q forall a. [a] -> [a] -> [a]
++ forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
p [a]
q (forall a. Int -> [a] -> [a]
drop Int
n [a]
s)
                 else a
c forall a. a -> [a] -> [a]
: forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
p [a]
q [a]
s'

-- | Replace the /i/th value at /ns/ with /x/.
--
-- > replace_at "test" 2 'n' == "tent"
replace_at :: Integral i => [a] -> i -> a -> [a]
replace_at :: forall i a. Integral i => [a] -> i -> a -> [a]
replace_at [a]
ns i
i a
x =
    let f :: i -> a -> a
f i
j a
y = if i
i forall a. Eq a => a -> a -> Bool
== i
j then a
x else a
y
    in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith i -> a -> a
f [i
0..] [a]
ns

-- | Data.List.stripPrefix, which however hugs doesn't know of.
strip_prefix :: Eq a => [a] -> [a] -> Maybe [a]
strip_prefix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
strip_prefix [a]
lhs [a]
rhs =
  case ([a]
lhs,[a]
rhs) of
    ([], [a]
ys) -> forall a. a -> Maybe a
Just [a]
ys
    ([a]
_, []) -> forall a. Maybe a
Nothing
    (a
x:[a]
xs, a
y:[a]
ys) -> if a
x forall a. Eq a => a -> a -> Bool
== a
y then forall a. Eq a => [a] -> [a] -> Maybe [a]
strip_prefix [a]
xs [a]
ys else forall a. Maybe a
Nothing

-- | 'error' of 'stripPrefix'
strip_prefix_err :: Eq t => [t] -> [t] -> [t]
strip_prefix_err :: forall a. Eq a => [a] -> [a] -> [a]
strip_prefix_err [t]
pfx = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"strip_prefix") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Maybe [a]
strip_prefix [t]
pfx

-- * Association lists

-- | Equivalent to 'groupBy' /eq/ 'on' /f/.
--
-- > group_by_on (==) snd (zip [0..] "abbc") == [[(0,'a')],[(1,'b'),(2,'b')],[(3,'c')]]
group_by_on :: (x -> x -> Bool) -> (t -> x) -> [t] -> [[t]]
group_by_on :: forall x t. (x -> x -> Bool) -> (t -> x) -> [t] -> [[t]]
group_by_on x -> x -> Bool
eq t -> x
f = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (x -> x -> Bool
eq forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` t -> x
f)

-- | 'group_by_on' of '=='.
--
-- > r = [[(1,'a'),(1,'b')],[(2,'c')],[(3,'d'),(3,'e')],[(4,'f')]]
-- > group_on fst (zip [1,1,2,3,3,4] "abcdef") == r
group_on :: Eq x => (a -> x) -> [a] -> [[a]]
group_on :: forall x a. Eq x => (a -> x) -> [a] -> [[a]]
group_on = forall x t. (x -> x -> Bool) -> (t -> x) -> [t] -> [[t]]
group_by_on forall a. Eq a => a -> a -> Bool
(==)

-- | Given an equality predicate and accesors for /key/ and /value/ collate adjacent values.
collate_by_on_adjacent :: (k -> k -> Bool) -> (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
collate_by_on_adjacent :: forall k a v.
(k -> k -> Bool) -> (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_by_on_adjacent k -> k -> Bool
eq a -> k
f a -> v
g =
    let h :: [a] -> (k, [v])
h [a]
l = case [a]
l of
                [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"collate_by_on_adjacent"
                a
l0:[a]
_ -> (a -> k
f a
l0,forall a b. (a -> b) -> [a] -> [b]
map a -> v
g [a]
l)
    in forall a b. (a -> b) -> [a] -> [b]
map [a] -> (k, [v])
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x t. (x -> x -> Bool) -> (t -> x) -> [t] -> [[t]]
group_by_on k -> k -> Bool
eq a -> k
f

-- | 'collate_by_on_adjacent' of '=='
collate_on_adjacent :: Eq k => (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
collate_on_adjacent :: forall k a v. Eq k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_on_adjacent = forall k a v.
(k -> k -> Bool) -> (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_by_on_adjacent forall a. Eq a => a -> a -> Bool
(==)

-- | 'collate_on_adjacent' of 'fst' and 'snd'.
--
-- > collate_adjacent (zip "TDD" "xyz") == [('T',"x"),('D',"yz")]
collate_adjacent :: Eq a => [(a,b)] -> [(a,[b])]
collate_adjacent :: forall a b. Eq a => [(a, b)] -> [(a, [b])]
collate_adjacent = forall k a v. Eq k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_on_adjacent forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd

-- | Data.List.sortOn, which however hugs doesn't know of.
sort_on :: Ord b => (a -> b) -> [a] -> [a]
sort_on :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sort_on a -> b
f = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> let y :: b
y = a -> b
f a
x in b
y seq :: forall a b. a -> b -> b
`seq` (b
y, a
x))

-- | 'sortOn' prior to 'collate_on_adjacent'.
--
-- > r = [('A',"a"),('B',"bd"),('C',"ce"),('D',"f")]
-- > collate_on fst snd (zip "ABCBCD" "abcdef") == r
collate_on :: Ord k => (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
collate_on :: forall k a v. Ord k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_on a -> k
f a -> v
g = forall k a v. Eq k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_on_adjacent a -> k
f a -> v
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sort_on a -> k
f

-- | 'collate_on' of 'fst' and 'snd'.
--
-- > collate (zip "TDD" "xyz") == [('D',"yz"),('T',"x")]
-- > collate (zip [1,2,1] "abc") == [(1,"ac"),(2,"b")]
collate :: Ord a => [(a,b)] -> [(a,[b])]
collate :: forall a b. Ord a => [(a, b)] -> [(a, [b])]
collate = forall k a v. Ord k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
collate_on forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd

-- | Reverse of 'collate', inverse if order is not considered.
--
-- > uncollate [(1,"ac"),(2,"b")] == zip [1,1,2] "acb"
uncollate :: [(k,[v])] -> [(k,v)]
uncollate :: forall k v. [(k, [v])] -> [(k, v)]
uncollate = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(k
k,[v]
v) -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat k
k) [v]
v)

-- | Make /assoc/ list with given /key/.
--
-- > with_key 'a' [1..3] == [('a',1),('a',2),('a',3)]
with_key :: k -> [v] -> [(k,v)]
with_key :: forall k v. k -> [v] -> [(k, v)]
with_key k
h = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat k
h)

-- | Left biased merge of association lists /p/ and /q/.
--
-- > assoc_merge [(5,"a"),(3,"b")] [(5,"A"),(7,"C")] == [(5,"a"),(3,"b"),(7,"C")]
assoc_merge :: Eq k => [(k,v)] -> [(k,v)] -> [(k,v)]
assoc_merge :: forall k v. Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
assoc_merge [(k, v)]
p [(k, v)]
q =
    let p_k :: [k]
p_k = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(k, v)]
p
        q' :: [(k, v)]
q' = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [k]
p_k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(k, v)]
q
    in [(k, v)]
p forall a. [a] -> [a] -> [a]
++ [(k, v)]
q'

-- | Keys are in ascending order, the entry retrieved is the rightmose with
--   a key less than or equal to the key requested.
--   If the key requested is less than the initial key, or the list is empty, returns 'Nothing'.
--
-- > let m = [(1,'a'),(4,'x'),(4,'b'),(5,'c')]
-- > mapMaybe (ord_map_locate m) [1 .. 6] == [(1,'a'),(1,'a'),(1,'a'),(4,'b'),(5,'c'),(5,'c')]
-- > ord_map_locate m 0 == Nothing
ord_map_locate :: Ord k => [(k,v)] -> k -> Maybe (k,v)
ord_map_locate :: forall k v. Ord k => [(k, v)] -> k -> Maybe (k, v)
ord_map_locate [(k, v)]
mp k
i =
    let f :: (k, b) -> [(k, b)] -> Maybe (k, b)
f (k
k0,b
v0) [(k, b)]
xs =
          case [(k, b)]
xs of
            [] -> if k
i forall a. Ord a => a -> a -> Bool
>= k
k0 then forall a. a -> Maybe a
Just (k
k0,b
v0) else forall a. HasCallStack => [Char] -> a
error [Char]
"ord_map_locate?"
            ((k
k1,b
v1):[(k, b)]
xs') -> if k
i forall a. Ord a => a -> a -> Bool
>= k
k0 Bool -> Bool -> Bool
&& k
i forall a. Ord a => a -> a -> Bool
< k
k1 then forall a. a -> Maybe a
Just (k
k0,b
v0) else (k, b) -> [(k, b)] -> Maybe (k, b)
f (k
k1,b
v1) [(k, b)]
xs'
    in case [(k, v)]
mp of
         [] -> forall a. Maybe a
Nothing
         (k
k0,v
v0):[(k, v)]
mp' -> if k
i forall a. Ord a => a -> a -> Bool
< k
k0 then forall a. Maybe a
Nothing else forall {b}. (k, b) -> [(k, b)] -> Maybe (k, b)
f (k
k0,v
v0) [(k, v)]
mp'

-- * Δ

-- | Intervals to values, zero is /n/.
--
-- > dx_d 5 [1,2,3] == [5,6,8,11]
dx_d :: (Num a) => a -> [a] -> [a]
dx_d :: forall a. Num a => a -> [a] -> [a]
dx_d = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+)

-- | Variant that takes initial value and separates final value.  This
-- is an appropriate function for 'mapAccumL'.
--
-- > dx_d' 5 [1,2,3] == (11,[5,6,8])
-- > dx_d' 0 [1,1,1] == (3,[0,1,2])
dx_d' :: Num t => t -> [t] -> (t,[t])
dx_d' :: forall t. Num t => t -> [t] -> (t, [t])
dx_d' t
n [t]
l =
    case forall a. [a] -> [a]
reverse (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) t
n [t]
l) of
      t
e:[t]
r -> (t
e,forall a. [a] -> [a]
reverse [t]
r)
      [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"dx_d'"

-- | Integration with /f/, ie. apply flip of /f/ between elements of /l/.
--
-- > d_dx_by (,) "abcd" == [('b','a'),('c','b'),('d','c')]
-- > d_dx_by (-) [0,2,4,1,0] == [2,2,-3,-1]
-- > d_dx_by (-) [2,3,0,4,1] == [1,-3,4,-3]
d_dx_by :: (t -> t -> u) -> [t] -> [u]
d_dx_by :: forall t u. (t -> t -> u) -> [t] -> [u]
d_dx_by t -> t -> u
f [t]
l = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
l then [] else forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith t -> t -> u
f (forall a. [a] -> [a]
tail [t]
l) [t]
l

-- | Integrate, 'd_dx_by' '-', ie. pitch class segment to interval sequence.
--
-- > d_dx [5,6,8,11] == [1,2,3]
-- > d_dx [] == []
d_dx :: (Num a) => [a] -> [a]
d_dx :: forall a. Num a => [a] -> [a]
d_dx = forall t u. (t -> t -> u) -> [t] -> [u]
d_dx_by (-)

-- | Elements of /p/ not in /q/.
--
-- > [1,2,3] `difference` [1,2] == [3]
difference :: Eq a => [a] -> [a] -> [a]
difference :: forall a. Eq a => [a] -> [a] -> [a]
difference [a]
p [a]
q = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
q) [a]
p

-- | Is /p/ a subset of /q/, ie. is 'intersect' of /p/ and /q/ '==' /p/.
--
-- > map (is_subset [1,2]) [[1],[1,2],[1,2,3]] == [False,True,True]
is_subset :: Eq a => [a] -> [a] -> Bool
is_subset :: forall a. Eq a => [a] -> [a] -> Bool
is_subset [a]
p [a]
q = [a]
p forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a]
q forall a. Eq a => a -> a -> Bool
== [a]
p

-- | Is /p/ a proper subset of /q/, 'is_subset' and 'not' equal.
--
-- > map (is_proper_subset [1,2]) [[1],[1,2],[1,2,3]] == [False,False,True]
is_proper_subset :: Eq a => [a] -> [a] -> Bool
is_proper_subset :: forall a. Eq a => [a] -> [a] -> Bool
is_proper_subset [a]
p [a]
q = forall a. Eq a => [a] -> [a] -> Bool
is_subset [a]
p [a]
q Bool -> Bool -> Bool
&& [a]
p forall a. Eq a => a -> a -> Bool
/= [a]
p forall a. Eq a => [a] -> [a] -> [a]
`union` [a]
q

-- | Is /p/ a superset of /q/, ie. 'flip' 'is_subset'.
--
-- > is_superset [1,2,3] [1,2] == True
is_superset :: Eq a => [a] -> [a] -> Bool
is_superset :: forall a. Eq a => [a] -> [a] -> Bool
is_superset = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> Bool
is_subset

-- | Is /p/ a subsequence of /q/, ie. synonym for 'isInfixOf'.
--
-- > subsequence [1,2] [1,2,3] == True
subsequence :: Eq a => [a] -> [a] -> Bool
subsequence :: forall a. Eq a => [a] -> [a] -> Bool
subsequence = forall a. Eq a => [a] -> [a] -> Bool
isInfixOf

-- | Erroring variant of 'findIndex'.
findIndex_err :: (a -> Bool) -> [a] -> Int
findIndex_err :: forall a. (a -> Bool) -> [a] -> Int
findIndex_err a -> Bool
f = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"findIndex?") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
f

-- | Erroring variant of 'elemIndex'.
elemIndex_err :: Eq a => a -> [a] -> Int
elemIndex_err :: forall a. Eq a => a -> [a] -> Int
elemIndex_err a
x = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"ix_of") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x

-- | Variant of 'elemIndices' that requires /e/ to be unique in /p/.
--
-- > elem_index_unique 'a' "abcda" == undefined
elem_index_unique :: Eq a => a -> [a] -> Int
elem_index_unique :: forall a. Eq a => a -> [a] -> Int
elem_index_unique a
e [a]
p =
    case forall a. Eq a => a -> [a] -> [Int]
elemIndices a
e [a]
p of
      [Int
i] -> Int
i
      [Int]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"elem_index_unique"

-- | Lookup that errors and prints message and key.
lookup_err_msg :: (Eq k,Show k) => String -> k -> [(k,v)] -> v
lookup_err_msg :: forall k v. (Eq k, Show k) => [Char] -> k -> [(k, v)] -> v
lookup_err_msg [Char]
err k
k = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error ([Char]
err forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show k
k)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup k
k

-- | Error variant.
lookup_err :: Eq k => k -> [(k,v)] -> v
lookup_err :: forall k v. Eq k => k -> [(k, v)] -> v
lookup_err k
n = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"lookup") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup k
n

-- | 'lookup' variant with default value.
lookup_def :: Eq k => k -> v -> [(k,v)] -> v
lookup_def :: forall k v. Eq k => k -> v -> [(k, v)] -> v
lookup_def k
k v
d = forall a. a -> Maybe a -> a
fromMaybe v
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup k
k

-- | If /l/ is empty 'Nothing', else 'Just' /l/.
non_empty :: [t] -> Maybe [t]
non_empty :: forall t. [t] -> Maybe [t]
non_empty [t]
l = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
l then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [t]
l

-- | Variant on 'filter' that selects all matches.
--
-- > lookup_set 1 (zip [1,2,3,4,1] "abcde") == Just "ae"
lookup_set :: Eq k => k -> [(k,v)] -> Maybe [v]
lookup_set :: forall k v. Eq k => k -> [(k, v)] -> Maybe [v]
lookup_set k
k = forall t. [t] -> Maybe [t]
non_empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== k
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | Erroring variant.
lookup_set_err :: Eq k => k -> [(k,v)] -> [v]
lookup_set_err :: forall k v. Eq k => k -> [(k, v)] -> [v]
lookup_set_err k
k = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"lookup_set?") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Eq k => k -> [(k, v)] -> Maybe [v]
lookup_set k
k

-- | Reverse lookup.
--
-- > reverse_lookup 'c' [] == Nothing
-- > reverse_lookup 'b' (zip [1..] ['a'..]) == Just 2
-- > lookup 2 (zip [1..] ['a'..]) == Just 'b'
reverse_lookup :: Eq v => v -> [(k,v)] -> Maybe k
reverse_lookup :: forall v k. Eq v => v -> [(k, v)] -> Maybe k
reverse_lookup v
k = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== v
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- | Erroring variant.
reverse_lookup_err :: Eq v => v -> [(k,v)] -> k
reverse_lookup_err :: forall v k. Eq v => v -> [(k, v)] -> k
reverse_lookup_err v
k = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"reverse_lookup") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v k. Eq v => v -> [(k, v)] -> Maybe k
reverse_lookup v
k

{-
reverse_lookup :: Eq b => b -> [(a,b)] -> Maybe a
reverse_lookup key ls =
    case ls of
      [] -> Nothing
      (x,y):ls' -> if key == y then Just x else reverse_lookup key ls'
-}

-- | Erroring variant of 'find'.
find_err :: (t -> Bool) -> [t] -> t
find_err :: forall t. (t -> Bool) -> [t] -> t
find_err t -> Bool
f = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"find") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find t -> Bool
f

-- | Basis of 'find_bounds_scl', indicates if /x/ is to the left or
-- right of the list, and if to the right whether equal or not.
-- 'Right' values will be correct if the list is not ascending,
-- however 'Left' values only make sense for ascending ranges.
--
-- > map (find_bounds_cmp compare [(0,1),(1,2)]) [-1,0,1,2,3]
find_bounds_cmp :: (t -> s -> Ordering) -> [(t,t)] -> s -> Either ((t,t),Ordering) (t,t)
find_bounds_cmp :: forall t s.
(t -> s -> Ordering)
-> [(t, t)] -> s -> Either ((t, t), Ordering) (t, t)
find_bounds_cmp t -> s -> Ordering
f [(t, t)]
l s
x =
    let g :: (t, t) -> Bool
g (t
p,t
q) = t -> s -> Ordering
f t
p s
x forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& t -> s -> Ordering
f t
q s
x forall a. Eq a => a -> a -> Bool
== Ordering
GT
    in case [(t, t)]
l of
         [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"find_bounds_cmp: nil"
         [(t
p,t
q)] -> if (t, t) -> Bool
g (t
p,t
q) then forall a b. b -> Either a b
Right (t
p,t
q) else forall a b. a -> Either a b
Left ((t
p,t
q),t -> s -> Ordering
f t
q s
x)
         (t
p,t
q):[(t, t)]
l' -> if t -> s -> Ordering
f t
p s
x forall a. Eq a => a -> a -> Bool
== Ordering
GT
                     then forall a b. a -> Either a b
Left ((t
p,t
q),Ordering
GT)
                     else if (t, t) -> Bool
g (t
p,t
q) then forall a b. b -> Either a b
Right (t
p,t
q) else forall t s.
(t -> s -> Ordering)
-> [(t, t)] -> s -> Either ((t, t), Ordering) (t, t)
find_bounds_cmp t -> s -> Ordering
f [(t, t)]
l' s
x

-- | Decide if value is nearer the left or right value of a range, return 'fst' or 'snd'.
decide_nearest_f :: Ord o => Bool -> (p -> o) -> (p,p) -> ((x,x) -> x)
decide_nearest_f :: forall o p x. Ord o => Bool -> (p -> o) -> (p, p) -> (x, x) -> x
decide_nearest_f Bool
bias_left p -> o
f (p
p,p
q) =
  case forall a. Ord a => a -> a -> Ordering
compare (p -> o
f p
p) (p -> o
f p
q) of
    Ordering
LT -> forall a b. (a, b) -> a
fst
    Ordering
EQ -> if Bool
bias_left then forall a b. (a, b) -> a
fst else forall a b. (a, b) -> b
snd
    Ordering
GT -> forall a b. (a, b) -> b
snd

-- | 'decide_nearest_f' with 'abs' of '-' as measure.
--
-- > (decide_nearest True 2 (1,3)) ("left","right") == "left"
decide_nearest :: (Num o,Ord o) => Bool -> o -> (o,o) -> ((x,x) -> x)
decide_nearest :: forall o x. (Num o, Ord o) => Bool -> o -> (o, o) -> (x, x) -> x
decide_nearest Bool
bias_left o
x = forall o p x. Ord o => Bool -> (p -> o) -> (p, p) -> (x, x) -> x
decide_nearest_f Bool
bias_left (forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o
x forall a. Num a => a -> a -> a
-))

-- | /sel_f/ gets comparison key from /t/.
find_nearest_by :: (Ord n,Num n) => (t -> n) -> Bool -> [t] -> n -> t
find_nearest_by :: forall n t. (Ord n, Num n) => (t -> n) -> Bool -> [t] -> n -> t
find_nearest_by t -> n
sel_f Bool
bias_left [t]
l n
x =
  let cmp_f :: t -> n -> Ordering
cmp_f t
i n
j = forall a. Ord a => a -> a -> Ordering
compare (t -> n
sel_f t
i) n
j
  in case forall t s.
(t -> s -> Ordering)
-> [(t, t)] -> s -> Either ((t, t), Ordering) (t, t)
find_bounds_cmp t -> n -> Ordering
cmp_f (forall t. Int -> [t] -> [(t, t)]
adj2 Int
1 [t]
l) n
x of
       Left ((t
p,t
_),Ordering
GT) -> t
p
       Left ((t
_,t
q),Ordering
_) -> t
q
       Right (t
p,t
q) -> forall o x. (Num o, Ord o) => Bool -> o -> (o, o) -> (x, x) -> x
decide_nearest Bool
bias_left n
x (t -> n
sel_f t
p,t -> n
sel_f t
q) (t
p,t
q)

-- | Find the number that is nearest the requested value in an
-- ascending list of numbers.
--
-- > map (find_nearest_err True [0,3.5,4,7]) [-1,1,3,5,7,9] == [0,0,3.5,4,7,7]
find_nearest_err :: (Num n,Ord n) => Bool -> [n] -> n -> n
find_nearest_err :: forall n. (Num n, Ord n) => Bool -> [n] -> n -> n
find_nearest_err = forall n t. (Ord n, Num n) => (t -> n) -> Bool -> [t] -> n -> t
find_nearest_by forall a. a -> a
id

-- | 'find_nearest_err' allowing 'null' input list (which returns 'Nothing')
find_nearest :: (Num n,Ord n) => Bool -> [n] -> n -> Maybe n
find_nearest :: forall n. (Num n, Ord n) => Bool -> [n] -> n -> Maybe n
find_nearest Bool
bias_left [n]
l n
x = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [n]
l then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall n. (Num n, Ord n) => Bool -> [n] -> n -> n
find_nearest_err Bool
bias_left [n]
l n
x)

-- | Basis of 'find_bounds'.  There is an option to consider the last
-- element specially, and if equal to the last span is given.
--
-- scl=special-case-last
find_bounds_scl :: Bool -> (t -> s -> Ordering) -> [(t,t)] -> s -> Maybe (t,t)
find_bounds_scl :: forall t s.
Bool -> (t -> s -> Ordering) -> [(t, t)] -> s -> Maybe (t, t)
find_bounds_scl Bool
scl t -> s -> Ordering
f [(t, t)]
l s
x =
    case forall t s.
(t -> s -> Ordering)
-> [(t, t)] -> s -> Either ((t, t), Ordering) (t, t)
find_bounds_cmp t -> s -> Ordering
f [(t, t)]
l s
x of
         Right (t, t)
r -> forall a. a -> Maybe a
Just (t, t)
r
         Left ((t, t)
r,Ordering
EQ) -> if Bool
scl then forall a. a -> Maybe a
Just (t, t)
r else forall a. Maybe a
Nothing
         Either ((t, t), Ordering) (t, t)
_ -> forall a. Maybe a
Nothing

-- | Find adjacent elements of list that bound element under given comparator.
--
-- > let {f = find_bounds True compare [1..5]
-- >     ;r = [Nothing,Just (1,2),Just (3,4),Just (4,5)]}
-- > in map f [0,1,3.5,5] == r
find_bounds :: Bool -> (t -> s -> Ordering) -> [t] -> s -> Maybe (t,t)
find_bounds :: forall t s.
Bool -> (t -> s -> Ordering) -> [t] -> s -> Maybe (t, t)
find_bounds Bool
scl t -> s -> Ordering
f [t]
l = forall t s.
Bool -> (t -> s -> Ordering) -> [(t, t)] -> s -> Maybe (t, t)
find_bounds_scl Bool
scl t -> s -> Ordering
f (forall t. Int -> [t] -> [(t, t)]
adj2 Int
1 [t]
l)

-- | Special case of 'dropRight'.
--
-- > map drop_last ["","?","remove"] == ["","","remov"]
drop_last :: [t] -> [t]
drop_last :: forall a. [a] -> [a]
drop_last [t]
l =
    case [t]
l of
      [] -> []
      [t
_] -> []
      t
e:[t]
l' -> t
e forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
drop_last [t]
l'

-- | Variant of 'drop' from right of list.
--
-- > dropRight 1 [1..9] == [1..8]
dropRight :: Int -> [a] -> [a]
dropRight :: forall a. Int -> [a] -> [a]
dropRight Int
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Variant of 'dropWhile' from right of list.
--
-- > dropWhileRight Data.Char.isDigit "A440" == "A"
dropWhileRight :: (a -> Bool) -> [a] -> [a]
dropWhileRight :: forall a. (a -> Bool) -> [a] -> [a]
dropWhileRight a -> Bool
p = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Data.List.dropWhileEnd, which however hugs doesn't know of.
drop_while_end :: (a -> Bool) -> [a] -> [a]
drop_while_end :: forall a. (a -> Bool) -> [a] -> [a]
drop_while_end a -> Bool
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> if a -> Bool
p a
x Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then [] else a
x forall a. a -> [a] -> [a]
: [a]
xs) []

{- | 'foldr' form of 'dropWhileRight'.

> drop_while_right Data.Char.isDigit "A440" == "A"
-}
drop_while_right :: (a -> Bool) -> [a] -> [a]
drop_while_right :: forall a. (a -> Bool) -> [a] -> [a]
drop_while_right a -> Bool
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> if a -> Bool
p a
x Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then [] else a
xforall a. a -> [a] -> [a]
:[a]
xs) []

-- | 'take' from right.
--
-- > take_right 3 "taking" == "ing"
take_right :: Int -> [a] -> [a]
take_right :: forall a. Int -> [a] -> [a]
take_right Int
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | 'takeWhile' from right.
--
-- > takeWhileRight Data.Char.isDigit "A440" == "440"
takeWhileRight :: (a -> Bool) -> [a] -> [a]
takeWhileRight :: forall a. (a -> Bool) -> [a] -> [a]
takeWhileRight a -> Bool
p = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

{- | 'foldr' form of 'takeWhileRight'.

> take_while_right Data.Char.isDigit "A440" == "440"
-}
take_while_right :: (a -> Bool) -> [a] -> [a]
take_while_right :: forall a. (a -> Bool) -> [a] -> [a]
take_while_right a -> Bool
p =
  forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x (Bool, [a])
xys -> (if a -> Bool
p a
x Bool -> Bool -> Bool
&& forall a b. (a, b) -> a
fst (Bool, [a])
xys then forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. a -> a
id (a
xforall a. a -> [a] -> [a]
:) else forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a b. a -> b -> a
const Bool
False) forall a. a -> a
id) (Bool, [a])
xys) (Bool
True, [])

-- | Variant of 'take' that allows 'Nothing' to indicate the complete list.
--
-- > maybe_take (Just 5) [1 .. ] == [1 .. 5]
-- > maybe_take Nothing [1 .. 9] == [1 .. 9]
maybe_take :: Maybe Int -> [a] -> [a]
maybe_take :: forall a. Maybe Int -> [a] -> [a]
maybe_take Maybe Int
n [a]
l = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
l (forall a. Int -> [a] -> [a]
`take` [a]
l) Maybe Int
n

{- | Take until /f/ is true.  This is not the same as 'not' at
     'takeWhile' because it keeps the last element. It is an error
     if the predicate never succeeds.

> take_until (== 'd') "tender" == "tend"
> takeWhile (not . (== 'd')) "tend" == "ten"
> take_until (== 'd') "seven" == undefined
-}
take_until :: (a -> Bool) -> [a] -> [a]
take_until :: forall a. (a -> Bool) -> [a] -> [a]
take_until a -> Bool
f [a]
l =
  case [a]
l of
    [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"take_until?"
    a
e:[a]
l' -> if a -> Bool
f a
e then [a
e] else a
e forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
take_until a -> Bool
f [a]
l'

-- | Apply /f/ at first element, and /g/ at all other elements.
--
-- > at_head negate id [1..5] == [-1,2,3,4,5]
at_head :: (a -> b) -> (a -> b) -> [a] -> [b]
at_head :: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_head a -> b
f a -> b
g [a]
x =
    case [a]
x of
      [] -> []
      a
e:[a]
x' -> a -> b
f a
e forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map a -> b
g [a]
x'

-- | Apply /f/ at all but last element, and /g/ at last element.
--
-- > at_last (* 2) negate [1..4] == [2,4,6,-4]
at_last :: (a -> b) -> (a -> b) -> [a] -> [b]
at_last :: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_last a -> b
f a -> b
g [a]
x =
    case [a]
x of
      [] -> []
      [a
i] -> [a -> b
g a
i]
      a
i:[a]
x' -> a -> b
f a
i forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_last a -> b
f a -> b
g [a]
x'

-- | Separate list into an initial list and perhaps the last element tuple.
--
-- > separate_last' [] == ([],Nothing)
separate_last' :: [a] -> ([a],Maybe a)
separate_last' :: forall a. [a] -> ([a], Maybe a)
separate_last' [a]
x =
    case forall a. [a] -> [a]
reverse [a]
x of
      [] -> ([],forall a. Maybe a
Nothing)
      a
e:[a]
x' -> (forall a. [a] -> [a]
reverse [a]
x',forall a. a -> Maybe a
Just a
e)

-- | Error on null input.
--
-- > separate_last [1..5] == ([1..4],5)
separate_last :: [a] -> ([a],a)
separate_last :: forall a. [a] -> ([a], a)
separate_last = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"separate_last")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> ([a], Maybe a)
separate_last'

-- | Replace directly repeated elements with 'Nothing'.
--
-- > indicate_repetitions "abba" == [Just 'a',Just 'b',Nothing,Just 'a']
indicate_repetitions :: Eq a => [a] -> [Maybe a]
indicate_repetitions :: forall a. Eq a => [a] -> [Maybe a]
indicate_repetitions =
    let f :: [a] -> [Maybe a]
f [a]
l = case [a]
l of
                [] -> []
                a
e:[a]
l' -> forall a. a -> Maybe a
Just a
e forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) [a]
l'
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. [a] -> [Maybe a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group

-- | 'zipWith' of list and it's own tail.
--
-- > zip_with_adj (,) "abcde" == [('a','b'),('b','c'),('c','d'),('d','e')]
zip_with_adj :: (a -> a -> b) -> [a] -> [b]
zip_with_adj :: forall t u. (t -> t -> u) -> [t] -> [u]
zip_with_adj a -> a -> b
f [a]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> b
f [a]
xs (forall a. [a] -> [a]
tail [a]
xs)

-- | Type-specialised 'zip_with_adj'.
compare_adjacent_by :: (a -> a -> Ordering) -> [a] -> [Ordering]
compare_adjacent_by :: forall a. (a -> a -> Ordering) -> [a] -> [Ordering]
compare_adjacent_by = forall t u. (t -> t -> u) -> [t] -> [u]
zip_with_adj

-- | 'compare_adjacent_by' of 'compare'.
--
-- > compare_adjacent [0,1,3,2] == [LT,LT,GT]
compare_adjacent :: Ord a => [a] -> [Ordering]
compare_adjacent :: forall a. Ord a => [a] -> [Ordering]
compare_adjacent = forall a. (a -> a -> Ordering) -> [a] -> [Ordering]
compare_adjacent_by forall a. Ord a => a -> a -> Ordering
compare

-- | Head and tail of list.  Useful to avoid "incomplete-uni-patterns" warnings.  It's an error if the list is empty.
headTail :: [a] -> (a, [a])
headTail :: forall a. [a] -> (a, [a])
headTail [a]
l = (forall a. [a] -> a
head [a]
l, forall a. [a] -> [a]
tail [a]
l)

-- | First and second elements of list. Useful to avoid "incomplete-uni-patterns" warnings.  It's an error if the list has less than two elements.
firstSecond :: [t] -> (t, t)
firstSecond :: forall t. [t] -> (t, t)
firstSecond [t]
l = ([t]
l forall a. [a] -> Int -> a
!! Int
0, [t]
l forall a. [a] -> Int -> a
!! Int
1)

-- | 'Data.List.groupBy' does not make adjacent comparisons, it
-- compares each new element to the start of the group.  This function
-- is the adjacent variant.
--
-- > groupBy (<) [1,2,3,2,4,1,5,9] == [[1,2,3,2,4],[1,5,9]]
-- > adjacent_groupBy (<) [1,2,3,2,4,1,5,9] == [[1,2,3],[2,4],[1,5,9]]
adjacent_groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
adjacent_groupBy :: forall a. (a -> a -> Bool) -> [a] -> [[a]]
adjacent_groupBy a -> a -> Bool
f [a]
p =
    case [a]
p of
      [] -> []
      [a
x] -> [[a
x]]
      a
x:a
y:[a]
p' -> let r :: [[a]]
r = forall a. (a -> a -> Bool) -> [a] -> [[a]]
adjacent_groupBy a -> a -> Bool
f (a
yforall a. a -> [a] -> [a]
:[a]
p')
                    ([a]
r0, [[a]]
r') = forall a. [a] -> (a, [a])
headTail [[a]]
r
                in if a -> a -> Bool
f a
x a
y
                   then (a
xforall a. a -> [a] -> [a]
:[a]
r0) forall a. a -> [a] -> [a]
: [[a]]
r'
                   else [a
x] forall a. a -> [a] -> [a]
: [[a]]
r

-- | Reduce sequences of consecutive values to ranges.
--
-- > group_ranges [-1,0,3,4,5,8,9,12] == [(-1,0),(3,5),(8,9),(12,12)]
-- > group_ranges [3,2,3,4,3] == [(3,3),(2,4),(3,3)]
group_ranges :: (Num t, Eq t) => [t] -> [(t,t)]
group_ranges :: forall t. (Num t, Eq t) => [t] -> [(t, t)]
group_ranges =
    let f :: [b] -> (b, b)
f [b]
l = (forall a. [a] -> a
head [b]
l,forall a. [a] -> a
last [b]
l)
    in forall a b. (a -> b) -> [a] -> [b]
map forall t. [t] -> (t, t)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
adjacent_groupBy (\t
p t
q -> t
p forall a. Num a => a -> a -> a
+ t
1 forall a. Eq a => a -> a -> Bool
== t
q)

-- | 'groupBy' on /structure/ of 'Maybe', ie. all 'Just' compare equal.
--
-- > let r = [[Just 1],[Nothing,Nothing],[Just 4,Just 5]]
-- > in group_just [Just 1,Nothing,Nothing,Just 4,Just 5] == r
group_just :: [Maybe a] -> [[Maybe a]]
group_just :: forall a. [Maybe a] -> [[Maybe a]]
group_just = forall x a. Eq x => (a -> x) -> [a] -> [[a]]
group_on forall a. Maybe a -> Bool
isJust

-- | Predicate to determine if all elements of the list are '=='.
--
-- > all_equal "aaa" == True
all_equal :: Eq a => [a] -> Bool
all_equal :: forall a. Eq a => [a] -> Bool
all_equal [a]
l =
    case [a]
l of
      [] -> Bool
True
      [a
_] -> Bool
True
      a
x:[a]
xs -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs

-- | Variant using 'nub'.
all_eq :: Eq n => [n] -> Bool
all_eq :: forall a. Eq a => [a] -> Bool
all_eq = (forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub

-- | 'nubBy' '==' 'on' /f/.
--
-- > nub_on snd (zip "ABCD" "xxyy") == [('A','x'),('C','y')]
nub_on :: Eq b => (a -> b) -> [a] -> [a]
nub_on :: forall b a. Eq b => (a -> b) -> [a] -> [a]
nub_on a -> b
f = forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

-- | 'group_on' of 'sortOn'.
--
-- > let r = [[('1','a'),('1','c')],[('2','d')],[('3','b'),('3','e')]]
-- > in sort_group_on fst (zip "13123" "abcde") == r
sort_group_on :: Ord b => (a -> b) -> [a] -> [[a]]
sort_group_on :: forall b a. Ord b => (a -> b) -> [a] -> [[a]]
sort_group_on a -> b
f = forall x a. Eq x => (a -> x) -> [a] -> [[a]]
group_on a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sort_on a -> b
f

-- | Maybe cons element onto list.
--
-- > Nothing `mcons` "something" == "something"
-- > Just 's' `mcons` "omething" == "something"
mcons :: Maybe a -> [a] -> [a]
mcons :: forall a. Maybe a -> [a] -> [a]
mcons Maybe a
e [a]
l = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
l (forall a. a -> [a] -> [a]
:[a]
l) Maybe a
e

-- | Cons onto end of list.
--
-- > snoc 4 [1,2,3] == [1,2,3,4]
snoc :: a -> [a] -> [a]
snoc :: forall a. a -> [a] -> [a]
snoc a
e [a]
l = [a]
l forall a. [a] -> [a] -> [a]
++ [a
e]

-- * Ordering

-- | Comparison function type.
type Compare_F a = a -> a -> Ordering

-- | If /f/ compares 'EQ', defer to /g/.
two_stage_compare :: Compare_F a -> Compare_F a -> Compare_F a
two_stage_compare :: forall a. Compare_F a -> Compare_F a -> Compare_F a
two_stage_compare Compare_F a
f Compare_F a
g a
p a
q =
    case Compare_F a
f a
p a
q of
      Ordering
EQ -> Compare_F a
g a
p a
q
      Ordering
r -> Ordering
r

-- | 'compare' 'on' of 'two_stage_compare'
two_stage_compare_on :: (Ord i, Ord j) => (t -> i) -> (t -> j) -> t -> t -> Ordering
two_stage_compare_on :: forall i j t.
(Ord i, Ord j) =>
(t -> i) -> (t -> j) -> t -> t -> Ordering
two_stage_compare_on t -> i
f t -> j
g = forall a. Compare_F a -> Compare_F a -> Compare_F a
two_stage_compare (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` t -> i
f) (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` t -> j
g)

-- | Sequence of comparison functions, continue comparing until not EQ.
--
-- > compare (1,0) (0,1) == GT
-- > n_stage_compare [compare `on` snd,compare `on` fst] (1,0) (0,1) == LT
n_stage_compare :: [Compare_F a] -> Compare_F a
n_stage_compare :: forall a. [Compare_F a] -> Compare_F a
n_stage_compare [Compare_F a]
l a
p a
q =
    case [Compare_F a]
l of
      [] -> Ordering
EQ
      Compare_F a
f:[Compare_F a]
l' -> case Compare_F a
f a
p a
q of
                Ordering
EQ -> forall a. [Compare_F a] -> Compare_F a
n_stage_compare [Compare_F a]
l' a
p a
q
                Ordering
r -> Ordering
r

-- | 'compare' 'on' of 'two_stage_compare'
n_stage_compare_on :: Ord i => [t -> i] -> t -> t -> Ordering
n_stage_compare_on :: forall i t. Ord i => [t -> i] -> t -> t -> Ordering
n_stage_compare_on [t -> i]
l = forall a. [Compare_F a] -> Compare_F a
n_stage_compare (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on`) [t -> i]
l)

-- | Sort sequence /a/ based on ordering of sequence /b/.
--
-- > sort_to "abc" [1,3,2] == "acb"
-- > sort_to "adbce" [1,4,2,3,5] == "abcde"
sort_to :: Ord i => [e] -> [i] -> [e]
sort_to :: forall i e. Ord i => [e] -> [i] -> [e]
sort_to [e]
e = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sort_on forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [e]
e

-- | 'flip' of 'sort_to'.
--
-- > sort_to_rev [1,4,2,3,5] "adbce" == "abcde"
sort_to_rev :: Ord i => [i] -> [e] -> [e]
sort_to_rev :: forall i e. Ord i => [i] -> [e] -> [e]
sort_to_rev = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall i e. Ord i => [e] -> [i] -> [e]
sort_to

-- | 'sortBy' of 'two_stage_compare'.
sort_by_two_stage :: Compare_F a -> Compare_F a -> [a] -> [a]
sort_by_two_stage :: forall a. Compare_F a -> Compare_F a -> [a] -> [a]
sort_by_two_stage Compare_F a
f Compare_F a
g = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Compare_F a -> Compare_F a -> Compare_F a
two_stage_compare Compare_F a
f Compare_F a
g)

-- | 'sortBy' of 'n_stage_compare'.
sort_by_n_stage :: [Compare_F a] -> [a] -> [a]
sort_by_n_stage :: forall a. [Compare_F a] -> [a] -> [a]
sort_by_n_stage [Compare_F a]
f = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. [Compare_F a] -> Compare_F a
n_stage_compare [Compare_F a]
f)

-- | 'sortBy' of 'two_stage_compare_on'.
sort_by_two_stage_on :: (Ord b,Ord c) => (a -> b) -> (a -> c) -> [a] -> [a]
sort_by_two_stage_on :: forall b c a. (Ord b, Ord c) => (a -> b) -> (a -> c) -> [a] -> [a]
sort_by_two_stage_on a -> b
f a -> c
g = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall i j t.
(Ord i, Ord j) =>
(t -> i) -> (t -> j) -> t -> t -> Ordering
two_stage_compare_on a -> b
f a -> c
g)

-- | 'sortBy' of 'n_stage_compare_on'.
sort_by_n_stage_on :: Ord b => [a -> b] -> [a] -> [a]
sort_by_n_stage_on :: forall b a. Ord b => [a -> b] -> [a] -> [a]
sort_by_n_stage_on [a -> b]
f = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall i t. Ord i => [t -> i] -> t -> t -> Ordering
n_stage_compare_on [a -> b]
f)

-- | Given a comparison function, merge two ascending lists. Alias for 'O.mergeBy'
--
-- > merge_by compare [1,3,5] [2,4] == [1..5]
merge_by :: Compare_F a -> [a] -> [a] -> [a]
merge_by :: forall a. Compare_F a -> [a] -> [a] -> [a]
merge_by = forall a. Compare_F a -> [a] -> [a] -> [a]
O.mergeBy

-- | 'merge_by' 'compare' 'on'.
merge_on :: Ord x => (a -> x) -> [a] -> [a] -> [a]
merge_on :: forall x a. Ord x => (a -> x) -> [a] -> [a] -> [a]
merge_on a -> x
f = forall a. Compare_F a -> [a] -> [a] -> [a]
merge_by (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> x
f)

-- | 'O.mergeBy' of 'two_stage_compare'.
merge_by_two_stage :: Ord b => (a -> b) -> Compare_F c -> (a -> c) -> [a] -> [a] -> [a]
merge_by_two_stage :: forall b a c.
Ord b =>
(a -> b) -> Compare_F c -> (a -> c) -> [a] -> [a] -> [a]
merge_by_two_stage a -> b
f Compare_F c
cmp a -> c
g = forall a. Compare_F a -> [a] -> [a] -> [a]
O.mergeBy (forall a. Compare_F a -> Compare_F a -> Compare_F a
two_stage_compare (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) (Compare_F c
cmp forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> c
g))

-- | Alias for 'O.merge'
merge :: Ord a => [a] -> [a] -> [a]
merge :: forall a. Ord a => [a] -> [a] -> [a]
merge = forall a. Ord a => [a] -> [a] -> [a]
O.merge

-- | Merge list of sorted lists given comparison function.  Note that
-- this is not equal to 'O.mergeAll'.
merge_set_by :: (a -> a -> Ordering) -> [[a]] -> [a]
merge_set_by :: forall a. (a -> a -> Ordering) -> [[a]] -> [a]
merge_set_by a -> a -> Ordering
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Compare_F a -> [a] -> [a] -> [a]
merge_by a -> a -> Ordering
f) []

-- | 'merge_set_by' of 'compare'.
--
-- > merge_set [[1,3,5,7,9],[2,4,6,8],[10]] == [1..10]
merge_set :: Ord a => [[a]] -> [a]
merge_set :: forall a. Ord a => [[a]] -> [a]
merge_set = forall a. (a -> a -> Ordering) -> [[a]] -> [a]
merge_set_by forall a. Ord a => a -> a -> Ordering
compare

{-| 'merge_by' variant that joins (resolves) equal elements.

> let {left p _ = p
>     ;right _ q = q
>     ;cmp = compare `on` fst
>     ;p = zip [1,3,5] "abc"
>     ;q = zip [1,2,3] "ABC"
>     ;left_r = [(1,'a'),(2,'B'),(3,'b'),(5,'c')]
>     ;right_r = [(1,'A'),(2,'B'),(3,'C'),(5,'c')]}
> in merge_by_resolve left cmp p q == left_r &&
>    merge_by_resolve right cmp p q == right_r

> merge_by_resolve (\x _ -> x) (compare `on` fst) [(0,'A'),(1,'B'),(4,'E')] (zip [1..] "bcd")
-}
merge_by_resolve :: (a -> a -> a) -> Compare_F a -> [a] -> [a] -> [a]
merge_by_resolve :: forall a. (a -> a -> a) -> Compare_F a -> [a] -> [a] -> [a]
merge_by_resolve a -> a -> a
jn Compare_F a
cmp =
    let recur :: [a] -> [a] -> [a]
recur [a]
p [a]
q =
            case ([a]
p,[a]
q) of
              ([],[a]
_) -> [a]
q
              ([a]
_,[]) -> [a]
p
              (a
l:[a]
p',a
r:[a]
q') -> case Compare_F a
cmp a
l a
r of
                               Ordering
LT -> a
l forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
recur [a]
p' [a]
q
                               Ordering
EQ -> a -> a -> a
jn a
l a
r forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
recur [a]
p' [a]
q'
                               Ordering
GT -> a
r forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
recur [a]
p [a]
q'
    in [a] -> [a] -> [a]
recur

-- | Merge two sorted (ascending) sequences.
--   Where elements compare equal, select element from left input.
--
-- > asc_seq_left_biased_merge_by (compare `on` fst) [(0,'A'),(1,'B'),(4,'E')] (zip [1..] "bcd")
asc_seq_left_biased_merge_by :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
asc_seq_left_biased_merge_by :: forall a. Compare_F a -> [a] -> [a] -> [a]
asc_seq_left_biased_merge_by = forall a. (a -> a -> a) -> Compare_F a -> [a] -> [a] -> [a]
merge_by_resolve forall a b. a -> b -> a
const

-- | Find the first two adjacent elements for which /f/ is True.
--
-- > find_adj (>) [1,2,3,3,2,1] == Just (3,2)
-- > find_adj (>=) [1,2,3,3,2,1] == Just (3,3)
find_adj :: (a -> a -> Bool) -> [a] -> Maybe (a,a)
find_adj :: forall a. (a -> a -> Bool) -> [a] -> Maybe (a, a)
find_adj a -> a -> Bool
f [a]
xs =
    case [a]
xs of
      a
p:a
q:[a]
xs' -> if a -> a -> Bool
f a
p a
q then forall a. a -> Maybe a
Just (a
p,a
q) else forall a. (a -> a -> Bool) -> [a] -> Maybe (a, a)
find_adj a -> a -> Bool
f (a
qforall a. a -> [a] -> [a]
:[a]
xs')
      [a]
_ -> forall a. Maybe a
Nothing

-- | 'find_adj' of '>='
--
-- > filter is_ascending (words "A AA AB ABB ABC ABA") == words "A AB ABC"
is_ascending :: Ord a => [a] -> Bool
is_ascending :: forall a. Ord a => [a] -> Bool
is_ascending = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> Maybe (a, a)
find_adj forall a. Ord a => a -> a -> Bool
(>=)

-- | 'find_adj' of '>'
--
-- > filter is_non_descending (words "A AA AB ABB ABC ABA") == ["A","AA","AB","ABB","ABC"]
is_non_descending :: Ord a => [a] -> Bool
is_non_descending :: forall a. Ord a => [a] -> Bool
is_non_descending = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> Maybe (a, a)
find_adj forall a. Ord a => a -> a -> Bool
(>)

-- | Variant of `elem` that operates on a sorted list, halting.
--   This is 'O.member'.
--
-- > 16 `elem_ordered` [1,3 ..] == False
-- > 16 `elem` [1,3 ..] == undefined
elem_ordered :: Ord t => t -> [t] -> Bool
elem_ordered :: forall t. Ord t => t -> [t] -> Bool
elem_ordered = forall t. Ord t => t -> [t] -> Bool
O.member

-- | Variant of `elemIndex` that operates on a sorted list, halting.
--
-- > 16 `elemIndex_ordered` [1,3 ..] == Nothing
-- > 16 `elemIndex_ordered` [0,1,4,9,16,25,36,49,64,81,100] == Just 4
elemIndex_ordered :: Ord t => t -> [t] -> Maybe Int
elemIndex_ordered :: forall t. Ord t => t -> [t] -> Maybe Int
elemIndex_ordered t
e =
    let recur :: t -> [t] -> Maybe t
recur t
k [t]
l =
            case [t]
l of
              [] -> forall a. Maybe a
Nothing
              t
x:[t]
l' -> if t
e forall a. Eq a => a -> a -> Bool
== t
x
                      then forall a. a -> Maybe a
Just t
k
                      else if t
x forall a. Ord a => a -> a -> Bool
> t
e
                           then forall a. Maybe a
Nothing
                           else t -> [t] -> Maybe t
recur (t
k forall a. Num a => a -> a -> a
+ t
1) [t]
l'
    in forall {t}. Num t => t -> [t] -> Maybe t
recur Int
0

-- | 'zipWith' variant equivalent to 'mapMaybe' (ie. 'catMaybes' of 'zipWith')
zip_with_maybe :: (a -> b -> Maybe c) -> [a] -> [b] -> [c]
zip_with_maybe :: forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> [c]
zip_with_maybe a -> b -> Maybe c
f [a]
lhs = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> Maybe c
f [a]
lhs

-- | 'zipWith' variant that extends shorter side using given value.
zip_with_ext :: t -> u -> (t -> u -> v) -> [t] -> [u] -> [v]
zip_with_ext :: forall t u v. t -> u -> (t -> u -> v) -> [t] -> [u] -> [v]
zip_with_ext t
i u
j t -> u -> v
f [t]
p [u]
q =
  case ([t]
p,[u]
q) of
    ([],[u]
_) -> forall a b. (a -> b) -> [a] -> [b]
map (t -> u -> v
f t
i) [u]
q
    ([t]
_,[]) -> forall a b. (a -> b) -> [a] -> [b]
map (t -> u -> v
`f` u
j) [t]
p
    (t
x:[t]
p',u
y:[u]
q') -> t -> u -> v
f t
x u
y forall a. a -> [a] -> [a]
: forall t u v. t -> u -> (t -> u -> v) -> [t] -> [u] -> [v]
zip_with_ext t
i u
j t -> u -> v
f [t]
p' [u]
q'

{- | 'zip_with_ext' of ','

> let f = zip_ext 'i' 'j'
> f "" "" == []
> f "p" "" == zip "p" "j"
> f "" "q" == zip "i" "q"
> f "pp" "q" == zip "pp" "qj"
> f "p" "qq" == zip "pi" "qq"
-}
zip_ext :: t -> u -> [t] -> [u] -> [(t,u)]
zip_ext :: forall t u. t -> u -> [t] -> [u] -> [(t, u)]
zip_ext t
i u
j = forall t u v. t -> u -> (t -> u -> v) -> [t] -> [u] -> [v]
zip_with_ext t
i u
j (,)

-- | Keep right variant of 'zipWith', where unused rhs values are returned.
--
-- > zip_with_kr (,) [1..3] ['a'..'e'] == ([(1,'a'),(2,'b'),(3,'c')],"de")
zip_with_kr :: (a -> b -> c) -> [a] -> [b] -> ([c],[b])
zip_with_kr :: forall a b c. (a -> b -> c) -> [a] -> [b] -> ([c], [b])
zip_with_kr a -> b -> c
f =
    let go :: [c] -> [a] -> [b] -> ([c], [b])
go [c]
r [a]
p [b]
q =
            case ([a]
p,[b]
q) of
              (a
i:[a]
p',b
j:[b]
q') -> [c] -> [a] -> [b] -> ([c], [b])
go (a -> b -> c
f a
i b
j forall a. a -> [a] -> [a]
: [c]
r) [a]
p' [b]
q'
              ([a], [b])
_ -> (forall a. [a] -> [a]
reverse [c]
r,[b]
q)
    in [c] -> [a] -> [b] -> ([c], [b])
go []

-- | A 'zipWith' variant that always consumes an element from the left
-- hand side (lhs), but only consumes an element from the right hand
-- side (rhs) if the zip function is 'Right' and not if 'Left'.
-- There's also a secondary function to continue if the rhs ends
-- before the lhs.
zip_with_perhaps_rhs :: (a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
zip_with_perhaps_rhs :: forall a b c.
(a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
zip_with_perhaps_rhs a -> b -> Either c c
f a -> c
g [a]
lhs [b]
rhs =
    case ([a]
lhs,[b]
rhs) of
      ([],[b]
_) -> []
      ([a]
_,[]) -> forall a b. (a -> b) -> [a] -> [b]
map a -> c
g [a]
lhs
      (a
p:[a]
lhs',b
q:[b]
rhs') -> case a -> b -> Either c c
f a
p b
q of
                           Left c
r -> c
r forall a. a -> [a] -> [a]
: forall a b c.
(a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
zip_with_perhaps_rhs a -> b -> Either c c
f a -> c
g [a]
lhs' [b]
rhs
                           Right c
r -> c
r forall a. a -> [a] -> [a]
: forall a b c.
(a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
zip_with_perhaps_rhs a -> b -> Either c c
f a -> c
g [a]
lhs' [b]
rhs'

{- | Zip a list with a list of lists.
Ordinarily the list has at least as many elements as there are elements at the list of lists.
There is also a Traversable form of this called 'adopt_shape_2_zip_stream'.

> zip_list_with_list_of_list [1 ..] ["a", "list", "of", "strings"]
> zip_list_with_list_of_list [1 .. 9] ["a", "list", "of", "strings"]
-}
zip_list_with_list_of_list :: [p] -> [[q]] -> [[(p, q)]]
zip_list_with_list_of_list :: forall p q. [p] -> [[q]] -> [[(p, q)]]
zip_list_with_list_of_list [p]
s [[q]]
l =
  case [[q]]
l of
    [] -> []
    [q]
e:[[q]]
l' ->
      let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [q]
e
      in forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> [a] -> [a]
take Int
n [p]
s) [q]
e forall a. a -> [a] -> [a]
: forall p q. [p] -> [[q]] -> [[(p, q)]]
zip_list_with_list_of_list (forall a. Int -> [a] -> [a]
drop Int
n [p]
s) [[q]]
l'

-- | Fill gaps in a sorted association list, range is inclusive at both ends.
--
-- > let r = [(1,'a'),(2,'x'),(3,'x'),(4,'x'),(5,'b'),(6,'x'),(7,'c'),(8,'x'),(9,'x')]
-- > in fill_gaps_ascending' 'x' (1,9) (zip [1,5,7] "abc") == r
fill_gaps_ascending :: (Enum n, Ord n) => t -> (n,n) -> [(n,t)] -> [(n,t)]
fill_gaps_ascending :: forall n t. (Enum n, Ord n) => t -> (n, n) -> [(n, t)] -> [(n, t)]
fill_gaps_ascending t
def_e (n
l,n
r) =
    let f :: a -> (a, b) -> Either (a, t) (a, b)
f a
i (a
j,b
e) = if a
j forall a. Ord a => a -> a -> Bool
> a
i then forall a b. a -> Either a b
Left (a
i,t
def_e) else forall a b. b -> Either a b
Right (a
j,b
e)
        g :: a -> (a, t)
g a
i = (a
i,t
def_e)
    in forall a b c.
(a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
zip_with_perhaps_rhs forall {a} {b}. Ord a => a -> (a, b) -> Either (a, t) (a, b)
f forall {a}. a -> (a, t)
g [n
l .. n
r]

-- | Direct definition.
fill_gaps_ascending' :: (Num n,Enum n, Ord n) => t -> (n,n) -> [(n,t)] -> [(n,t)]
fill_gaps_ascending' :: forall n t.
(Num n, Enum n, Ord n) =>
t -> (n, n) -> [(n, t)] -> [(n, t)]
fill_gaps_ascending' t
def (n
l,n
r) =
    let recur :: n -> [(n, t)] -> [(n, t)]
recur n
n [(n, t)]
x =
            if n
n forall a. Ord a => a -> a -> Bool
> n
r
            then []
            else case [(n, t)]
x of
                   [] -> forall a b. [a] -> [b] -> [(a, b)]
zip [n
n .. n
r] (forall a. a -> [a]
repeat t
def)
                   (n
m,t
e):[(n, t)]
x' -> if n
n forall a. Ord a => a -> a -> Bool
< n
m
                               then (n
n,t
def) forall a. a -> [a] -> [a]
: n -> [(n, t)] -> [(n, t)]
recur (n
n forall a. Num a => a -> a -> a
+ n
1) [(n, t)]
x
                               else (n
m,t
e) forall a. a -> [a] -> [a]
: n -> [(n, t)] -> [(n, t)]
recur (n
n forall a. Num a => a -> a -> a
+ n
1) [(n, t)]
x'
    in n -> [(n, t)] -> [(n, t)]
recur n
l

-- | Variant with default value for empty input list case.
minimumBy_or :: t -> (t -> t -> Ordering) -> [t] -> t
minimumBy_or :: forall t. t -> (t -> t -> Ordering) -> [t] -> t
minimumBy_or t
p t -> t -> Ordering
f [t]
q = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
q then t
p else forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy t -> t -> Ordering
f [t]
q

-- | 'minimum' and 'maximum' in one pass.
--
-- > minmax "minmax" == ('a','x')
minmax :: Ord t => [t] -> (t,t)
minmax :: forall t. Ord t => [t] -> (t, t)
minmax [t]
inp =
    case [t]
inp of
      [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"minmax: null"
      t
x:[t]
xs -> let mm :: b -> (b, b) -> (b, b)
mm b
p (b
l,b
r) = (forall a. Ord a => a -> a -> a
min b
p b
l,forall a. Ord a => a -> a -> a
max b
p b
r) in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. Ord b => b -> (b, b) -> (b, b)
mm (t
x,t
x) [t]
xs

-- | Append /k/ to the right of /l/ until result has /n/ places.
--   Truncates long input lists.
--
-- > map (pad_right '0' 2 . return) ['0' .. '9']
-- > pad_right '0' 12 "1101" == "110100000000"
-- > map (pad_right ' '3) ["S","E-L"] == ["S  ","E-L"]
-- > pad_right '!' 3 "truncate" == "tru"
pad_right :: a -> Int -> [a] -> [a]
pad_right :: forall a. a -> Int -> [a] -> [a]
pad_right a
k Int
n [a]
l = forall a. Int -> [a] -> [a]
take Int
n ([a]
l forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat a
k)

-- | Variant that errors if the input list has more than /n/ places.
--
-- > map (pad_right_err '!' 3) ["x","xy","xyz","xyz!"]
pad_right_err :: t -> Int -> [t] -> [t]
pad_right_err :: forall a. a -> Int -> [a] -> [a]
pad_right_err t
k Int
n [t]
l = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
l forall a. Ord a => a -> a -> Bool
> Int
n then forall a. HasCallStack => [Char] -> a
error [Char]
"pad_right_err?" else forall a. a -> Int -> [a] -> [a]
pad_right t
k Int
n [t]
l

-- | Variant that will not truncate long inputs.
--
-- > pad_right_no_truncate '!' 3 "truncate" == "truncate"
pad_right_no_truncate :: a -> Int -> [a] -> [a]
pad_right_no_truncate :: forall a. a -> Int -> [a] -> [a]
pad_right_no_truncate a
k Int
n [a]
l = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l forall a. Ord a => a -> a -> Bool
> Int
n then [a]
l else forall a. a -> Int -> [a] -> [a]
pad_right a
k Int
n [a]
l

-- | Append /k/ to the left of /l/ until result has /n/ places.
--
-- > map (pad_left '0' 2 . return) ['0' .. '9']
pad_left :: a -> Int -> [a] -> [a]
pad_left :: forall a. a -> Int -> [a] -> [a]
pad_left a
k Int
n [a]
l = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) a
k forall a. [a] -> [a] -> [a]
++ [a]
l

-- * Embedding

-- | Locate first (leftmost) embedding of /q/ in /p/.
-- Return partial indices for failure at 'Left'.
--
-- > embedding ("embedding","ming") == Right [1,6,7,8]
-- > embedding ("embedding","mind") == Left [1,6,7]
embedding :: Eq t => ([t],[t]) -> Either [Int] [Int]
embedding :: forall t. Eq t => ([t], [t]) -> Either [Int] [Int]
embedding =
    let recur :: t -> [t] -> ([a], [a]) -> Either [t] [t]
recur t
n [t]
r ([a]
p,[a]
q) =
            case ([a]
p,[a]
q) of
              ([a]
_,[]) -> forall a b. b -> Either a b
Right (forall a. [a] -> [a]
reverse [t]
r)
              ([],[a]
_) -> forall a b. a -> Either a b
Left (forall a. [a] -> [a]
reverse [t]
r)
              (a
x:[a]
p',a
y:[a]
q') ->
                  let n' :: t
n' = t
n forall a. Num a => a -> a -> a
+ t
1
                      r' :: [t]
r' = if a
x forall a. Eq a => a -> a -> Bool
== a
y then t
n forall a. a -> [a] -> [a]
: [t]
r else [t]
r
                  in t -> [t] -> ([a], [a]) -> Either [t] [t]
recur t
n' [t]
r' ([a]
p',if a
x forall a. Eq a => a -> a -> Bool
== a
y then [a]
q' else [a]
q)
    in forall {a} {t}.
(Eq a, Num t) =>
t -> [t] -> ([a], [a]) -> Either [t] [t]
recur Int
0 []

-- | 'fromRight' of 'embedding'
embedding_err :: Eq t => ([t],[t]) -> [Int]
embedding_err :: forall t. Eq t => ([t], [t]) -> [Int]
embedding_err = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error [Char]
"embedding_err") forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Eq t => ([t], [t]) -> Either [Int] [Int]
embedding

-- | Does /q/ occur in sequence, though not necessarily adjacently, in /p/.
--
-- > is_embedding [1 .. 9] [1,3,7] == True
-- > is_embedding "embedding" "ming" == True
-- > is_embedding "embedding" "mind" == False
is_embedding :: Eq t => [t] -> [t] -> Bool
is_embedding :: forall a. Eq a => [a] -> [a] -> Bool
is_embedding [t]
p [t]
q = forall a b. Either a b -> Bool
T.is_right (forall t. Eq t => ([t], [t]) -> Either [Int] [Int]
embedding ([t]
p,[t]
q))

-- * Un-list

-- | Unpack one element list.
unlist1 :: [t] -> Maybe t
unlist1 :: forall t. [t] -> Maybe t
unlist1 [t]
l =
    case [t]
l of
      [t
e] -> forall a. a -> Maybe a
Just t
e
      [t]
_ -> forall a. Maybe a
Nothing

-- | Erroring variant.
unlist1_err :: [t] -> t
unlist1_err :: forall a. [a] -> a
unlist1_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"unlist1") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. [t] -> Maybe t
unlist1

-- * Tree

{- | Given an 'Ordering' predicate where 'LT' opens a group, 'GT'
closes a group, and 'EQ' continues current group, construct tree
from list.

> let l = "a {b {c d} e f} g h i"
> let t = group_tree ((==) '{',(==) '}') l
> catMaybes (flatten t) == l

> let {d = putStrLn . drawTree . fmap show}
> in d (group_tree ((==) '(',(==) ')') "a(b(cd)ef)ghi")

-}
group_tree :: (a -> Bool,a -> Bool) -> [a] -> Tree.Tree (Maybe a)
group_tree :: forall a. (a -> Bool, a -> Bool) -> [a] -> Tree (Maybe a)
group_tree (a -> Bool
open_f,a -> Bool
close_f) =
    let unit :: a -> Tree (Maybe a)
unit a
e = forall a. a -> [Tree a] -> Tree a
Tree.Node (forall a. a -> Maybe a
Just a
e) []
        nil :: Tree (Maybe a)
nil = forall a. a -> [Tree a] -> Tree a
Tree.Node forall a. Maybe a
Nothing []
        insert_e :: Tree a -> Tree a -> Tree a
insert_e (Tree.Node a
t [Tree a]
l) Tree a
e = forall a. a -> [Tree a] -> Tree a
Tree.Node a
t (Tree a
eforall a. a -> [a] -> [a]
:[Tree a]
l)
        reverse_n :: Tree a -> Tree a
reverse_n (Tree.Node a
t [Tree a]
l) = forall a. a -> [Tree a] -> Tree a
Tree.Node a
t (forall a. [a] -> [a]
reverse [Tree a]
l)
        do_push :: ([Tree (Maybe a)], [Tree (Maybe a)])
-> a -> ([Tree (Maybe a)], [Tree (Maybe a)])
do_push ([Tree (Maybe a)]
r,[Tree (Maybe a)]
z) a
e =
            case [Tree (Maybe a)]
z of
              Tree (Maybe a)
h:[Tree (Maybe a)]
z' -> ([Tree (Maybe a)]
r,forall {a}. Tree a -> Tree a -> Tree a
insert_e Tree (Maybe a)
h (forall {a}. a -> Tree (Maybe a)
unit a
e) forall a. a -> [a] -> [a]
: [Tree (Maybe a)]
z')
              [] -> (forall {a}. a -> Tree (Maybe a)
unit a
e forall a. a -> [a] -> [a]
: [Tree (Maybe a)]
r,[])
        do_open :: (a, [Tree (Maybe a)]) -> (a, [Tree (Maybe a)])
do_open (a
r,[Tree (Maybe a)]
z) = (a
r,forall {a}. Tree (Maybe a)
nilforall a. a -> [a] -> [a]
:[Tree (Maybe a)]
z)
        do_close :: ([Tree a], [Tree a]) -> ([Tree a], [Tree a])
do_close ([Tree a]
r,[Tree a]
z) =
            case [Tree a]
z of
              Tree a
h0:Tree a
h1:[Tree a]
z' -> ([Tree a]
r,forall {a}. Tree a -> Tree a -> Tree a
insert_e Tree a
h1 (forall {a}. Tree a -> Tree a
reverse_n Tree a
h0) forall a. a -> [a] -> [a]
: [Tree a]
z')
              Tree a
h:[Tree a]
z' -> (forall {a}. Tree a -> Tree a
reverse_n Tree a
h forall a. a -> [a] -> [a]
: [Tree a]
r,[Tree a]
z')
              [] -> ([Tree a]
r,[Tree a]
z)
        go :: ([Tree (Maybe a)], [Tree (Maybe a)]) -> [a] -> Tree (Maybe a)
go ([Tree (Maybe a)], [Tree (Maybe a)])
st [a]
x =
            case [a]
x of
              [] -> forall a. a -> [Tree a] -> Tree a
Tree.Node forall a. Maybe a
Nothing (forall a. [a] -> [a]
reverse (forall a b. (a, b) -> a
fst ([Tree (Maybe a)], [Tree (Maybe a)])
st))
              a
e:[a]
x' -> if a -> Bool
open_f a
e
                      then ([Tree (Maybe a)], [Tree (Maybe a)]) -> [a] -> Tree (Maybe a)
go (forall {a}.
([Tree (Maybe a)], [Tree (Maybe a)])
-> a -> ([Tree (Maybe a)], [Tree (Maybe a)])
do_push (forall {a} {a}. (a, [Tree (Maybe a)]) -> (a, [Tree (Maybe a)])
do_open ([Tree (Maybe a)], [Tree (Maybe a)])
st) a
e) [a]
x'
                      else if a -> Bool
close_f a
e
                           then ([Tree (Maybe a)], [Tree (Maybe a)]) -> [a] -> Tree (Maybe a)
go (forall {a}. ([Tree a], [Tree a]) -> ([Tree a], [Tree a])
do_close (forall {a}.
([Tree (Maybe a)], [Tree (Maybe a)])
-> a -> ([Tree (Maybe a)], [Tree (Maybe a)])
do_push ([Tree (Maybe a)], [Tree (Maybe a)])
st a
e)) [a]
x'
                           else ([Tree (Maybe a)], [Tree (Maybe a)]) -> [a] -> Tree (Maybe a)
go (forall {a}.
([Tree (Maybe a)], [Tree (Maybe a)])
-> a -> ([Tree (Maybe a)], [Tree (Maybe a)])
do_push ([Tree (Maybe a)], [Tree (Maybe a)])
st a
e) [a]
x'
    in ([Tree (Maybe a)], [Tree (Maybe a)]) -> [a] -> Tree (Maybe a)
go ([],[])

-- * Indexing

{- | Remove element at index.

> map (remove_ix 5) ["remove","removed"] == ["remov","removd"]
> remove_ix 5 "short" -- error
-}
remove_ix :: Int -> [a] -> [a]
remove_ix :: forall a. Int -> [a] -> [a]
remove_ix Int
k [a]
l = let ([a]
p,[a]
q) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
k [a]
l in [a]
p forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail [a]
q

{- | Delete element at ix from list (c.f. remove_ix, this has a more specific error if index does not exist).

> delete_at 3 "deleted" == "delted"
> delete_at 8 "deleted" -- error
-}
delete_at :: (Eq t, Num t) => t -> [a] -> [a]
delete_at :: forall t a. (Eq t, Num t) => t -> [a] -> [a]
delete_at t
ix [a]
l =
  case (t
ix,[a]
l) of
    (t
_,[]) -> forall a. HasCallStack => [Char] -> a
error [Char]
"delete_at: index does not exist"
    (t
0,a
_:[a]
l') -> [a]
l'
    (t
_,a
e:[a]
l') -> a
e forall a. a -> [a] -> [a]
: forall t a. (Eq t, Num t) => t -> [a] -> [a]
delete_at (t
ix forall a. Num a => a -> a -> a
- t
1) [a]
l'

-- | Select or remove elements at set of indices.
operate_ixs :: Bool -> [Int] -> [a] -> [a]
operate_ixs :: forall a. Bool -> [Int] -> [a] -> [a]
operate_ixs Bool
mode [Int]
k =
    let sel :: Int -> [Int] -> Bool
sel = if Bool
mode then forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem else forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
        f :: (Int, a) -> Maybe a
f (Int
n,a
e) = if Int
n Int -> [Int] -> Bool
`sel` [Int]
k then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
e
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (Int, a) -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]

-- | Select elements at set of indices.
--
-- > select_ixs [1,3] "select" == "ee"
select_ixs :: [Int] -> [a] -> [a]
select_ixs :: forall a. [Int] -> [a] -> [a]
select_ixs = forall a. Bool -> [Int] -> [a] -> [a]
operate_ixs Bool
True

-- | Remove elements at set of indices.
--
-- > remove_ixs [1,3,5] "remove" == "rmv"
remove_ixs :: [Int] -> [a] -> [a]
remove_ixs :: forall a. [Int] -> [a] -> [a]
remove_ixs = forall a. Bool -> [Int] -> [a] -> [a]
operate_ixs Bool
False

-- | Replace element at /i/ in /p/ by application of /f/.
--
-- > replace_ix negate 1 [1..3] == [1,-2,3]
replace_ix :: (a -> a) -> Int -> [a] -> [a]
replace_ix :: forall a. (a -> a) -> Int -> [a] -> [a]
replace_ix a -> a
f Int
i [a]
p =
    let ([a]
q,[a]
r) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
p
        (a
s,[a]
t) = forall a. [a] -> (a, [a])
headTail [a]
r
    in [a]
q forall a. [a] -> [a] -> [a]
++ (a -> a
f a
s forall a. a -> [a] -> [a]
: [a]
t)

-- | List equality, ignoring indicated indices.
--
-- > list_eq_ignoring_indices [3,5] "abcdefg" "abc.e.g" == True
list_eq_ignoring_indices :: (Eq t,Integral i) => [i] -> [t] -> [t] -> Bool
list_eq_ignoring_indices :: forall t i. (Eq t, Integral i) => [i] -> [t] -> [t] -> Bool
list_eq_ignoring_indices [i]
x =
  let f :: i -> [a] -> [a] -> Bool
f i
n [a]
p [a]
q =
        case ([a]
p,[a]
q) of
          ([],[]) -> Bool
True
          ([],[a]
_) -> Bool
False
          ([a]
_,[]) -> Bool
False
          (a
p1:[a]
p',a
q1:[a]
q') -> (i
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [i]
x Bool -> Bool -> Bool
|| a
p1 forall a. Eq a => a -> a -> Bool
== a
q1) Bool -> Bool -> Bool
&&
                           i -> [a] -> [a] -> Bool
f (i
n forall a. Num a => a -> a -> a
+ i
1) [a]
p' [a]
q'
  in forall {a}. Eq a => i -> [a] -> [a] -> Bool
f i
0

-- | Edit list to have /v/ at indices /k/.
--   Replacement assoc-list must be ascending.
--   All replacements must be in range.
--
-- > list_set_indices [(2,'C'),(4,'E')] "abcdefg" == "abCdEfg"
-- > list_set_indices [] "abcdefg" == "abcdefg"
-- > list_set_indices [(9,'I')] "abcdefg" == undefined
list_set_indices :: (Eq ix, Num ix) => [(ix,t)] -> [t] -> [t]
list_set_indices :: forall ix t. (Eq ix, Num ix) => [(ix, t)] -> [t] -> [t]
list_set_indices =
  let f :: t -> [(t, a)] -> [a] -> [a]
f t
n [(t, a)]
r [a]
l =
        case ([(t, a)]
r,[a]
l) of
          ([],[a]
_) -> [a]
l
          ([(t, a)]
_,[]) -> forall a. HasCallStack => [Char] -> a
error [Char]
"list_set_indices: out of range?"
          ((t
k,a
v):[(t, a)]
r',a
l0:[a]
l') -> if t
n forall a. Eq a => a -> a -> Bool
== t
k
                              then a
v forall a. a -> [a] -> [a]
: t -> [(t, a)] -> [a] -> [a]
f (t
n forall a. Num a => a -> a -> a
+ t
1) [(t, a)]
r' [a]
l'
                              else a
l0 forall a. a -> [a] -> [a]
: t -> [(t, a)] -> [a] -> [a]
f (t
n forall a. Num a => a -> a -> a
+ t
1) [(t, a)]
r [a]
l'
  in forall {t} {a}. (Eq t, Num t) => t -> [(t, a)] -> [a] -> [a]
f ix
0

-- | Variant of 'list_set_indices' with one replacement.
list_set_ix :: (Eq t, Num t) => t -> a -> [a] -> [a]
list_set_ix :: forall t a. (Eq t, Num t) => t -> a -> [a] -> [a]
list_set_ix t
k a
v = forall ix t. (Eq ix, Num ix) => [(ix, t)] -> [t] -> [t]
list_set_indices [(t
k,a
v)]

-- | Cyclic indexing function.
--
-- > map (at_cyclic "cycle") [0..9] == "cyclecycle"
at_cyclic :: [a] -> Int -> a
at_cyclic :: forall a. [a] -> Int -> a
at_cyclic [a]
l Int
n =
    let m :: IntMap a
m = forall a. [(Int, a)] -> IntMap a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [a]
l)
        k :: Int
k = forall a. IntMap a -> Int
Map.size IntMap a
m
        n' :: Int
n' = Int
n forall a. Integral a => a -> a -> a
`mod` Int
k
    in forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"cyc_at") (forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
n' IntMap a
m)

{- | Index list from the end, assuming the list is longer than n + 1.

atFromEnd [1 .. 30] 0 == 30
atFromEnd [1..100] 15 == 85
-}
atFromEnd :: [t] -> Int -> t
atFromEnd :: forall a. [a] -> Int -> a
atFromEnd [t]
lst Int
n =
  let loop :: [a] -> [b] -> a
loop [a]
xs [b]
ys = forall a. [a] -> a
last (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> a
const [a]
xs [b]
ys)
  in forall {a} {b}. [a] -> [b] -> a
loop [t]
lst (forall a. Int -> [a] -> [a]
drop Int
n [t]
lst)