{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns, BangPatterns, DefaultSignatures #-}
{-# LANGUAGE Trustworthy, CPP, TypeFamilies, ConstraintKinds #-}

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints, RankNTypes #-}
#endif

{- |
    Module      :  SDP.Linear
    Copyright   :  (c) Andrey Mulik 2019-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.Linear" is a module that provides several convenient interfaces for
    working with various linear data structures.
-}
module SDP.Linear
(
  -- * Exports
  module SDP.Nullable,
  module SDP.Index,
  module SDP.Sort,
  module SDP.Zip,
  
  -- * Bordered class
  Bordered (..), Bordered1, Bordered2,
  
  -- * Linear class
  Linear (..), Linear1, Linear2, pattern (:>), pattern (:<),
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  Bordered', Bordered'', Linear', Linear'',
#endif
  
  -- ** Split class
  Split (..), Split1,
  
  -- * Related functions
  stripPrefix, stripSuffix, stripPrefix', stripSuffix',
  intercalate, tails, inits, ascending
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Nullable
import SDP.Index
import SDP.Sort
import SDP.Zip

import qualified Data.List as L

import Control.Exception.SDP

default ()

infix  8 `filter`, `except`
infixr 5 :>, ++
infixl 5 :<
infixl 9 !^

--------------------------------------------------------------------------------

-- | Class of bordered data structures.
class (Index i, Estimate b) => Bordered b i | b -> i
  where
    {-# MINIMAL (bounds|(lower, upper)) #-}
    
    {-# INLINE bounds #-}
    {- |
      Returns the exact 'upper' and 'lower' bounds of given structure. If the
      structure doesn't have explicitly defined boundaries (list, for example),
      use the @'defaultBounds' . 'sizeOf'@.
    -}
    bounds :: b -> (i, i)
    bounds b
es = (b -> i
forall b i. Bordered b i => b -> i
lower b
es, b -> i
forall b i. Bordered b i => b -> i
upper b
es)
    
    {-# INLINE lower #-}
    -- | Returns lower bound of structure
    lower :: b -> i
    lower =  (i, i) -> i
forall a b. (a, b) -> a
fst ((i, i) -> i) -> (b -> (i, i)) -> b -> i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    {-# INLINE upper #-}
    -- | Returns upper bound of structure
    upper :: b -> i
    upper =  (i, i) -> i
forall a b. (a, b) -> b
snd ((i, i) -> i) -> (b -> (i, i)) -> b -> i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    {-# INLINE sizeOf #-}
    -- | Returns actual size of structure.
    sizeOf :: b -> Int
    sizeOf =  (i, i) -> Int
forall i. Index i => (i, i) -> Int
size ((i, i) -> Int) -> (b -> (i, i)) -> b -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    -- | Returns actual sizes of structure.
    sizesOf :: b -> [Int]
    sizesOf =  (i, i) -> [Int]
forall i. Index i => (i, i) -> [Int]
sizes ((i, i) -> [Int]) -> (b -> (i, i)) -> b -> [Int]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    {-# INLINE indexIn #-}
    -- | Checks if an index falls within the boundaries of the structure.
    indexIn :: b -> i -> Bool
    indexIn =  (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange ((i, i) -> i -> Bool) -> (b -> (i, i)) -> b -> i -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    {-# INLINE indices #-}
    -- | Returns index range list.
    indices :: b -> [i]
    indices =  (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range ((i, i) -> [i]) -> (b -> (i, i)) -> b -> [i]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    {-# INLINE indexOf #-}
    -- | Returns index by offset in structure.
    indexOf :: b -> Int -> i
    indexOf =  (i, i) -> Int -> i
forall i. Index i => (i, i) -> Int -> i
index ((i, i) -> Int -> i) -> (b -> (i, i)) -> b -> Int -> i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds
    
    {-# INLINE offsetOf #-}
    -- | Returns index offset in structure bounds.
    offsetOf :: b -> i -> Int
    offsetOf =  (i, i) -> i -> Int
forall i. Index i => (i, i) -> i -> Int
offset ((i, i) -> i -> Int) -> (b -> (i, i)) -> b -> i -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds

--------------------------------------------------------------------------------

instance (Index i) => Bordered (i, i) i
  where
    bounds :: (i, i) -> (i, i)
bounds = (i, i) -> (i, i)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    lower :: (i, i) -> i
lower  = (i, i) -> i
forall a b. (a, b) -> a
fst
    upper :: (i, i) -> i
upper  = (i, i) -> i
forall a b. (a, b) -> b
snd
    
    indices :: (i, i) -> [i]
indices = (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range
    indexIn :: (i, i) -> i -> Bool
indexIn = (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange
    
    sizeOf :: (i, i) -> Int
sizeOf   = (i, i) -> Int
forall i. Index i => (i, i) -> Int
size
    indexOf :: (i, i) -> Int -> i
indexOf  = (i, i) -> Int -> i
forall i. Index i => (i, i) -> Int -> i
index
    offsetOf :: (i, i) -> i -> Int
offsetOf = (i, i) -> i -> Int
forall i. Index i => (i, i) -> i -> Int
offset

instance Bordered [e] Int
  where
    sizeOf :: [e] -> Int
sizeOf = [e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    lower :: [e] -> Int
lower  = Int -> [e] -> Int
forall a b. a -> b -> a
const Int
0
    
    upper :: [e] -> Int
upper [e]
es = [e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

--------------------------------------------------------------------------------

{-# RULES
  "select/Just"  select  Just = listL;
  "select'/Just" select' Just = id;
#-}

{- |
  Class of list-like data structures, which
  
  * can be converted to and from list
  * can be created from singleton or 'Foldable' stream
  * support filter operations, separation, concatenation and selection
  * It can be represented as 'head', 'tail', 'init' and 'last' elements and
  constructed from 'head' and 'tail' or 'init' and 'last'.
-}
class (Nullable l) => Linear l e | l -> e
  where
    {-# MINIMAL (listL|listR), (fromList|fromFoldable), (head,tail|uncons), (init,last|unsnoc) #-}
    
    -- | Separates line to 'head' and 'tail', deconstructor for ':>' pattern.
    uncons :: l -> (e, l)
    uncons l
xs = (l -> e
forall l e. Linear l e => l -> e
head l
xs, l -> l
forall l e. Linear l e => l -> l
tail l
xs)
    
    -- | Same as @'isNull' '?-' 'uncons'@
    uncons' :: l -> Maybe (e, l)
    uncons' =  l -> Bool
forall e. Nullable e => e -> Bool
isNull (l -> Bool) -> (l -> (e, l)) -> l -> Maybe (e, l)
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?- l -> (e, l)
forall l e. Linear l e => l -> (e, l)
uncons
    
    -- | Prepends element to line, constructor for ':>' pattern.
    toHead :: e -> l -> l
    toHead =  l -> l -> l
forall l e. Linear l e => l -> l -> l
(++) (l -> l -> l) -> (e -> l) -> e -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> l
forall l e. Linear l e => e -> l
single
    
    -- | Returns first element of line, may fail.
    head :: l -> e
    head =  (e, l) -> e
forall a b. (a, b) -> a
fst ((e, l) -> e) -> (l -> (e, l)) -> l -> e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> (e, l)
forall l e. Linear l e => l -> (e, l)
uncons
    
    -- | Returns line except first, may fail.
    tail :: l -> l
    tail =  (e, l) -> l
forall a b. (a, b) -> b
snd ((e, l) -> l) -> (l -> (e, l)) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> (e, l)
forall l e. Linear l e => l -> (e, l)
uncons
    
    -- | Separates line to 'init' and 'last', deconstructor for ':<' pattern.
    unsnoc :: l -> (l, e)
    unsnoc l
xs = (l -> l
forall l e. Linear l e => l -> l
init l
xs, l -> e
forall l e. Linear l e => l -> e
last l
xs)
    
    -- | Same as @'isNull' '?-' 'unsnoc'@
    unsnoc' :: l -> Maybe (l, e)
    unsnoc' =  l -> Bool
forall e. Nullable e => e -> Bool
isNull (l -> Bool) -> (l -> (l, e)) -> l -> Maybe (l, e)
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?- l -> (l, e)
forall l e. Linear l e => l -> (l, e)
unsnoc
    
    -- | Appends element to line, constructor for ':<' pattern.
    toLast :: l -> e -> l
    toLast l
es =  (l
es l -> l -> l
forall l e. Linear l e => l -> l -> l
++) (l -> l) -> (e -> l) -> e -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> l
forall l e. Linear l e => e -> l
single
    
    -- | Returns line except 'last' element, may fail.
    init :: l -> l
    init =  (l, e) -> l
forall a b. (a, b) -> a
fst ((l, e) -> l) -> (l -> (l, e)) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> (l, e)
forall l e. Linear l e => l -> (l, e)
unsnoc
    
    -- | Returns last element, may fail.
    last :: l -> e
    last =  (l, e) -> e
forall a b. (a, b) -> b
snd ((l, e) -> e) -> (l -> (l, e)) -> l -> e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> (l, e)
forall l e. Linear l e => l -> (l, e)
unsnoc
    
    -- | Just singleton.
    single :: e -> l
    single =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (e -> [e]) -> e -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> [e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    
    -- | Concatenation of two lines.
    (++) :: l -> l -> l
    (++) =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> l -> [e]) -> l -> l -> l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ([e] -> [e] -> [e]) -> (l -> [e]) -> l -> l -> [e]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [e] -> [e] -> [e]
forall l e. Linear l e => l -> l -> l
(++) l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | @replicate n e@ returns a line of @n@ repetitions of the element @e@.
    replicate :: Int -> e -> l
    replicate Int
n = Int -> [e] -> l
forall l e. Linear l e => Int -> [e] -> l
fromListN Int
n ([e] -> l) -> (e -> [e]) -> e -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> e -> [e]
forall l e. Linear l e => Int -> e -> l
replicate Int
n
    
    -- | Creates line from list.
    fromList :: [e] -> l
    fromList =  [e] -> l
forall l e (f :: * -> *). (Linear l e, Foldable f) => f e -> l
fromFoldable
    
    -- | Create finite line from (possibly infinite) list.
    fromListN :: Int -> [e] -> l
    fromListN =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (Int -> [e] -> [e]) -> Int -> [e] -> l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
take
    
    -- | Right to left view of line.
    listR :: l -> [e]
    listR =  l -> [e]
forall l e. Linear l e => l -> [e]
listL (l -> [e]) -> (l -> l) -> l -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> l
forall l e. Linear l e => l -> l
reverse
    
    -- | Left to right view of line, same to 'toList'.
    listL :: l -> [e]
    listL =  [e] -> [e]
forall l e. Linear l e => l -> l
reverse ([e] -> [e]) -> (l -> [e]) -> l -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listR
    
    -- | Generalized 'fromList'.
    fromFoldable :: (Foldable f) => f e -> l
    fromFoldable =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (f e -> [e]) -> f e -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    
    {- |
      Returns the element of a sequence by offset, may be completely unsafe.
      This is an optimistic read function and shouldn't perform checks for
      efficiency reasons.
      
      If you need safety, use (!) or (!?). The generalization of this function
      by index type (.!).
      
      > es !^ i = listL es !! i
    -}
    (!^) :: l -> Int -> e
    (!^) =  [e] -> Int -> e
forall a. [a] -> Int -> a
(L.!!) ([e] -> Int -> e) -> (l -> [e]) -> l -> Int -> e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @write es n e@ writes value @e@ in position @n@ (offset), returns new
      structure. If @n@ is out of range, returns equal structure (@es@ or copy).
    -}
    write :: l -> Int -> e -> l
    write l
es = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (Int -> e -> [e]) -> Int -> e -> l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [e] -> Int -> e -> [e]
forall l e. Linear l e => l -> Int -> e -> l
write (l -> [e]
forall l e. Linear l e => l -> [e]
listL l
es)
    
    -- | Generalized concat.
    concat :: (Foldable f) => f l -> l
    concat =  (l -> l -> l) -> l -> f l -> l
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr l -> l -> l
forall l e. Linear l e => l -> l -> l
(++) l
forall e. Nullable e => e
Z
    
    -- | Generalized concatMap.
    concatMap :: (Foldable f) => (a -> l) -> f a -> l
    concatMap a -> l
f = [l] -> l
forall l e (f :: * -> *). (Linear l e, Foldable f) => f l -> l
concat ([l] -> l) -> (f a -> [l]) -> f a -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> [l] -> [l]) -> [l] -> f a -> [l]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (l -> [l] -> [l]) -> (a -> l) -> a -> [l] -> [l]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> l
f) []
    
    -- | Generalized intersperse.
    intersperse :: e -> l -> l
    intersperse e
e = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> [e]) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> [e] -> [e]
forall l e. Linear l e => e -> l -> l
intersperse e
e ([e] -> [e]) -> (l -> [e]) -> l -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | Generalized filter.
    filter :: (e -> Bool) -> l -> l
    filter e -> Bool
p = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> [e]) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> Bool) -> [e] -> [e]
forall l e. Linear l e => (e -> Bool) -> l -> l
filter e -> Bool
p ([e] -> [e]) -> (l -> [e]) -> l -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | Inverted filter.
    except :: (e -> Bool) -> l -> l
    except e -> Bool
p = (e -> Bool) -> l -> l
forall l e. Linear l e => (e -> Bool) -> l -> l
filter (Bool -> Bool
not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> Bool
p)
    
    -- | Generalization of partition.
    partition :: (e -> Bool) -> l -> (l, l)
    partition e -> Bool
p l
es = ((e -> Bool) -> l -> l
forall l e. Linear l e => (e -> Bool) -> l -> l
filter e -> Bool
p l
es, (e -> Bool) -> l -> l
forall l e. Linear l e => (e -> Bool) -> l -> l
except e -> Bool
p l
es)
    
    -- | Generalization of partition, that select sublines by predicates.
    partitions :: (Foldable f) => f (e -> Bool) -> l -> [l]
    partitions f (e -> Bool)
ps l
es =
      let f :: [l] -> (e -> Bool) -> [l]
f = \ (l
x : [l]
xs) -> (\ (l
y, l
ys) -> (l
ys l -> [l] -> [l]
forall a. a -> [a] -> [a]
: l
y l -> [l] -> [l]
forall a. a -> [a] -> [a]
: [l]
xs)) ((l, l) -> [l]) -> ((e -> Bool) -> (l, l)) -> (e -> Bool) -> [l]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((e -> Bool) -> l -> (l, l)
forall l e. Linear l e => (e -> Bool) -> l -> (l, l)
`partition` l
x)
      in  [l] -> [l]
forall l e. Linear l e => l -> l
reverse ([l] -> [l]) -> [l] -> [l]
forall a b. (a -> b) -> a -> b
$ ([l] -> (e -> Bool) -> [l]) -> [l] -> f (e -> Bool) -> [l]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [l] -> (e -> Bool) -> [l]
f [l
es] f (e -> Bool)
ps
    
    -- | @select f es@ is selective map of @es@ elements to new list.
    select :: (e -> Maybe a) -> l -> [a]
    select e -> Maybe a
f = (e -> [a] -> [a]) -> [a] -> [e] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ e
x [a]
es -> case e -> Maybe a
f e
x of {(Just a
e) -> a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
es; Maybe a
_ -> [a]
es}) [] ([e] -> [a]) -> (l -> [e]) -> l -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | @select' f es@ is selective map of @es@ elements to new line.
    select' :: (t e ~ l, Linear1 t a) => (e -> Maybe a) -> l -> t a
    select' =  [a] -> t a
forall l e. Linear l e => [e] -> l
fromList ([a] -> t a)
-> ((e -> Maybe a) -> l -> [a]) -> (e -> Maybe a) -> l -> t a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Maybe a) -> l -> [a]
forall l e a. Linear l e => (e -> Maybe a) -> l -> [a]
select
    
    {- |
      @extract f es@ returns a selective map of @es@ elements to new list and
      the remaining elements of the line.
    -}
    extract :: (e -> Maybe a) -> l -> ([a], l)
    extract e -> Maybe a
f =
      let g :: e -> ([a], [e]) -> ([a], [e])
g = \ e
b -> ([e] -> [e]) -> ([a], [e]) -> ([a], [e])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (e
b e -> [e] -> [e]
forall a. a -> [a] -> [a]
:) (([a], [e]) -> ([a], [e]))
-> (a -> ([a], [e]) -> ([a], [e]))
-> Maybe a
-> ([a], [e])
-> ([a], [e])
forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` (([a] -> [a]) -> ([a], [e]) -> ([a], [e])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (([a] -> [a]) -> ([a], [e]) -> ([a], [e]))
-> (a -> [a] -> [a]) -> a -> ([a], [e]) -> ([a], [e])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:)) (Maybe a -> ([a], [e]) -> ([a], [e]))
-> Maybe a -> ([a], [e]) -> ([a], [e])
forall a b. (a -> b) -> a -> b
$ e -> Maybe a
f e
b
      in  ([e] -> l) -> ([a], [e]) -> ([a], l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> l
forall l e. Linear l e => [e] -> l
fromList (([a], [e]) -> ([a], l)) -> (l -> ([a], [e])) -> l -> ([a], l)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> ([a], [e]) -> ([a], [e])) -> ([a], [e]) -> [e] -> ([a], [e])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr e -> ([a], [e]) -> ([a], [e])
g ([], []) ([e] -> ([a], [e])) -> (l -> [e]) -> l -> ([a], [e])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @extract' f es@ returns a selective map of @es@ elements to new line and
      the remaining elements of the line.
    -}
    extract' :: (t e ~ l, Linear1 t a) => (e -> Maybe a) -> l -> (t a, l)
    extract' =  ([a] -> t a) -> ([a], l) -> (t a, l)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [a] -> t a
forall l e. Linear l e => [e] -> l
fromList (([a], l) -> (t a, l))
-> ((e -> Maybe a) -> l -> ([a], l))
-> (e -> Maybe a)
-> l
-> (t a, l)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Maybe a) -> l -> ([a], l)
forall l e a. Linear l e => (e -> Maybe a) -> l -> ([a], l)
extract
    
    {- |
      @selects fs es@ sequentially applies the functions from @fs@ to the
      remainder of @es@, returns a list of selections and the remainder of the
      last selection.
    -}
    selects :: (Foldable f) => f (e -> Maybe a) -> l -> ([[a]], l)
    selects f (e -> Maybe a)
fs l
es =
      let g :: [[a]] -> l -> (e -> Maybe a) -> ([[a]], l)
g = \ [[a]]
as -> ([a] -> [[a]]) -> ([a], l) -> ([[a]], l)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
as) (([a], l) -> ([[a]], l))
-> (l -> (e -> Maybe a) -> ([a], l))
-> l
-> (e -> Maybe a)
-> ([[a]], l)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ((e -> Maybe a) -> l -> ([a], l))
-> l -> (e -> Maybe a) -> ([a], l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (e -> Maybe a) -> l -> ([a], l)
forall l e a. Linear l e => (e -> Maybe a) -> l -> ([a], l)
extract
      in  (([[a]], l) -> (e -> Maybe a) -> ([[a]], l))
-> ([[a]], l) -> f (e -> Maybe a) -> ([[a]], l)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (([[a]] -> l -> (e -> Maybe a) -> ([[a]], l))
-> ([[a]], l) -> (e -> Maybe a) -> ([[a]], l)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [[a]] -> l -> (e -> Maybe a) -> ([[a]], l)
forall a. [[a]] -> l -> (e -> Maybe a) -> ([[a]], l)
g) ([], l
es) f (e -> Maybe a)
fs
    
    {- |
      @selects' fs es@ sequentially applies the functions from @fs@ to the
      remainder of @es@, returns a line of selections and the remainder of the
      last selection.
    -}
    selects' :: (Foldable f, t e ~ l, Linear1 t a) => f (e -> Maybe a) -> l -> ([t a], l)
    selects' =  ([[a]] -> [t a]) -> ([[a]], l) -> ([t a], l)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (([a] -> t a) -> [[a]] -> [t a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> t a
forall l e. Linear l e => [e] -> l
fromList) (([[a]], l) -> ([t a], l))
-> (f (e -> Maybe a) -> l -> ([[a]], l))
-> f (e -> Maybe a)
-> l
-> ([t a], l)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... f (e -> Maybe a) -> l -> ([[a]], l)
forall l e (f :: * -> *) a.
(Linear l e, Foldable f) =>
f (e -> Maybe a) -> l -> ([[a]], l)
selects
    
    {- |
      The @isSubseqOf xs ys@ checks if all the elements of the @xs@ occur,
      in order, in the @ys@. The elements don't have to occur consecutively.
    -}
    isSubseqOf :: (Eq e) => l -> l -> Bool
    isSubseqOf =  [e] -> [e] -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
isSubseqOf ([e] -> [e] -> Bool) -> (l -> [e]) -> l -> l -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | Generalized reverse.
    reverse :: l -> l
    reverse =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> [e]) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listR
    
    -- | O(1) 'force', same as 'id'.
    force :: l -> l
    force =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> [e]) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @since 0.2.1
      
      @'before' es i e@ insert @e@ to @es@ before element with offset @i@. If
      @i@ goes beyond the lower or upper bounds, @e@ is prepended or appended to
      @es@ respectively.
      
      > before [0 .. 5] (-1) 7 == [7,0,1,2,3,4,5]
      > before [0 .. 5]   0  7 == [7,0,1,2,3,4,5]
      > before [0 .. 5]   3  7 == [0,1,2,7,3,4,5]
      > before [0 .. 5]   5  7 == [0,1,2,3,4,7,5]
      > before [0 .. 5]  19  7 == [0,1,2,3,4,5,7]
    -}
    before :: l -> Int -> e -> l
    before l
es = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (Int -> e -> [e]) -> Int -> e -> l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [e] -> Int -> e -> [e]
forall l e. Linear l e => l -> Int -> e -> l
before (l -> [e]
forall l e. Linear l e => l -> [e]
listL l
es)
    
    {- |
      @since 0.2.1
      
      @'after' es i e@ insert @e@ to @es@ after element with offset @i@.
      
      > after es i e == before es (i + 1) e
    -}
    after :: l -> Int -> e -> l
    after l
es Int
i e
e = l -> Int -> e -> l
forall l e. Linear l e => l -> Int -> e -> l
before l
es (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) e
e
    
    {- |
      @since 0.2.1
      
      @'remove' es i@ delete element with offset @i@ from @es@.
      
      > remove (-1) [0 .. 5] == [0 .. 5]
      > remove   6  [0 .. 5] == [0 .. 5]
      > remove   0  [0 .. 5] == [1,2,3,4,5]
      > remove   3  [0 .. 5] == [0,1,2,4,5]
      > remove   5  [0 .. 5] == [0,1,2,3,4]
    -}
    remove :: Int -> l -> l
    remove Int
n = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> [e]) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [e] -> [e]
forall l e. Linear l e => Int -> l -> l
remove Int
n ([e] -> [e]) -> (l -> [e]) -> l -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | Generalized 'subsequences'.
    subsequences :: l -> [l]
    subsequences =  (l
forall e. Nullable e => e
Z l -> [l] -> [l]
forall a. a -> [a] -> [a]
:) ([l] -> [l]) -> (l -> [l]) -> l -> [l]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [l]
forall t e a. (Linear t e, Linear a e) => t -> [a]
go
      where
        go :: t -> [a]
go (e
x :> t
xs) = e -> a
forall l e. Linear l e => e -> l
single e
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
ys [a]
r -> a
ys a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (e
x e -> a -> a
forall l e. Linear l e => e -> l -> l
:> a
ys) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r) [] (t -> [a]
go t
xs)
        go     t
_     = [a]
forall e. Nullable e => e
Z
    
    {- |
      @iterate n f x@ returns sequence of @n@ applications of @f@ to @x@.
      
      Note that @iterate@ returns finite sequence, instead "Prelude" prototype.
    -}
    iterate :: Int -> (e -> e) -> e -> l
    iterate Int
n = Int -> [e] -> l
forall l e. Linear l e => Int -> [e] -> l
fromListN Int
n ([e] -> l) -> ((e -> e) -> e -> [e]) -> (e -> e) -> e -> l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Int -> (e -> e) -> e -> [e]
forall l e. Linear l e => Int -> (e -> e) -> e -> l
iterate Int
n
    
    -- | Same as @nubBy ('==')@.
    nub :: (Eq e) => l -> l
    nub =  Equal e -> l -> l
forall l e. Linear l e => Equal e -> l -> l
nubBy Equal e
forall a. Eq a => a -> a -> Bool
(==)
    
    -- | Generalization of nubBy.
    nubBy :: Equal e -> l -> l
    nubBy Equal e
f = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> (l -> [e]) -> l -> l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Equal e -> [e] -> [e]
forall l e. Linear l e => Equal e -> l -> l
nubBy Equal e
f ([e] -> [e]) -> (l -> [e]) -> l -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- Folds with offset. -}
    
    -- | 'ofoldr' is right fold with offset.
    ofoldr :: (Int -> e -> b -> b) -> b -> l -> b
    ofoldr Int -> e -> b -> b
f b
base = (Int -> e -> b -> b) -> b -> [e] -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr Int -> e -> b -> b
f b
base ([e] -> b) -> (l -> [e]) -> l -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | 'ofoldl' is left fold with offset.
    ofoldl :: (Int -> b -> e -> b) -> b -> l -> b
    ofoldl Int -> b -> e -> b
f b
base = (Int -> b -> e -> b) -> b -> [e] -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl Int -> b -> e -> b
f b
base ([e] -> b) -> (l -> [e]) -> l -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | 'ofoldr'' is strict version of 'ofoldr'.
    ofoldr' :: (Int -> e -> b -> b) -> b -> l -> b
    ofoldr' Int -> e -> b -> b
f = (Int -> e -> b -> b) -> b -> l -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr (\ !Int
i e
e !b
b -> Int -> e -> b -> b
f Int
i e
e b
b)
    
    -- | 'ofoldl'' is strict version of 'ofoldl'.
    ofoldl' :: (Int -> b -> e -> b) -> b -> l -> b
    ofoldl' Int -> b -> e -> b
f = (Int -> b -> e -> b) -> b -> l -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl (\ !Int
i !b
b e
e -> Int -> b -> e -> b
f Int
i b
b e
e)
    
    {- 'Foldable' crutches. -}
    
    -- | 'o_foldr' is just 'foldr' in 'Linear' context.
    o_foldr :: (e -> b -> b) -> b -> l -> b
    o_foldr =  (Int -> e -> b -> b) -> b -> l -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr ((Int -> e -> b -> b) -> b -> l -> b)
-> ((e -> b -> b) -> Int -> e -> b -> b)
-> (e -> b -> b)
-> b
-> l
-> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> b -> b) -> Int -> e -> b -> b
forall a b. a -> b -> a
const
    
    -- | 'o_foldl' is just 'foldl' in 'Linear' context.
    o_foldl :: (b -> e -> b) -> b -> l -> b
    o_foldl =  (Int -> b -> e -> b) -> b -> l -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl ((Int -> b -> e -> b) -> b -> l -> b)
-> ((b -> e -> b) -> Int -> b -> e -> b)
-> (b -> e -> b)
-> b
-> l
-> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> e -> b) -> Int -> b -> e -> b
forall a b. a -> b -> a
const
    
    -- | 'o_foldr'' is just 'foldr'' in 'Linear' context.
    o_foldr' :: (e -> b -> b) -> b -> l -> b
    o_foldr' =  (Int -> e -> b -> b) -> b -> l -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr' ((Int -> e -> b -> b) -> b -> l -> b)
-> ((e -> b -> b) -> Int -> e -> b -> b)
-> (e -> b -> b)
-> b
-> l
-> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> b -> b) -> Int -> e -> b -> b
forall a b. a -> b -> a
const
    
    -- | 'o_foldl'' is just 'foldl'' in 'Linear' context.
    o_foldl' :: (b -> e -> b) -> b -> l -> b
    o_foldl' =  (Int -> b -> e -> b) -> b -> l -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl' ((Int -> b -> e -> b) -> b -> l -> b)
-> ((b -> e -> b) -> Int -> b -> e -> b)
-> (b -> e -> b)
-> b
-> l
-> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> e -> b) -> Int -> b -> e -> b
forall a b. a -> b -> a
const
    
    {- |
      @since 0.2.1
      
      'o_foldr1' is just 'Data.Foldable.foldr1' in 'Linear' context.
    -}
    o_foldr1 :: (e -> e -> e) -> l -> e
    o_foldr1 e -> e -> e
f = \ (l
es :< e
e) -> (e -> e -> e) -> e -> l -> e
forall l e b. Linear l e => (e -> b -> b) -> b -> l -> b
o_foldr e -> e -> e
f e
e l
es
    
    {- |
      @since 0.2.1
      
      'o_foldl1' is just 'Data.Foldable.foldl1' in 'Linear' context.
    -}
    o_foldl1 :: (e -> e -> e) -> l -> e
    o_foldl1 e -> e -> e
f = \ (e
e :> l
es) -> (e -> e -> e) -> e -> l -> e
forall l e b. Linear l e => (b -> e -> b) -> b -> l -> b
o_foldl e -> e -> e
f e
e l
es
    
    {- |
      @since 0.2.1
      
      'o_foldr1'' is just strict 'Data.Foldable.foldr1' in 'Linear' context.
    -}
    o_foldr1' :: (e -> e -> e) -> l -> e
    o_foldr1' e -> e -> e
f = \ (l
es :< e
e) -> (e -> e -> e) -> e -> l -> e
forall l e b. Linear l e => (e -> b -> b) -> b -> l -> b
o_foldr' e -> e -> e
f e
e l
es
    
    {- |
      @since 0.2.1
      
      'o_foldl1'' is just 'Data.Foldable.foldl1'' in 'Linear' context.
    -}
    o_foldl1' :: (e -> e -> e) -> l -> e
    o_foldl1' e -> e -> e
f = \ (e
e :> l
es) -> (e -> e -> e) -> e -> l -> e
forall l e b. Linear l e => (b -> e -> b) -> b -> l -> b
o_foldl' e -> e -> e
f e
e l
es

--------------------------------------------------------------------------------

-- | Split - class of splittable data structures.
class (Linear s e) => Split s e | s -> e
  where
    {-# MINIMAL (take|sans), (drop|keep) #-}
    
    -- | @take n es@ takes first @n@ elements of @es@.
    take :: Int -> s -> s
    default take :: (Bordered s i) => Int -> s -> s
    take Int
n s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
sans (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    -- | @drop n es@ drops first @n@ elements of @es@.
    drop :: Int -> s -> s
    default drop :: (Bordered s i) => Int -> s -> s
    drop Int
n s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
keep (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    -- | @keep n es@ takes last @n@ elements of @es@.
    keep :: Int -> s -> s
    default keep :: (Bordered s i) => Int -> s -> s
    keep Int
n s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    -- | @sans n es@ drops last @n@ elements of @es@.
    sans :: Int -> s -> s
    default sans :: (Bordered s i) => Int -> s -> s
    sans Int
n s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
take (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    {- |
      @save n es@ takes first @n@ elements of @es@ if @n > 0@ and last @-n@
      elements otherwise.
    -}
    save :: Int -> s -> s
    save Int
n = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> (s -> s) -> (s -> s) -> s -> s
forall a. Bool -> a -> a -> a
? Int -> s -> s
forall s e. Split s e => Int -> s -> s
take Int
n ((s -> s) -> s -> s) -> (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s e. Split s e => Int -> s -> s
keep (-Int
n)
    
    {- |
      @skip n es@ drops first @n@ elements of @es@ if @n > 0@ and last @-n@
      elements otherwise.
    -}
    skip :: Int -> s -> s
    skip Int
n = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> (s -> s) -> (s -> s) -> s -> s
forall a. Bool -> a -> a -> a
? Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop Int
n ((s -> s) -> s -> s) -> (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s e. Split s e => Int -> s -> s
sans (-Int
n)
    
    -- | @split n es@ is same to @(take n es, drop n es)@.
    split :: Int -> s -> (s, s)
    split Int
n s
es = (Int -> s -> s
forall s e. Split s e => Int -> s -> s
take Int
n s
es, Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop Int
n s
es)
    
    -- | @divide n es@ is same to @(sans n es, keep n es)@.
    divide :: Int -> s -> (s, s)
    divide Int
n s
es = (Int -> s -> s
forall s e. Split s e => Int -> s -> s
sans Int
n s
es, Int -> s -> s
forall s e. Split s e => Int -> s -> s
keep Int
n s
es)
    
    {- |
      Splits line into sequences of given sizes (left to right).
      
      > splits [5, 3, 12] ['a'..'z'] = ["abcde","fgh","ijklmnopqrst","uvwxyz"]
    -}
    splits :: (Foldable f) => f Int -> s -> [s]
    splits f Int
ns s
es =
      let f :: [s] -> Int -> [s]
f = \ (s
r : [s]
ds) Int
n -> let (s
d, s
r') = Int -> s -> (s, s)
forall s e. Split s e => Int -> s -> (s, s)
split Int
n s
r in s
r' s -> [s] -> [s]
forall a. a -> [a] -> [a]
: s
d s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
ds
      in  [s] -> [s]
forall l e. Linear l e => l -> l
reverse ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ ([s] -> Int -> [s]) -> [s] -> f Int -> [s]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [s] -> Int -> [s]
f [s
es] f Int
ns
    
    {- |
      Splits line into sequences of given sizes (right to left).
      
      > divides [5,3,12] ['a'..'z'] == ["abcdef","ghijk","lmn","opqrstuvwxyz"]
    -}
    divides :: (Foldable f) => f Int -> s -> [s]
    divides f Int
ns s
es =
      let f :: Int -> [s] -> [s]
f = \ Int
n (s
r : [s]
ds) -> let (s
r', s
d) = Int -> s -> (s, s)
forall s e. Split s e => Int -> s -> (s, s)
divide Int
n s
r in s
r' s -> [s] -> [s]
forall a. a -> [a] -> [a]
: s
d s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
ds
      in  (Int -> [s] -> [s]) -> [s] -> f Int -> [s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> [s] -> [s]
f [s
es] f Int
ns
    
    {- |
      Splits structures into parts by given offsets.
      
      > parts [0,5,6,12,26] ['a'..'z'] = ["","abcde","f","ghijkl","mnopqrstuvwxyz",""]
      > -- if previous offset is equal or greater, subline is empty and next
      > begins from previous:
      > parts [0, 5, 4, 12, 26] ['a' .. 'z'] = ["","abcde","","fghijklm","nopqrstuvwxyz",""]
    -}
    parts :: (Foldable f) => f Int -> s -> [s]
    parts =  [Int] -> s -> [s]
forall s e (f :: * -> *).
(Split s e, Foldable f) =>
f Int -> s -> [s]
splits ([Int] -> s -> [s]) -> (f Int -> [Int]) -> f Int -> s -> [s]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Int] -> [Int]
forall a. Num a => [a] -> [a]
go ([Int] -> [Int]) -> (f Int -> [Int]) -> f Int -> [Int]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList where go :: [a] -> [a]
go [a]
is = (a -> a -> a) -> [a] -> [a] -> [a]
forall (z :: * -> *) a b c.
Zip z =>
(a -> b -> c) -> z a -> z b -> z c
zipWith (-) [a]
is (a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
is)
    
    {- |
      Splits structures into chunks of size @n@ and the rest.
      
      > chunks x [] = [] -- forall x
      > chunks 0 es = [] -- forall es
      
      > chunks 3 [1 .. 10] == [[1,2,3],[4,5,6],[7,8,9],[10]]
    -}
    chunks :: Int -> s -> [s]
    chunks Int
_  s
Z = []
    chunks Int
n s
es = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> [s] -> [s] -> [s]
forall a. Bool -> a -> a -> a
? [] ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ let (s
x, s
xs) = Int -> s -> (s, s)
forall s e. Split s e => Int -> s -> (s, s)
split Int
n s
es in s
x s -> [s] -> [s]
forall a. a -> [a] -> [a]
: Int -> s -> [s]
forall s e. Split s e => Int -> s -> [s]
chunks Int
n s
xs
    
    {- |
      Split line by first (left) separation element. If there is no such
      element, @splitBy es = (es, Z)@.
      
      > splitBy (== '.') "foo" == ("foo","")
      > splitBy (== '.') "foo." == ("foo","")
      > splitBy (== '.') ".foo" == ("","foo")
      > splitBy (== '.') "foo.bar" == ("foo","bar")
      > splitBy (== '.') "foo.bar.baz" == ("foo","bar.baz")
    -}
    splitBy :: (e -> Bool) -> s -> (s, s)
    splitBy e -> Bool
f = ([e] -> s) -> ([e] -> s) -> ([e], [e]) -> (s, s)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [e] -> s
forall l e. Linear l e => [e] -> l
fromList [e] -> s
forall l e. Linear l e => [e] -> l
fromList (([e], [e]) -> (s, s)) -> (s -> ([e], [e])) -> s -> (s, s)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> Bool) -> [e] -> ([e], [e])
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
splitBy e -> Bool
f ([e] -> ([e], [e])) -> (s -> [e]) -> s -> ([e], [e])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      Split line by last (right) separation element. If there is no such
      element, @divide es = (Z, es)@.
      
      > divideBy (== '.') "foo" == ("","foo")
      > divideBy (== '.') ".foo" == ("","foo")
      > divideBy (== '.') "foo." == ("foo","")
      > divideBy (== '.') "foo.bar" == ("foo","bar")
      > divideBy (== '.') "foo.bar.baz" == ("foo.bar","baz")
    -}
    divideBy :: (e -> Bool) -> s -> (s, s)
    divideBy e -> Bool
f = ([e] -> s) -> ([e] -> s) -> ([e], [e]) -> (s, s)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [e] -> s
forall l e. Linear l e => [e] -> l
fromList [e] -> s
forall l e. Linear l e => [e] -> l
fromList (([e], [e]) -> (s, s)) -> (s -> ([e], [e])) -> s -> (s, s)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> Bool) -> [e] -> ([e], [e])
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
divideBy e -> Bool
f ([e] -> ([e], [e])) -> (s -> [e]) -> s -> ([e], [e])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | Splits line by separation elements.
    splitsBy :: (e -> Bool) -> s -> [s]
    splitsBy e -> Bool
e = ([e] -> s) -> [[e]] -> [s]
forall a b. (a -> b) -> [a] -> [b]
map [e] -> s
forall l e. Linear l e => [e] -> l
fromList ([[e]] -> [s]) -> (s -> [[e]]) -> s -> [s]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> Bool) -> [e] -> [[e]]
forall s e. Split s e => (e -> Bool) -> s -> [s]
splitsBy e -> Bool
e ([e] -> [[e]]) -> (s -> [e]) -> s -> [[e]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @splitsOn sub line@ splits @line@ by @sub@.
      
      > splitsOn "fo" "foobar bazfoobar1" == ["","obar baz","obar1"]
    -}
    splitsOn :: (Eq e) => s -> s -> [s]
#if __GLASGOW_HASKELL__ >= 820
    default splitsOn :: (Eq e, Bordered s i) => s -> s -> [s]
    splitsOn sub line = drop (sizeOf sub) <$> parts (infixes sub line) line
    -- ghc-8.0.1 has bug in default signatures, so this can be used with it
#else
    {-
      Not tested, but should be significantly slower than the definitions below.
      If you plan to support ghc-8.0.1, override splitsOn in all your instances.
    -}
    splitsOn s
sub s
line = [e] -> s
forall l e. Linear l e => [e] -> l
fromList ([e] -> s) -> [[e]] -> [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [e] -> [e] -> [[e]]
forall s e. (Split s e, Eq e) => s -> s -> [s]
splitsOn (s -> [e]
forall l e. Linear l e => l -> [e]
listL s
sub) (s -> [e]
forall l e. Linear l e => l -> [e]
listL s
line)
#endif
    
    {- |
      @replaceBy sub new line@ replace every non-overlapping occurrence of @sub@
      in @line@ with @new@.
      
      > replaceBy "foo" "bar" "foobafoorbaz" == "barbabarrbaz"
    -}
    replaceBy :: (Eq e) => s -> s -> s -> s
    replaceBy s
sub s
new = s -> [s] -> s
forall (f :: * -> *) l e.
(Foldable f, Linear1 f l, Linear l e) =>
l -> f l -> l
intercalate s
new ([s] -> s) -> (s -> [s]) -> s -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> s -> [s]
forall s e. (Split s e, Eq e) => s -> s -> [s]
splitsOn s
sub
    
    {- |
      Removes every non-overlapping occurrence of @sub@ with 'Z'.
      
      > removeAll = concat ... splitsOn
      > (`replaceBy` Z) = removeAll
    -}
    removeAll :: (Eq e) => s -> s -> s
    removeAll =  [s] -> s
forall l e (f :: * -> *). (Linear l e, Foldable f) => f l -> l
concat ([s] -> s) -> (s -> s -> [s]) -> s -> s -> s
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... s -> s -> [s]
forall s e. (Split s e, Eq e) => s -> s -> [s]
splitsOn
    
    {- |
      @combo f es@ returns the length of the @es@ subsequence (left to tight)
      whose elements are in order @f@.
      
      > combo (<) [] == 0
      > combo (<) [1] == 1
      > combo (<) [7, 4, 12] == 1
      > combo (<) [1, 7, 3, 12] == 2
    -}
    combo :: Equal e -> s -> Int
    combo Equal e
f = Equal e -> [e] -> Int
forall s e. Split s e => Equal e -> s -> Int
combo Equal e
f ([e] -> Int) -> (s -> [e]) -> s -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @justifyL n e es@ appends @e@ elements if the @es@ is shorter than @n@,
      @justifyL n e es@ prepends @(n - sizeOf es)@ elements @e@ to @es@ from the
      takes @n@ elements if longer.
      left side if @(sizeOf es < n)@. Otherwise returns the first @n@ elements
      of @es@, like @'take' n es@ do.
    -}
    justifyL :: Int -> e -> s -> s
    justifyL Int
n e
e = Int -> s -> s
forall s e. Split s e => Int -> s -> s
take Int
n (s -> s) -> (s -> s) -> s -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (s -> s -> s
forall l e. Linear l e => l -> l -> l
++ Int -> e -> s
forall l e. Linear l e => Int -> e -> l
replicate Int
n e
e)
    
    {- |
      @justifyR n e es@ appends @(n - sizeOf es)@ elements @e@ to @es@ from the
      right side if @(sizeOf es < n)@. Otherwise returns the first @n@ elements
      of @es@, like @'keep' n es@ do.
    -}
    justifyR :: Int -> e -> s -> s
    justifyR Int
n e
e = Int -> s -> s
forall s e. Split s e => Int -> s -> s
keep Int
n (s -> s) -> (s -> s) -> s -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> e -> s
forall l e. Linear l e => Int -> e -> l
replicate Int
n e
e s -> s -> s
forall l e. Linear l e => l -> l -> l
++)
    
    {- |
      @each n es@ returns each @n@-th element of structure.
      If @n == 1@, returns @es@.
      If @n < 1@, returns 'Z'.
    -}
    each :: Int -> s -> s
    each Int
n = [e] -> s
forall l e. Linear l e => [e] -> l
fromList ([e] -> s) -> (s -> [e]) -> s -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
each Int
n ([e] -> [e]) -> (s -> [e]) -> s -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @eachFrom o n es@ returns each nth element of structure, beginning from o.
      
      > eachFrom o n = each n . drop o
      
      > eachFrom 0 2 [1 .. 20] == [2, 4 .. 20]
      > eachFrom 1 2 [1 .. 20] == [3, 5 .. 19]
    -}
    eachFrom :: Int -> Int -> s -> s
    eachFrom Int
o Int
n = Int -> s -> s
forall s e. Split s e => Int -> s -> s
each Int
n (s -> s) -> (s -> s) -> s -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop Int
o
    
    -- | @sub `'isPrefixOf'` es@ checks if @sub@ is beginning of @es@.
    isPrefixOf :: (Eq e) => s -> s -> Bool
    isPrefixOf (e
x :> s
xs) (e
y :> s
ys) = e
x Equal e
forall a. Eq a => a -> a -> Bool
== e
y Bool -> Bool -> Bool
&& s
xs s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isPrefixOf` s
ys
    isPrefixOf s
xs               s
ys = s -> Bool
forall e. Nullable e => e -> Bool
isNull s
xs Bool -> Bool -> Bool
&& s -> Bool
forall e. Nullable e => e -> Bool
isNull s
ys
    
    -- | @sub `'isSuffixOf'` es@ checks if @sub@ is ending of @es@.
    isSuffixOf :: (Eq e) => s -> s -> Bool
    isSuffixOf (s
xs :< e
x) (s
ys :< e
y) = e
x Equal e
forall a. Eq a => a -> a -> Bool
== e
y Bool -> Bool -> Bool
&& s
xs s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isSuffixOf` s
ys
    isSuffixOf s
xs               s
ys = s -> Bool
forall e. Nullable e => e -> Bool
isNull s
xs Bool -> Bool -> Bool
&& s -> Bool
forall e. Nullable e => e -> Bool
isNull s
ys
    
    -- | isInfixOf checks whether the first line is the substring of the second
    isInfixOf  :: (Eq e) => s -> s -> Bool
    isInfixOf s
_   s
Z = Bool
False
    isInfixOf s
xs s
ys = s
xs s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isPrefixOf` s
ys Bool -> Bool -> Bool
|| s
xs s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isInfixOf` s -> s
forall l e. Linear l e => l -> l
tail s
ys
    
    -- | prefix gives length of init, satisfying preducate.
    prefix :: (e -> Bool) -> s -> Int
    prefix e -> Bool
p = (e -> Int -> Int) -> Int -> s -> Int
forall l e b. Linear l e => (e -> b -> b) -> b -> l -> b
o_foldr' (\ e
e Int
c -> e -> Bool
p e
e Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int -> Int
forall a. Enum a => a -> a
succ Int
c (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0) Int
0
    
    -- | suffix gives length of tail, satisfying predicate.
    suffix :: (e -> Bool) -> s -> Int
    suffix e -> Bool
p = (Int -> e -> Int) -> Int -> s -> Int
forall l e b. Linear l e => (b -> e -> b) -> b -> l -> b
o_foldl' (\ Int
c e
e -> e -> Bool
p e
e Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int -> Int
forall a. Enum a => a -> a
succ Int
c (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0) Int
0
    
    {- |
      @infixes inf es@ returns a list of @inf@ positions in @es@, without
      intersections.
      
      > "" `infixes` es = []
      > "abba" `infixes` "baababba" == [4]
      > "abab" `infixes` "baababab" == [2]
      > "aaaa" `infixes` "aaaaaaaa" == [0, 4]
    -}
    infixes :: (Eq e) => s -> s -> [Int]
    infixes =  ([e] -> [e] -> [Int]) -> (s -> [e]) -> s -> s -> [Int]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [e] -> [e] -> [Int]
forall s e. (Split s e, Eq e) => s -> s -> [Int]
infixes s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    -- | @dropSide f = dropWhile f . dropEnd f@.
    dropSide :: (e -> Bool) -> s -> s
    dropSide e -> Bool
f = (e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile e -> Bool
f (s -> s) -> (s -> s) -> s -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
dropEnd e -> Bool
f
    
    -- | Takes the longest init by predicate.
    takeWhile :: (e -> Bool) -> s -> s
    takeWhile e -> Bool
p s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
take ((e -> Bool) -> s -> Int
forall s e. Split s e => (e -> Bool) -> s -> Int
prefix e -> Bool
p s
es) s
es
    
    -- | Drops the longest init by predicate.
    dropWhile :: (e -> Bool) -> s -> s
    dropWhile e -> Bool
p s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop ((e -> Bool) -> s -> Int
forall s e. Split s e => (e -> Bool) -> s -> Int
prefix e -> Bool
p s
es) s
es
    
    -- | Takes the longest suffix by predicate.
    takeEnd :: (e -> Bool) -> s -> s
    takeEnd e -> Bool
p s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
keep ((e -> Bool) -> s -> Int
forall s e. Split s e => (e -> Bool) -> s -> Int
suffix e -> Bool
p s
es) s
es
    
    -- | Drops the longest prefix by predicate.
    dropEnd :: (e -> Bool) -> s -> s
    dropEnd e -> Bool
p s
es = Int -> s -> s
forall s e. Split s e => Int -> s -> s
sans ((e -> Bool) -> s -> Int
forall s e. Split s e => (e -> Bool) -> s -> Int
suffix e -> Bool
p s
es) s
es
    
    -- | Left-side span.
    spanl :: (e -> Bool) -> s -> (s, s)
    spanl e -> Bool
p s
es = ((e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
takeWhile e -> Bool
p s
es, (e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile e -> Bool
p s
es)
    
    -- | Left-side break.
    breakl :: (e -> Bool) -> s -> (s, s)
    breakl e -> Bool
p s
es = ((e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> Bool
p) s
es, (e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> Bool
p) s
es)
    
    -- | Right-side span.
    spanr :: (e -> Bool) -> s -> (s, s)
    spanr e -> Bool
p s
es = ((e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
dropEnd e -> Bool
p s
es, (e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
takeEnd e -> Bool
p s
es)
    
    -- | Right-side break.
    breakr :: (e -> Bool) -> s -> (s, s)
    breakr e -> Bool
p s
es = ((e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
dropEnd (Bool -> Bool
not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> Bool
p) s
es, (e -> Bool) -> s -> s
forall s e. Split s e => (e -> Bool) -> s -> s
takeEnd (Bool -> Bool
not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> Bool
p) s
es)
    
    {- |
      @selectWhile f es@ selects results of applying @f@ to @es@ (left to right)
      untill first fail.
    -}
    selectWhile :: (e -> Maybe a) -> s -> [a]
    selectWhile e -> Maybe a
f = (e -> Maybe a) -> [e] -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectWhile e -> Maybe a
f ([e] -> [a]) -> (s -> [e]) -> s -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @selectEnd f es@ selects results of applying @f@ to @es@ (right to left)
      untill first fail.
    -}
    selectEnd :: (e -> Maybe a) -> s -> [a]
    selectEnd e -> Maybe a
f = (e -> Maybe a) -> [e] -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectEnd e -> Maybe a
f ([e] -> [a]) -> (s -> [e]) -> s -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      @extractWhile f es@ selects results of applying @f@ to @es@ (left to
      right) untill first fail. Returns selected results and rest of line.
    -}
    extractWhile :: (e -> Maybe a) -> s -> ([a], s)
    extractWhile e -> Maybe a
f s
es = let as :: [a]
as = (e -> Maybe a) -> s -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectWhile e -> Maybe a
f s
es in ([a]
as, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> s -> s
forall s e. Split s e => Int -> s -> s
`drop` s
es)
    
    {- |
      @extractEnd f es@ selects results of applying @f@ to @es@ (right to left)
      untill first fail. Returns rest of line and selected results.
    -}
    extractEnd :: (e -> Maybe a) -> s -> (s, [a])
    extractEnd e -> Maybe a
f s
es = let as :: [a]
as = (e -> Maybe a) -> s -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectEnd e -> Maybe a
f s
es in ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> s -> s
forall s e. Split s e => Int -> s -> s
`sans` s
es, [a]
as)
    
    -- | @selectWhile'@ is 'selectWhile' version for generalized structures.
    selectWhile' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> t a
    selectWhile' =  [a] -> t a
forall l e. Linear l e => [e] -> l
fromList ([a] -> t a)
-> ((e -> Maybe a) -> s -> [a]) -> (e -> Maybe a) -> s -> t a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Maybe a) -> s -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectWhile
    
    -- | @selectEnd'@ is 'selectEnd' version for generalized structures.
    selectEnd' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> t a
    selectEnd' =  [a] -> t a
forall l e. Linear l e => [e] -> l
fromList ([a] -> t a)
-> ((e -> Maybe a) -> s -> [a]) -> (e -> Maybe a) -> s -> t a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Maybe a) -> s -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectEnd
    
    -- | @extractWhile'@ is 'extractWhile' version for generalized structures.
    extractWhile' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> (t a, s)
    extractWhile' =  ([a] -> t a) -> ([a], s) -> (t a, s)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [a] -> t a
forall l e. Linear l e => [e] -> l
fromList (([a], s) -> (t a, s))
-> ((e -> Maybe a) -> s -> ([a], s))
-> (e -> Maybe a)
-> s
-> (t a, s)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Maybe a) -> s -> ([a], s)
forall s e a. Split s e => (e -> Maybe a) -> s -> ([a], s)
extractWhile
    
    -- | @extractEnd'@ is 'extractEnd' version for generalized structures.
    extractEnd' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> (s, t a)
    extractEnd' =  ([a] -> t a) -> (s, [a]) -> (s, t a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [a] -> t a
forall l e. Linear l e => [e] -> l
fromList ((s, [a]) -> (s, t a))
-> ((e -> Maybe a) -> s -> (s, [a]))
-> (e -> Maybe a)
-> s
-> (s, t a)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Maybe a) -> s -> (s, [a])
forall s e a. Split s e => (e -> Maybe a) -> s -> (s, [a])
extractEnd

--------------------------------------------------------------------------------

-- | Pattern @(':>')@ is left-size view of line. Same as 'uncons' and 'toHead'.
pattern  (:>)   :: (Linear l e) => e -> l -> l
pattern x $b:> :: e -> l -> l
$m:> :: forall r l e. Linear l e => l -> (e -> l -> r) -> (Void# -> r) -> r
:> xs <- (uncons' -> Just (x, xs)) where (:>) = e -> l -> l
forall l e. Linear l e => e -> l -> l
toHead

-- | Pattern @(':<')@ is right-size view of line. Same as 'unsnoc' and 'toLast'.
pattern   (:<)  :: (Linear l e) => l -> e -> l
pattern xs $b:< :: l -> e -> l
$m:< :: forall r l e. Linear l e => l -> (l -> e -> r) -> (Void# -> r) -> r
:< x <- (unsnoc' -> Just (xs, x)) where (:<) = l -> e -> l
forall l e. Linear l e => l -> e -> l
toLast

-- | 'Linear' contraint for @(Type -> Type)@-kind types.
type Linear1 l e = Linear (l e) e

-- | 'Linear' contraint for @(Type -> Type -> Type)@-kind types.
type Linear2 l i e = Linear (l i e) e

-- | 'Bordered' contraint for @(Type -> Type)@-kind types.
type Bordered1 l i e = Bordered (l e) i

-- | 'Bordered' contraint for @(Type -> Type -> Type)@-kind types.
type Bordered2 l i e = Bordered (l i e) i

-- | Kind @(Type -> Type)@ 'Split' structure.
type Split1 s e = Split (s e) e

#if __GLASGOW_HASKELL__ >= 806
-- | 'Linear' contraint for @(Type -> Type)@-kind types.
type Linear' l = forall e . Linear (l e) e

-- | 'Linear' contraint for @(Type -> Type -> Type)@-kind types.
type Linear'' l = forall i e . Linear (l i e) e

-- | 'Bordered' contraint for @(Type -> Type)@-kind types.
type Bordered' l i = forall e . Bordered (l e) i

-- | 'Bordered' contraint for @(Type -> Type -> Type)@-kind types.
type Bordered'' l = forall i e . Bordered (l i e) i
#endif

--------------------------------------------------------------------------------

{-# COMPLETE [], (:>) #-}
{-# COMPLETE [], (:<) #-}

instance Linear [e] e
  where
    toHead :: e -> [e] -> [e]
toHead = (:)
    single :: e -> [e]
single = e -> [e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ++ :: [e] -> [e] -> [e]
(++)   = [e] -> [e] -> [e]
forall e. [e] -> [e] -> [e]
(L.++)
    !^ :: [e] -> Int -> e
(!^)   = [e] -> Int -> e
forall a. [a] -> Int -> a
(L.!!)
    
    fromList :: [e] -> [e]
fromList     = [e] -> [e]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    fromListN :: Int -> [e] -> [e]
fromListN    = Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
take
    fromFoldable :: f e -> [e]
fromFoldable = f e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    
    write :: [e] -> Int -> e -> [e]
write [e]
es Int
n e
e = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? [e]
es ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> [e]
go Int
n [e]
es
      where
        go :: Int -> [e] -> [e]
go Int
i (e
x : [e]
xs) = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e]
xs ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ e
x e -> [e] -> [e]
forall a. a -> [a] -> [a]
: Int -> [e] -> [e]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [e]
xs
        go Int
_ [e]
_ = []
    
    toLast :: [e] -> e -> [e]
toLast = (e -> [e] -> [e]) -> [e] -> e -> [e]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((e -> [e] -> [e]) -> [e] -> [e] -> [e]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (:) ([e] -> [e] -> [e]) -> (e -> [e]) -> e -> [e] -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> [e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    listR :: [e] -> [e]
listR  = [e] -> [e]
forall e. [e] -> [e]
L.reverse
    listL :: [e] -> [e]
listL  = [e] -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    nubBy :: Equal e -> [e] -> [e]
nubBy  = Equal e -> [e] -> [e]
forall e. Equal e -> [e] -> [e]
L.nubBy
    
    -- | O(1) force, same as 'id'.
    force :: [e] -> [e]
force = [e] -> [e]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    
    uncons :: [e] -> (e, [e])
uncons    []    = PatternMatchFail -> (e, [e])
forall a e. Exception e => e -> a
throw (PatternMatchFail -> (e, [e])) -> PatternMatchFail -> (e, [e])
forall a b. (a -> b) -> a -> b
$ String -> PatternMatchFail
PatternMatchFail String
"in SDP.Linear.(:>)"
    uncons (e
e : [e]
es) = (e
e, [e]
es)
    
    unsnoc :: [e] -> ([e], e)
unsnoc   [ ]    = PatternMatchFail -> ([e], e)
forall a e. Exception e => e -> a
throw (PatternMatchFail -> ([e], e)) -> PatternMatchFail -> ([e], e)
forall a b. (a -> b) -> a -> b
$ String -> PatternMatchFail
PatternMatchFail String
"in SDP.Linear.(:<)"
    unsnoc   [e
e]    = ([], e
e)
    unsnoc (e
e : [e]
es) = let ([e]
es', e
e') = [e] -> ([e], e)
forall l e. Linear l e => l -> (l, e)
unsnoc [e]
es in (e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e]
es', e
e')
    
    filter :: (e -> Bool) -> [e] -> [e]
filter      = (e -> Bool) -> [e] -> [e]
forall e. (e -> Bool) -> [e] -> [e]
L.filter
    reverse :: [e] -> [e]
reverse     = [e] -> [e]
forall e. [e] -> [e]
L.reverse
    replicate :: Int -> e -> [e]
replicate   = Int -> e -> [e]
forall e. Int -> e -> [e]
L.replicate
    partition :: (e -> Bool) -> [e] -> ([e], [e])
partition   = (e -> Bool) -> [e] -> ([e], [e])
forall e. (e -> Bool) -> [e] -> ([e], [e])
L.partition
    concatMap :: (a -> [e]) -> f a -> [e]
concatMap   = (a -> [e]) -> f a -> [e]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
L.concatMap
    intersperse :: e -> [e] -> [e]
intersperse = e -> [e] -> [e]
forall a. a -> [a] -> [a]
L.intersperse
    isSubseqOf :: [e] -> [e] -> Bool
isSubseqOf  = [e] -> [e] -> Bool
forall e. Eq e => [e] -> [e] -> Bool
L.isSubsequenceOf
    
    before :: [e] -> Int -> e -> [e]
before [e]
es Int
i e
e = Int -> [e] -> [e]
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
i) [e]
es
      where
        go :: Int -> [e] -> [e]
go Int
0    [e]
xs    = e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e]
xs
        go Int
n (e
x : [e]
xs) = e
x e -> [e] -> [e]
forall a. a -> [a] -> [a]
: Int -> [e] -> [e]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [e]
xs
        go Int
_    []    = [e
e]
    
    remove :: Int -> [e] -> [e]
remove Int
i [e]
es = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? [e]
es ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> [e]
forall t a. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [e]
es
      where
        go :: t -> [a] -> [a]
go t
0 (a
_ : [a]
xs) = [a]
xs
        go t
n (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [a]
xs
        go t
_    []    = []
    
    iterate :: Int -> (e -> e) -> e -> [e]
iterate Int
n e -> e
f e
e = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? [] ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
: Int -> (e -> e) -> e -> [e]
forall l e. Linear l e => Int -> (e -> e) -> e -> l
iterate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) e -> e
f (e -> e
f e
e)
    
    ofoldr :: (Int -> e -> b -> b) -> b -> [e] -> b
ofoldr Int -> e -> b -> b
f b
base =
      let go :: Int -> [e] -> b
go !Int
i [e]
es = case [e]
es of {(e
x : [e]
xs) -> Int -> e -> b -> b
f Int
i e
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [e]
xs; [e]
_ -> b
base}
      in  Int -> [e] -> b
go Int
0
    
    ofoldl :: (Int -> b -> e -> b) -> b -> [e] -> b
ofoldl Int -> b -> e -> b
f =
      let go :: Int -> b -> [e] -> b
go !Int
i b
base [e]
es = case [e]
es of {(e
x : [e]
xs) -> Int -> b -> [e] -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> b -> e -> b
f Int
i b
base e
x) [e]
xs; [e]
_ -> b
base}
      in  Int -> b -> [e] -> b
go Int
0
    
    o_foldr' :: (e -> b -> b) -> b -> [e] -> b
o_foldr' = (e -> b -> b) -> b -> [e] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr'
    o_foldl' :: (b -> e -> b) -> b -> [e] -> b
o_foldl' = (b -> e -> b) -> b -> [e] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    o_foldr :: (e -> b -> b) -> b -> [e] -> b
o_foldr  = (e -> b -> b) -> b -> [e] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    o_foldl :: (b -> e -> b) -> b -> [e] -> b
o_foldl  = (b -> e -> b) -> b -> [e] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl

instance Split [e] e
  where
    take :: Int -> [e] -> [e]
take  = Int -> [e] -> [e]
forall e. Int -> [e] -> [e]
L.take
    drop :: Int -> [e] -> [e]
drop  = Int -> [e] -> [e]
forall e. Int -> [e] -> [e]
L.drop
    split :: Int -> [e] -> ([e], [e])
split = Int -> [e] -> ([e], [e])
forall e. Int -> [e] -> ([e], [e])
L.splitAt
    
    each :: Int -> [e] -> [e]
each Int
n = case Int
n Compare Int
forall o. Ord o => Compare o
<=> Int
1 of {Ordering
LT -> [e] -> [e] -> [e]
forall a b. a -> b -> a
const []; Ordering
EQ -> [e] -> [e]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id; Ordering
GT -> Int -> [e] -> [e]
go Int
n}
      where
        go :: Int -> [e] -> [e]
go Int
i (e
x : [e]
xs) = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? e
x e -> [e] -> [e]
forall a. a -> [a] -> [a]
: Int -> [e] -> [e]
go Int
n [e]
xs ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> [e]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [e]
xs
        go Int
_ [e]
_ = []
    
    infixes :: [e] -> [e] -> [Int]
infixes  [e]
Z  = [Int] -> [e] -> [Int]
forall a b. a -> b -> a
const []
    infixes [e]
sub = Int -> [e] -> [Int]
go Int
0
      where
        go :: Int -> [e] -> [Int]
go Int
_ [] = []
        go Int
i [e]
es = [e]
sub [e] -> [e] -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isPrefixOf` [e]
es Bool -> [Int] -> [Int] -> [Int]
forall a. Bool -> a -> a -> a
? Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [e] -> [Int]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
drop Int
n [e]
es) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> [Int]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([e] -> [e]
forall l e. Linear l e => l -> l
tail [e]
es)
        
        n :: Int
n = [e] -> Int
forall b i. Bordered b i => b -> Int
sizeOf [e]
sub
    
    combo :: Equal e -> [e] -> Int
combo Equal e
_ [ ] = Int
0
    combo Equal e
_ [e
_] = Int
1
    combo Equal e
f (e
e1 : e
e2 : [e]
es) = e
e1 Equal e
`f` e
e2 Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int -> e -> [e] -> Int
go Int
2 e
e2 [e]
es (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
1
      where
        go :: Int -> e -> [e] -> Int
go !Int
i e
p (e
x : [e]
xs) = e
p Equal e
`f` e
x Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int -> e -> [e] -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) e
x [e]
xs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
i
        go  Int
i e
_    [e]
_     = Int
i
    
    splitBy :: (e -> Bool) -> [e] -> ([e], [e])
splitBy  e -> Bool
f [e]
es = let ([e]
as, [e]
bs) = (e -> Bool) -> [e] -> ([e], [e])
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
breakl e -> Bool
f [e]
es in [e] -> Bool
forall e. Nullable e => e -> Bool
isNull [e]
bs Bool -> ([e], [e]) -> ([e], [e]) -> ([e], [e])
forall a. Bool -> a -> a -> a
? ([e]
es, []) (([e], [e]) -> ([e], [e])) -> ([e], [e]) -> ([e], [e])
forall a b. (a -> b) -> a -> b
$ ([e]
as, [e] -> [e]
forall l e. Linear l e => l -> l
tail [e]
bs)
    divideBy :: (e -> Bool) -> [e] -> ([e], [e])
divideBy e -> Bool
f [e]
es = let ([e]
as, [e]
bs) = (e -> Bool) -> [e] -> ([e], [e])
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
breakr e -> Bool
f [e]
es in [e] -> Bool
forall e. Nullable e => e -> Bool
isNull [e]
as Bool -> ([e], [e]) -> ([e], [e]) -> ([e], [e])
forall a. Bool -> a -> a -> a
? ([], [e]
es) (([e], [e]) -> ([e], [e])) -> ([e], [e]) -> ([e], [e])
forall a b. (a -> b) -> a -> b
$ ([e] -> [e]
forall l e. Linear l e => l -> l
init [e]
as, [e]
bs)
    splitsBy :: (e -> Bool) -> [e] -> [[e]]
splitsBy e -> Bool
f [e]
es = (e -> Bool) -> [e] -> [e]
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile e -> Bool
f ([e] -> [e]) -> [[e]] -> [[e]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e -> Bool) -> [e] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
L.findIndices e -> Bool
f [e]
es [Int] -> [e] -> [[e]]
forall s e (f :: * -> *).
(Split s e, Foldable f) =>
f Int -> s -> [s]
`parts` [e]
es
    
    isPrefixOf :: [e] -> [e] -> Bool
isPrefixOf = [e] -> [e] -> Bool
forall e. Eq e => [e] -> [e] -> Bool
L.isPrefixOf
    isSuffixOf :: [e] -> [e] -> Bool
isSuffixOf = [e] -> [e] -> Bool
forall e. Eq e => [e] -> [e] -> Bool
L.isSuffixOf
    isInfixOf :: [e] -> [e] -> Bool
isInfixOf  = [e] -> [e] -> Bool
forall e. Eq e => [e] -> [e] -> Bool
L.isInfixOf
    
    breakl :: (e -> Bool) -> [e] -> ([e], [e])
breakl = (e -> Bool) -> [e] -> ([e], [e])
forall e. (e -> Bool) -> [e] -> ([e], [e])
L.break
    spanl :: (e -> Bool) -> [e] -> ([e], [e])
spanl  = (e -> Bool) -> [e] -> ([e], [e])
forall e. (e -> Bool) -> [e] -> ([e], [e])
L.span
    
    selectWhile :: (e -> Maybe a) -> [e] -> [a]
selectWhile e -> Maybe a
_    []    = []
    selectWhile e -> Maybe a
f (e
x : [e]
xs) = case e -> Maybe a
f e
x of {(Just a
e) -> a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (e -> Maybe a) -> [e] -> [a]
forall l e a. Linear l e => (e -> Maybe a) -> l -> [a]
select e -> Maybe a
f [e]
xs; Maybe a
_ -> []}
    
    selectEnd :: (e -> Maybe a) -> [e] -> [a]
selectEnd e -> Maybe a
f = [a] -> [a]
forall l e. Linear l e => l -> l
reverse ([a] -> [a]) -> ([e] -> [a]) -> [e] -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> Maybe a) -> [e] -> [a]
forall s e a. Split s e => (e -> Maybe a) -> s -> [a]
selectWhile e -> Maybe a
f ([e] -> [a]) -> ([e] -> [e]) -> [e] -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [e] -> [e]
forall l e. Linear l e => l -> l
reverse

--------------------------------------------------------------------------------

-- | @stripPrefix sub line@ strips prefix @sub@ of @line@ (if any).
stripPrefix :: (Split s e, Bordered s i, Eq e) => s -> s -> s
stripPrefix :: s -> s -> s
stripPrefix s
sub s
line = s
sub s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isPrefixOf` s
line Bool -> s -> s -> s
forall a. Bool -> a -> a -> a
? Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
sub) s
line (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s
line

-- | @stripSuffix sub line@ strips suffix @sub@ of @line@ (if any).
stripSuffix :: (Split s e, Bordered s i, Eq e) => s -> s -> s
stripSuffix :: s -> s -> s
stripSuffix s
sub s
line = s
sub s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
`isSuffixOf` s
line Bool -> s -> s -> s
forall a. Bool -> a -> a -> a
? Int -> s -> s
forall s e. Split s e => Int -> s -> s
sans (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
sub) s
line (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s
line

-- | @stripPrefix' sub line@ strips prefix @sub@ of @line@ or returns 'Nothing'.
stripPrefix' :: (Split s e, Bordered s i, Eq e) => s -> s -> Maybe s
stripPrefix' :: s -> s -> Maybe s
stripPrefix' s
sub = s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
isPrefixOf s
sub (s -> Bool) -> (s -> s) -> s -> Maybe s
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?+ Int -> s -> s
forall s e. Split s e => Int -> s -> s
drop (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
sub)

-- | @stripSuffix sub line@ strips suffix @sub@ of @line@ or returns 'Nothing'.
stripSuffix' :: (Split s e, Bordered s i, Eq e) => s -> s -> Maybe s
stripSuffix' :: s -> s -> Maybe s
stripSuffix' s
sub = s -> s -> Bool
forall s e. (Split s e, Eq e) => s -> s -> Bool
isSuffixOf s
sub (s -> Bool) -> (s -> s) -> s -> Maybe s
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?+ Int -> s -> s
forall s e. Split s e => Int -> s -> s
sans (s -> Int
forall b i. Bordered b i => b -> Int
sizeOf s
sub)

-- | intercalate is generalization of intercalate
intercalate :: (Foldable f, Linear1 f l, Linear l e) => l -> f l -> l
intercalate :: l -> f l -> l
intercalate =  f l -> l
forall l e (f :: * -> *). (Linear l e, Foldable f) => f l -> l
concat (f l -> l) -> (l -> f l -> f l) -> l -> f l -> l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... l -> f l -> f l
forall l e. Linear l e => e -> l -> l
intersperse

-- | @tails es@ returns sequence of @es@ tails.
tails :: (Linear l e) => l -> [l]
tails :: l -> [l]
tails l
Z  = [l
forall e. Nullable e => e
Z]
tails l
es = l
es l -> [l] -> [l]
forall a. a -> [a] -> [a]
: l -> [l]
forall l e. Linear l e => l -> [l]
tails (l -> l
forall l e. Linear l e => l -> l
tail l
es)

-- | tails is generalization of inits.
inits :: (Linear l e) => l -> [l]
inits :: l -> [l]
inits l
Z  = [l
forall e. Nullable e => e
Z]
inits l
es = l
es l -> [l] -> [l]
forall a. a -> [a] -> [a]
: l -> [l]
forall l e. Linear l e => l -> [l]
inits (l -> l
forall l e. Linear l e => l -> l
init l
es)

{- |
  @ascending es lengths@ checks if the subsequences of @es@ of lengths @lengths@
  is sorted.
-}
ascending :: (Split s e, Sort s e, Ord e) => s -> [Int] -> Bool
ascending :: s -> [Int] -> Bool
ascending =  (s -> Bool) -> [s] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all s -> Bool
forall s e. (Sort s e, Ord e) => s -> Bool
sorted ([s] -> Bool) -> (s -> [Int] -> [s]) -> s -> [Int] -> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ([Int] -> s -> [s]) -> s -> [Int] -> [s]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int] -> s -> [s]
forall s e (f :: * -> *).
(Split s e, Foldable f) =>
f Int -> s -> [s]
splits