{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
-- | Abstractions over sequential data structures, like lists and vectors.
module Data.Sequences where

import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Monoid (Monoid, mconcat, mempty, (<>))
import Data.MonoTraversable
import Data.Int (Int64, Int)
import qualified Data.List as List
import qualified Data.List.Split as List
import qualified Control.Monad (filterM, replicateM)
import Prelude (Bool (..), Monad (..), Maybe (..), Ordering (..), Ord (..), Eq (..), Functor (..), fromIntegral, otherwise, (-), fst, snd, Integral, ($), flip, maybe, error, (||))
import Data.Char (Char, isSpace)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Control.Category
import Control.Arrow ((***), first, second)
import Control.Monad (liftM)
import qualified Data.Sequence as Seq
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Storable as VS
import Data.String (IsString)
import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString.Unsafe as SU
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Algorithms.Merge as VAM
import Data.Ord (comparing)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy.Encoding as TL
import Data.Text.Encoding.Error (lenientDecode)
import Data.Word (Word8)

-- | 'SemiSequence' was created to share code between 'IsSequence' and 'NonNull'.
--
-- @Semi@ means 'SemiGroup'
-- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty' or 'NonNull'
-- A Monoid should be able to fill out 'IsSequence'.
--
-- 'SemiSequence' operations maintain the same type because they all maintain the same number of elements or increase them.
-- However, a decreasing function such as filter may change they type.
-- For example, from 'NonEmpty' to '[]'
-- This type-changing function exists on 'NonNull' as 'nfilter'
--
-- 'filter' and other such functions are placed in 'IsSequence'
--
-- /NOTE/: Like 'GrowingAppend', ideally we'd have a @Semigroup@ superclass
-- constraint here, but that would pull in more dependencies to this package
-- than desired.
class (Integral (Index seq), GrowingAppend seq) => SemiSequence seq where
    -- | The type of the index of a sequence.
    type Index seq

    -- | 'intersperse' takes an element and intersperses that element between
    -- the elements of the sequence.
    --
    -- @
    -- > 'intersperse' ',' "abcde"
    -- "a,b,c,d,e"
    -- @
    intersperse :: Element seq -> seq -> seq

    -- | Reverse a sequence
    --
    -- @
    -- > 'reverse' "hello world"
    -- "dlrow olleh"
    -- @
    reverse :: seq -> seq

    -- | 'find' takes a predicate and a sequence and returns the first element in
    -- the sequence matching the predicate, or 'Nothing' if there isn't an element
    -- that matches the predicate.
    --
    -- @
    -- > 'find' (== 5) [1 .. 10]
    -- 'Just' 5
    --
    -- > 'find' (== 15) [1 .. 10]
    -- 'Nothing'
    -- @
    find :: (Element seq -> Bool) -> seq -> Maybe (Element seq)

    -- | Sort a sequence using an supplied element ordering function.
    --
    -- @
    -- > let compare' x y = case 'compare' x y of LT -> GT; EQ -> EQ; GT -> LT
    -- > 'sortBy' compare' [5,3,6,1,2,4]
    -- [6,5,4,3,2,1]
    -- @
    sortBy :: (Element seq -> Element seq -> Ordering) -> seq -> seq

    -- | Prepend an element onto a sequence.
    --
    -- @
    -- > 4 \``cons`` [1,2,3]
    -- [4,1,2,3]
    -- @
    cons :: Element seq -> seq -> seq

    -- | Append an element onto a sequence.
    --
    -- @
    -- > [1,2,3] \``snoc`` 4
    -- [1,2,3,4]
    -- @
    snoc :: seq -> Element seq -> seq

-- | Create a sequence from a single element.
--
-- @
-- > 'singleton' 'a' :: 'String'
-- "a"
-- > 'singleton' 'a' :: 'Vector' 'Char'
-- 'Data.Vector.fromList' "a"
-- @
singleton :: MonoPointed seq => Element seq -> seq
singleton :: forall seq. MonoPointed seq => Element seq -> seq
singleton = forall seq. MonoPointed seq => Element seq -> seq
opoint
{-# INLINE singleton #-}

-- | Sequence Laws:
--
-- @
-- 'fromList' . 'otoList' = 'id'
-- 'fromList' (x <> y) = 'fromList' x <> 'fromList' y
-- 'otoList' ('fromList' x <> 'fromList' y) = x <> y
-- @
class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => IsSequence seq where
    -- | Convert a list to a sequence.
    --
    -- @
    -- > 'fromList' ['a', 'b', 'c'] :: Text
    -- "abc"
    -- @
    fromList :: [Element seq] -> seq
    -- this definition creates the Monoid constraint
    -- However, all the instances define their own fromList
    fromList = forall a. Monoid a => [a] -> a
mconcat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall seq. MonoPointed seq => Element seq -> seq
singleton

    -- | 'lengthIndex' returns the length of a sequence as @'Index' seq@.
    --
    -- @since 1.0.2
    lengthIndex :: seq -> Index seq;
    lengthIndex = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> Int64
olength64;

    -- below functions change type fron the perspective of NonEmpty

    -- | 'break' applies a predicate to a sequence, and returns a tuple where
    -- the first element is the longest prefix (possibly empty) of elements that
    -- /do not satisfy/ the predicate. The second element of the tuple is the
    -- remainder of the sequence.
    --
    -- @'break' p@ is equivalent to @'span' ('not' . p)@
    --
    -- @
    -- > 'break' (> 3) ('fromList' [1,2,3,4,1,2,3,4] :: 'Vector' 'Int')
    -- (fromList [1,2,3],fromList [4,1,2,3,4])
    --
    -- > 'break' (< 'z') ('fromList' "abc" :: 'Text')
    -- ("","abc")
    --
    -- > 'break' (> 'z') ('fromList' "abc" :: 'Text')
    -- ("abc","")
    -- @
    break :: (Element seq -> Bool) -> seq -> (seq, seq)
    break Element seq -> Bool
f = (forall seq. IsSequence seq => [Element seq] -> seq
fromList forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall seq. IsSequence seq => [Element seq] -> seq
fromList) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'span' applies a predicate to a sequence, and returns a tuple where
    -- the first element is the longest prefix (possibly empty) that
    -- /does satisfy/ the predicate. The second element of the tuple is the
    -- remainder of the sequence.
    --
    -- @'span' p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
    --
    -- @
    -- > 'span' (< 3) ('fromList' [1,2,3,4,1,2,3,4] :: 'Vector' 'Int')
    -- (fromList [1,2],fromList [3,4,1,2,3,4])
    --
    -- > 'span' (< 'z') ('fromList' "abc" :: 'Text')
    -- ("abc","")
    --
    -- > 'span' (< 0) [1,2,3]
    -- ([],[1,2,3])
    -- @
    span :: (Element seq -> Bool) -> seq -> (seq, seq)
    span Element seq -> Bool
f = (forall seq. IsSequence seq => [Element seq] -> seq
fromList forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall seq. IsSequence seq => [Element seq] -> seq
fromList) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'dropWhile' returns the suffix remaining after 'takeWhile'.
    --
    -- @
    -- > 'dropWhile' (< 3) [1,2,3,4,5,1,2,3]
    -- [3,4,5,1,2,3]
    --
    -- > 'dropWhile' (< 'z') ('fromList' "abc" :: 'Text')
    -- ""
    -- @
    dropWhile :: (Element seq -> Bool) -> seq -> seq
    dropWhile Element seq -> Bool
f = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'takeWhile' applies a predicate to a sequence, and returns the
    -- longest prefix (possibly empty) of the sequence of elements that
    -- /satisfy/ the predicate.
    --
    -- @
    -- > 'takeWhile' (< 3) [1,2,3,4,5,1,2,3]
    -- [1,2]
    --
    -- > 'takeWhile' (< 'z') ('fromList' "abc" :: 'Text')
    -- "abc"
    -- @
    takeWhile :: (Element seq -> Bool) -> seq -> seq
    takeWhile Element seq -> Bool
f = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | @'splitAt' n se@ returns a tuple where the first element is the prefix of
    -- the sequence @se@ with length @n@, and the second element is the remainder of
    -- the sequence.
    --
    -- @
    -- > 'splitAt' 6 "Hello world!"
    -- ("Hello ","world!")
    --
    -- > 'splitAt' 3 ('fromList' [1,2,3,4,5] :: 'Vector' 'Int')
    -- (fromList [1,2,3],fromList [4,5])
    -- @
    splitAt :: Index seq -> seq -> (seq, seq)
    splitAt Index seq
i = (forall seq. IsSequence seq => [Element seq] -> seq
fromList forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall seq. IsSequence seq => [Element seq] -> seq
fromList) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall i a. Integral i => i -> [a] -> ([a], [a])
List.genericSplitAt Index seq
i forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | Equivalent to 'splitAt'.
    unsafeSplitAt :: Index seq -> seq -> (seq, seq)
    unsafeSplitAt Index seq
i seq
seq = (forall seq. IsSequence seq => Index seq -> seq -> seq
unsafeTake Index seq
i seq
seq, forall seq. IsSequence seq => Index seq -> seq -> seq
unsafeDrop Index seq
i seq
seq)

    -- | @'take' n@ returns the prefix of a sequence of length @n@, or the
    -- sequence itself if @n > 'olength' seq@.
    --
    -- @
    -- > 'take' 3 "abcdefg"
    -- "abc"
    -- > 'take' 4 ('fromList' [1,2,3,4,5,6] :: 'Vector' 'Int')
    -- fromList [1,2,3,4]
    -- @
    take :: Index seq -> seq -> seq
    take Index seq
i = forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => Index seq -> seq -> (seq, seq)
splitAt Index seq
i

    -- | Equivalent to 'take'.
    unsafeTake :: Index seq -> seq -> seq
    unsafeTake = forall seq. IsSequence seq => Index seq -> seq -> seq
take

    -- | @'drop' n@ returns the suffix of a sequence after the first @n@
    -- elements, or an empty sequence if @n > 'olength' seq@.
    --
    -- @
    -- > 'drop' 3 "abcdefg"
    -- "defg"
    -- > 'drop' 4 ('fromList' [1,2,3,4,5,6] :: 'Vector' 'Int')
    -- fromList [5,6]
    -- @
    drop :: Index seq -> seq -> seq
    drop Index seq
i = forall a b. (a, b) -> b
snd forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => Index seq -> seq -> (seq, seq)
splitAt Index seq
i

    -- | Equivalent to 'drop'
    unsafeDrop :: Index seq -> seq -> seq
    unsafeDrop = forall seq. IsSequence seq => Index seq -> seq -> seq
drop

    -- | Same as 'drop' but drops from the end of the sequence instead.
    --
    -- @
    -- > 'dropEnd' 3 "abcdefg"
    -- "abcd"
    -- > 'dropEnd' 4 ('fromList' [1,2,3,4,5,6] :: 'Vector' 'Int')
    -- fromList [1,2]
    -- @
    --
    -- @since 1.0.4.0
    dropEnd :: Index seq -> seq -> seq
    dropEnd Index seq
i seq
s = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> (seq, seq)
splitAt (forall seq. IsSequence seq => seq -> Index seq
lengthIndex seq
s forall a. Num a => a -> a -> a
- Index seq
i) seq
s

    -- | 'partition' takes a predicate and a sequence and returns the pair of
    -- sequences of elements which do and do not satisfy the predicate.
    --
    -- @
    -- 'partition' p se = ('filter' p se, 'filter' ('not' . p) se)
    -- @
    partition :: (Element seq -> Bool) -> seq -> (seq, seq)
    partition Element seq -> Bool
f = (forall seq. IsSequence seq => [Element seq] -> seq
fromList forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall seq. IsSequence seq => [Element seq] -> seq
fromList) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'uncons' returns the tuple of the first element of a sequence and the rest
    -- of the sequence, or 'Nothing' if the sequence is empty.
    --
    -- @
    -- > 'uncons' ('fromList' [1,2,3,4] :: 'Vector' 'Int')
    -- 'Just' (1,fromList [2,3,4])
    --
    -- > 'uncons' ([] :: ['Int'])
    -- 'Nothing'
    -- @
    uncons :: seq -> Maybe (Element seq, seq)
    uncons = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall seq. IsSequence seq => [Element seq] -> seq
fromList) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'unsnoc' returns the tuple of the init of a sequence and the last element,
    -- or 'Nothing' if the sequence is empty.
    --
    -- @
    -- > 'unsnoc' ('fromList' [1,2,3,4] :: 'Vector' 'Int')
    -- 'Just' (fromList [1,2,3],4)
    --
    -- > 'unsnoc' ([] :: ['Int'])
    -- 'Nothing'
    -- @
    unsnoc :: seq -> Maybe (seq, Element seq)
    unsnoc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall seq. IsSequence seq => [Element seq] -> seq
fromList) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'filter' given a predicate returns a sequence of all elements that satisfy
    -- the predicate.
    --
    -- @
    -- > 'filter' (< 5) [1 .. 10]
    -- [1,2,3,4]
    -- @
    filter :: (Element seq -> Bool) -> seq -> seq
    filter Element seq -> Bool
f = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> [a]
List.filter Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | The monadic version of 'filter'.
    filterM :: Monad m => (Element seq -> m Bool) -> seq -> m seq
    filterM Element seq -> m Bool
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
(Element seq -> m Bool) -> seq -> m seq
filterM Element seq -> m Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- replicates are not in SemiSequence to allow for zero

    -- | @'replicate' n x@ is a sequence of length @n@ with @x@ as the
    -- value of every element.
    --
    -- @
    -- > 'replicate' 10 'a' :: Text
    -- "aaaaaaaaaa"
    -- @
    replicate :: Index seq -> Element seq -> seq
    replicate Index seq
i = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall i a. Integral i => i -> a -> [a]
List.genericReplicate Index seq
i

    -- | The monadic version of 'replicateM'.
    replicateM :: Monad m => Index seq -> m (Element seq) -> m seq
    replicateM Index seq
i = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Control.Monad.replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Index seq
i)

    -- below functions are not in SemiSequence because they return a List (instead of NonEmpty)

    -- | 'group' takes a sequence and returns a list of sequences such that the
    -- concatenation of the result is equal to the argument. Each subsequence in
    -- the result contains only equal elements, using the supplied equality test.
    --
    -- @
    -- > 'groupBy' (==) "Mississippi"
    -- ["M","i","ss","i","ss","i","pp","i"]
    -- @
    groupBy :: (Element seq -> Element seq -> Bool) -> seq -> [seq]
    groupBy Element seq -> Element seq -> Bool
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy Element seq -> Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | Similar to standard 'groupBy', but operates on the whole collection,
    -- not just the consecutive items.
    groupAllOn :: Eq b => (Element seq -> b) -> seq -> [seq]
    groupAllOn Element seq -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq b.
(IsSequence seq, Eq b) =>
(Element seq -> b) -> seq -> [seq]
groupAllOn Element seq -> b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'subsequences' returns a list of all subsequences of the argument.
    --
    -- @
    -- > 'subsequences' "abc"
    -- ["","a","b","ab","c","ac","bc","abc"]
    -- @
    subsequences :: seq -> [seq]
    subsequences = forall a b. (a -> b) -> [a] -> [b]
List.map forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. [a] -> [[a]]
List.subsequences forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | 'permutations' returns a list of all permutations of the argument.
    --
    -- @
    -- > 'permutations' "abc"
    -- ["abc","bac","cba","bca","cab","acb"]
    -- @
    permutations :: seq -> [seq]
    permutations = forall a b. (a -> b) -> [a] -> [b]
List.map forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. [a] -> [[a]]
List.permutations forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

    -- | __Unsafe__
    --
    -- Get the tail of a sequence, throw an exception if the sequence is empty.
    --
    -- @
    -- > 'tailEx' [1,2,3]
    -- [2,3]
    -- @
    tailEx :: seq -> seq
    tailEx = forall a b. (a, b) -> b
snd forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequences.tailEx") forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons

    -- | Safe version of 'tailEx'.
    --
    -- Returns 'Nothing' instead of throwing an exception when encountering
    -- an empty monomorphic container.
    --
    -- @since 1.0.0
    tailMay :: seq -> Maybe seq
    tailMay seq
seq
        | forall mono. MonoFoldable mono => mono -> Bool
onull seq
seq = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall seq. IsSequence seq => seq -> seq
tailEx seq
seq)
    {-# INLINE tailMay #-}

    -- | __Unsafe__
    --
    -- Get the init of a sequence, throw an exception if the sequence is empty.
    --
    -- @
    -- > 'initEx' [1,2,3]
    -- [1,2]
    -- @
    initEx :: seq -> seq
    initEx = forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequences.initEx") forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc

    -- | Safe version of 'initEx'.
    --
    -- Returns 'Nothing' instead of throwing an exception when encountering
    -- an empty monomorphic container.
    --
    -- @since 1.0.0
    initMay :: IsSequence seq => seq -> Maybe seq
    initMay seq
seq
        | forall mono. MonoFoldable mono => mono -> Bool
onull seq
seq = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall seq. IsSequence seq => seq -> seq
initEx seq
seq)
    {-# INLINE initMay #-}

    -- | Equivalent to 'tailEx'.
    unsafeTail :: seq -> seq
    unsafeTail = forall seq. IsSequence seq => seq -> seq
tailEx

    -- | Equivalent to 'initEx'.
    unsafeInit :: seq -> seq
    unsafeInit = forall seq. IsSequence seq => seq -> seq
initEx

    -- | Get the element of a sequence at a certain index, returns 'Nothing'
    -- if that index does not exist.
    --
    -- @
    -- > 'index' ('fromList' [1,2,3] :: 'Vector' 'Int') 1
    -- 'Just' 2
    -- > 'index' ('fromList' [1,2,3] :: 'Vector' 'Int') 4
    -- 'Nothing'
    -- @
    index :: seq -> Index seq -> Maybe (Element seq)
    index seq
seq' Index seq
idx
        | Index seq
idx forall a. Ord a => a -> a -> Bool
< Index seq
0 = forall a. Maybe a
Nothing
        | Bool
otherwise = forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay (forall seq. IsSequence seq => Index seq -> seq -> seq
drop Index seq
idx seq
seq')

    -- | __Unsafe__
    --
    -- Get the element of a sequence at a certain index, throws an exception
    -- if the index does not exist.
    indexEx :: seq -> Index seq -> Element seq
    indexEx seq
seq' Index seq
idx = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequences.indexEx") forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (forall seq.
IsSequence seq =>
seq -> Index seq -> Maybe (Element seq)
index seq
seq' Index seq
idx)

    -- | Equivalent to 'indexEx'.
    unsafeIndex :: seq -> Index seq -> Element seq
    unsafeIndex = forall seq. IsSequence seq => seq -> Index seq -> Element seq
indexEx

    -- | 'splitWhen' splits a sequence into components delimited by separators,
    -- where the predicate returns True for a separator element. The resulting
    -- components do not contain the separators. Two adjacent separators result
    -- in an empty component in the output. The number of resulting components
    -- is greater by one than number of separators.
    --
    -- Since 0.9.3
    splitWhen :: (Element seq -> Bool) -> seq -> [seq]
    splitWhen = forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> [seq]
defaultSplitWhen

    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE unsafeSplitAt #-}
    {-# INLINE take #-}
    {-# INLINE unsafeTake #-}
    {-# INLINE drop #-}
    {-# INLINE unsafeDrop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE filterM #-}
    {-# INLINE replicate #-}
    {-# INLINE replicateM #-}
    {-# INLINE groupBy #-}
    {-# INLINE groupAllOn #-}
    {-# INLINE subsequences #-}
    {-# INLINE permutations #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE unsafeTail #-}
    {-# INLINE unsafeInit #-}
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}
    {-# INLINE splitWhen #-}

-- | Use "Data.List"'s implementation of 'Data.List.find'.
defaultFind :: MonoFoldable seq => (Element seq -> Bool) -> seq -> Maybe (Element seq)
defaultFind :: forall seq.
MonoFoldable seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
defaultFind Element seq -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultFind #-}

-- | Use "Data.List"'s implementation of 'Data.List.intersperse'.
defaultIntersperse :: IsSequence seq => Element seq -> seq -> seq
defaultIntersperse :: forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse Element seq
e = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> [a] -> [a]
List.intersperse Element seq
e forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultIntersperse #-}

-- | Use "Data.List"'s implementation of 'Data.List.reverse'.
defaultReverse :: IsSequence seq => seq -> seq
defaultReverse :: forall seq. IsSequence seq => seq -> seq
defaultReverse = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. [a] -> [a]
List.reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultReverse #-}

-- | Use "Data.List"'s implementation of 'Data.List.sortBy'.
defaultSortBy :: IsSequence seq => (Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy :: forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy Element seq -> Element seq -> Ordering
f = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element seq -> Element seq -> Ordering
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultSortBy #-}

-- | Use 'splitWhen' from "Data.List.Split"
defaultSplitWhen :: IsSequence seq => (Element seq -> Bool) -> seq -> [seq]
defaultSplitWhen :: forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> [seq]
defaultSplitWhen Element seq -> Bool
f = forall a b. (a -> b) -> [a] -> [b]
List.map forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> [[a]]
List.splitWhen Element seq -> Bool
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultSplitWhen #-}

-- | Sort a vector using an supplied element ordering function.
vectorSortBy :: VG.Vector v e => (e -> e -> Ordering) -> v e -> v e
vectorSortBy :: forall (v :: * -> *) e.
Vector v e =>
(e -> e -> Ordering) -> v e -> v e
vectorSortBy e -> e -> Ordering
f = forall (v :: * -> *) a.
Vector v a =>
(forall s. Mutable v s a -> ST s ()) -> v a -> v a
VG.modify (forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VAM.sortBy e -> e -> Ordering
f)
{-# INLINE vectorSortBy #-}

-- | Sort a vector.
vectorSort :: (VG.Vector v e, Ord e) => v e -> v e
vectorSort :: forall (v :: * -> *) e. (Vector v e, Ord e) => v e -> v e
vectorSort = forall (v :: * -> *) a.
Vector v a =>
(forall s. Mutable v s a -> ST s ()) -> v a -> v a
VG.modify forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
VAM.sort
{-# INLINE vectorSort #-}

-- | Use "Data.List"'s 'Data.List.:' to prepend an element to a sequence.
defaultCons :: IsSequence seq => Element seq -> seq -> seq
defaultCons :: forall seq. IsSequence seq => Element seq -> seq -> seq
defaultCons Element seq
e = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq
eforall a. a -> [a] -> [a]
:) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultCons #-}

-- | Use "Data.List"'s 'Data.List.++' to append an element to a sequence.
defaultSnoc :: IsSequence seq => seq -> Element seq -> seq
defaultSnoc :: forall seq. IsSequence seq => seq -> Element seq -> seq
defaultSnoc seq
seq Element seq
e = forall seq. IsSequence seq => [Element seq] -> seq
fromList (forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
seq forall a. [a] -> [a] -> [a]
List.++ [Element seq
e])
{-# INLINE defaultSnoc #-}

-- | like Data.List.tail, but an input of 'mempty' returns 'mempty'
tailDef :: IsSequence seq => seq -> seq
tailDef :: forall seq. IsSequence seq => seq -> seq
tailDef seq
xs = case forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons seq
xs of
               Maybe (Element seq, seq)
Nothing -> forall a. Monoid a => a
mempty
               Just (Element seq, seq)
tuple -> forall a b. (a, b) -> b
snd (Element seq, seq)
tuple
{-# INLINE tailDef #-}

-- | like Data.List.init, but an input of 'mempty' returns 'mempty'
initDef :: IsSequence seq => seq -> seq
initDef :: forall seq. IsSequence seq => seq -> seq
initDef seq
xs = case forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc seq
xs of
               Maybe (seq, Element seq)
Nothing -> forall a. Monoid a => a
mempty
               Just (seq, Element seq)
tuple -> forall a b. (a, b) -> a
fst (seq, Element seq)
tuple
{-# INLINE initDef #-}

instance SemiSequence [a] where
    type Index [a] = Int
    intersperse :: Element [a] -> [a] -> [a]
intersperse = forall a. a -> [a] -> [a]
List.intersperse
    reverse :: [a] -> [a]
reverse = forall a. [a] -> [a]
List.reverse
    find :: (Element [a] -> Bool) -> [a] -> Maybe (Element [a])
find = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
    sortBy :: (Element [a] -> Element [a] -> Ordering) -> [a] -> [a]
sortBy Element [a] -> Element [a] -> Ordering
f = forall a. Vector a -> [a]
V.toList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element [a] -> Element [a] -> Ordering
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. [a] -> Vector a
V.fromList
    cons :: Element [a] -> [a] -> [a]
cons = (:)
    snoc :: [a] -> Element [a] -> [a]
snoc = forall seq. IsSequence seq => seq -> Element seq -> seq
defaultSnoc
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence [a] where
    fromList :: [Element [a]] -> [a]
fromList = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    lengthIndex :: [a] -> Index [a]
lengthIndex = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length
    filter :: (Element [a] -> Bool) -> [a] -> [a]
filter = forall a. (a -> Bool) -> [a] -> [a]
List.filter
    filterM :: forall (m :: * -> *).
Monad m =>
(Element [a] -> m Bool) -> [a] -> m [a]
filterM = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Control.Monad.filterM
    break :: (Element [a] -> Bool) -> [a] -> ([a], [a])
break = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break
    span :: (Element [a] -> Bool) -> [a] -> ([a], [a])
span = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span
    dropWhile :: (Element [a] -> Bool) -> [a] -> [a]
dropWhile = forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile
    takeWhile :: (Element [a] -> Bool) -> [a] -> [a]
takeWhile = forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile
    splitAt :: Index [a] -> [a] -> ([a], [a])
splitAt = forall a. Int -> [a] -> ([a], [a])
List.splitAt
    take :: Index [a] -> [a] -> [a]
take = forall a. Int -> [a] -> [a]
List.take
    drop :: Index [a] -> [a] -> [a]
drop = forall a. Int -> [a] -> [a]
List.drop
    uncons :: [a] -> Maybe (Element [a], [a])
uncons [] = forall a. Maybe a
Nothing
    uncons (a
x:[a]
xs) = forall a. a -> Maybe a
Just (a
x, [a]
xs)
    unsnoc :: [a] -> Maybe ([a], Element [a])
unsnoc [] = forall a. Maybe a
Nothing
    unsnoc (a
x0:[a]
xs0) =
        forall a. a -> Maybe a
Just (forall {a} {c}. ([a] -> c) -> a -> [a] -> (c, a)
loop forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a
x0 [a]
xs0)
      where
        loop :: ([a] -> c) -> a -> [a] -> (c, a)
loop [a] -> c
front a
x [] = ([a] -> c
front [], a
x)
        loop [a] -> c
front a
x (a
y:[a]
z) = ([a] -> c) -> a -> [a] -> (c, a)
loop ([a] -> c
front forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
xforall a. a -> [a] -> [a]
:)) a
y [a]
z
    partition :: (Element [a] -> Bool) -> [a] -> ([a], [a])
partition = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition
    replicate :: Index [a] -> Element [a] -> [a]
replicate = forall a. Int -> a -> [a]
List.replicate
    replicateM :: forall (m :: * -> *).
Monad m =>
Index [a] -> m (Element [a]) -> m [a]
replicateM = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Control.Monad.replicateM
    groupBy :: (Element [a] -> Element [a] -> Bool) -> [a] -> [[a]]
groupBy = forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy
    groupAllOn :: forall b. Eq b => (Element [a] -> b) -> [a] -> [[a]]
groupAllOn Element [a] -> b
f (a
head : [a]
tail) =
        (a
head forall a. a -> [a] -> [a]
: [a]
matches) forall a. a -> [a] -> [a]
: forall seq b.
(IsSequence seq, Eq b) =>
(Element seq -> b) -> seq -> [seq]
groupAllOn Element [a] -> b
f [a]
nonMatches
      where
        ([a]
matches, [a]
nonMatches) = forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
partition ((forall a. Eq a => a -> a -> Bool
== Element [a] -> b
f a
head) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element [a] -> b
f) [a]
tail
    groupAllOn Element [a] -> b
_ [] = []
    splitWhen :: (Element [a] -> Bool) -> [a] -> [[a]]
splitWhen = forall a. (a -> Bool) -> [a] -> [[a]]
List.splitWhen
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE drop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE filterM #-}
    {-# INLINE replicate #-}
    {-# INLINE replicateM #-}
    {-# INLINE groupBy #-}
    {-# INLINE groupAllOn #-}
    {-# INLINE splitWhen #-}

instance SemiSequence (NE.NonEmpty a) where
    type Index (NE.NonEmpty a) = Int

    intersperse :: Element (NonEmpty a) -> NonEmpty a -> NonEmpty a
intersperse  = forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse
    reverse :: NonEmpty a -> NonEmpty a
reverse      = forall a. NonEmpty a -> NonEmpty a
NE.reverse
    find :: (Element (NonEmpty a) -> Bool)
-> NonEmpty a -> Maybe (Element (NonEmpty a))
find Element (NonEmpty a) -> Bool
x       = forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find Element (NonEmpty a) -> Bool
x forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> [a]
NE.toList
    cons :: Element (NonEmpty a) -> NonEmpty a -> NonEmpty a
cons         = forall a. a -> NonEmpty a -> NonEmpty a
NE.cons
    snoc :: NonEmpty a -> Element (NonEmpty a) -> NonEmpty a
snoc NonEmpty a
xs Element (NonEmpty a)
x    = forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall seq. SemiSequence seq => seq -> Element seq -> seq
snoc Element (NonEmpty a)
x forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty a
xs
    sortBy :: (Element (NonEmpty a) -> Element (NonEmpty a) -> Ordering)
-> NonEmpty a -> NonEmpty a
sortBy Element (NonEmpty a) -> Element (NonEmpty a) -> Ordering
f     = forall a. [a] -> NonEmpty a
NE.fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element (NonEmpty a) -> Element (NonEmpty a) -> Ordering
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> [a]
NE.toList
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance SemiSequence S.ByteString where
    type Index S.ByteString = Int
    intersperse :: Element ByteString -> ByteString -> ByteString
intersperse = Word8 -> ByteString -> ByteString
S.intersperse
    reverse :: ByteString -> ByteString
reverse = ByteString -> ByteString
S.reverse
    find :: (Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
find = (Word8 -> Bool) -> ByteString -> Maybe Word8
S.find
    cons :: Element ByteString -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
S.cons
    snoc :: ByteString -> Element ByteString -> ByteString
snoc = ByteString -> Word8 -> ByteString
S.snoc
    sortBy :: (Element ByteString -> Element ByteString -> Ordering)
-> ByteString -> ByteString
sortBy = forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence S.ByteString where
    fromList :: [Element ByteString] -> ByteString
fromList = [Word8] -> ByteString
S.pack
    lengthIndex :: ByteString -> Index ByteString
lengthIndex = ByteString -> Int
S.length
    replicate :: Index ByteString -> Element ByteString -> ByteString
replicate = Int -> Word8 -> ByteString
S.replicate
    filter :: (Element ByteString -> Bool) -> ByteString -> ByteString
filter = (Word8 -> Bool) -> ByteString -> ByteString
S.filter
    break :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
break = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break
    span :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
span = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.span
    dropWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile
    takeWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile
    splitAt :: Index ByteString -> ByteString -> (ByteString, ByteString)
splitAt = Int -> ByteString -> (ByteString, ByteString)
S.splitAt
    take :: Index ByteString -> ByteString -> ByteString
take = Int -> ByteString -> ByteString
S.take
    unsafeTake :: Index ByteString -> ByteString -> ByteString
unsafeTake = Int -> ByteString -> ByteString
SU.unsafeTake
    drop :: Index ByteString -> ByteString -> ByteString
drop = Int -> ByteString -> ByteString
S.drop
    unsafeDrop :: Index ByteString -> ByteString -> ByteString
unsafeDrop = Int -> ByteString -> ByteString
SU.unsafeDrop
    partition :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
partition = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.partition
    uncons :: ByteString -> Maybe (Element ByteString, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
S.uncons
    unsnoc :: ByteString -> Maybe (ByteString, Element ByteString)
unsnoc ByteString
s
        | ByteString -> Bool
S.null ByteString
s = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (HasCallStack => ByteString -> ByteString
S.init ByteString
s, HasCallStack => ByteString -> Word8
S.last ByteString
s)
    groupBy :: (Element ByteString -> Element ByteString -> Bool)
-> ByteString -> [ByteString]
groupBy = (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
S.groupBy
    tailEx :: ByteString -> ByteString
tailEx = HasCallStack => ByteString -> ByteString
S.tail
    initEx :: ByteString -> ByteString
initEx = HasCallStack => ByteString -> ByteString
S.init
    unsafeTail :: ByteString -> ByteString
unsafeTail = ByteString -> ByteString
SU.unsafeTail
    splitWhen :: (Element ByteString -> Bool) -> ByteString -> [ByteString]
splitWhen Element ByteString -> Bool
f ByteString
s | ByteString -> Bool
S.null ByteString
s = [ByteString
S.empty]
                  | Bool
otherwise = (Word8 -> Bool) -> ByteString -> [ByteString]
S.splitWith Element ByteString -> Bool
f ByteString
s
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE unsafeTake #-}
    {-# INLINE drop #-}
    {-# INLINE unsafeDrop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE replicate #-}
    {-# INLINE groupBy #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE unsafeTail #-}
    {-# INLINE splitWhen #-}

    index :: ByteString -> Index ByteString -> Maybe (Element ByteString)
index ByteString
bs Index ByteString
i
        | Index ByteString
i forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Index ByteString
i forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
S.length ByteString
bs = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (ByteString -> Int -> Word8
SU.unsafeIndex ByteString
bs Index ByteString
i)
    indexEx :: ByteString -> Index ByteString -> Element ByteString
indexEx = HasCallStack => ByteString -> Int -> Word8
S.index
    unsafeIndex :: ByteString -> Index ByteString -> Element ByteString
unsafeIndex = ByteString -> Int -> Word8
SU.unsafeIndex
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance SemiSequence T.Text where
    type Index T.Text = Int
    intersperse :: Element Text -> Text -> Text
intersperse = Char -> Text -> Text
T.intersperse
    reverse :: Text -> Text
reverse = Text -> Text
T.reverse
    find :: (Element Text -> Bool) -> Text -> Maybe (Element Text)
find = (Char -> Bool) -> Text -> Maybe Char
T.find
    cons :: Element Text -> Text -> Text
cons = Char -> Text -> Text
T.cons
    snoc :: Text -> Element Text -> Text
snoc = Text -> Char -> Text
T.snoc
    sortBy :: (Element Text -> Element Text -> Ordering) -> Text -> Text
sortBy = forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence T.Text where
    fromList :: [Element Text] -> Text
fromList = [Char] -> Text
T.pack
    lengthIndex :: Text -> Index Text
lengthIndex = Text -> Int
T.length
    replicate :: Index Text -> Element Text -> Text
replicate Index Text
i Element Text
c = Int -> Text -> Text
T.replicate Index Text
i (Char -> Text
T.singleton Element Text
c)
    filter :: (Element Text -> Bool) -> Text -> Text
filter = (Char -> Bool) -> Text -> Text
T.filter
    break :: (Element Text -> Bool) -> Text -> (Text, Text)
break = (Char -> Bool) -> Text -> (Text, Text)
T.break
    span :: (Element Text -> Bool) -> Text -> (Text, Text)
span = (Char -> Bool) -> Text -> (Text, Text)
T.span
    dropWhile :: (Element Text -> Bool) -> Text -> Text
dropWhile = (Char -> Bool) -> Text -> Text
T.dropWhile
    takeWhile :: (Element Text -> Bool) -> Text -> Text
takeWhile = (Char -> Bool) -> Text -> Text
T.takeWhile
    splitAt :: Index Text -> Text -> (Text, Text)
splitAt = Int -> Text -> (Text, Text)
T.splitAt
    take :: Index Text -> Text -> Text
take = Int -> Text -> Text
T.take
    drop :: Index Text -> Text -> Text
drop = Int -> Text -> Text
T.drop
    dropEnd :: Index Text -> Text -> Text
dropEnd = Int -> Text -> Text
T.dropEnd
    partition :: (Element Text -> Bool) -> Text -> (Text, Text)
partition = (Char -> Bool) -> Text -> (Text, Text)
T.partition
    uncons :: Text -> Maybe (Element Text, Text)
uncons = Text -> Maybe (Char, Text)
T.uncons
    unsnoc :: Text -> Maybe (Text, Element Text)
unsnoc Text
t
        | Text -> Bool
T.null Text
t = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (Text -> Text
T.init Text
t, Text -> Char
T.last Text
t)
    groupBy :: (Element Text -> Element Text -> Bool) -> Text -> [Text]
groupBy = (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy
    tailEx :: Text -> Text
tailEx = Text -> Text
T.tail
    initEx :: Text -> Text
initEx = Text -> Text
T.init
    splitWhen :: (Element Text -> Bool) -> Text -> [Text]
splitWhen = (Char -> Bool) -> Text -> [Text]
T.split
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE drop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE replicate #-}
    {-# INLINE groupBy #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE splitWhen #-}

    index :: Text -> Index Text -> Maybe (Element Text)
index Text
t Index Text
i
        | Index Text
i forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Index Text
i forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
t = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (Text -> Int -> Char
T.index Text
t Index Text
i)
    indexEx :: Text -> Index Text -> Element Text
indexEx = Text -> Int -> Char
T.index
    unsafeIndex :: Text -> Index Text -> Element Text
unsafeIndex = Text -> Int -> Char
T.index
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance SemiSequence L.ByteString where
    type Index L.ByteString = Int64
    intersperse :: Element ByteString -> ByteString -> ByteString
intersperse = Word8 -> ByteString -> ByteString
L.intersperse
    reverse :: ByteString -> ByteString
reverse = ByteString -> ByteString
L.reverse
    find :: (Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
find = (Word8 -> Bool) -> ByteString -> Maybe Word8
L.find
    cons :: Element ByteString -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
L.cons
    snoc :: ByteString -> Element ByteString -> ByteString
snoc = ByteString -> Word8 -> ByteString
L.snoc
    sortBy :: (Element ByteString -> Element ByteString -> Ordering)
-> ByteString -> ByteString
sortBy = forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence L.ByteString where
    fromList :: [Element ByteString] -> ByteString
fromList = [Word8] -> ByteString
L.pack
    lengthIndex :: ByteString -> Index ByteString
lengthIndex = ByteString -> Int64
L.length
    replicate :: Index ByteString -> Element ByteString -> ByteString
replicate = Int64 -> Word8 -> ByteString
L.replicate
    filter :: (Element ByteString -> Bool) -> ByteString -> ByteString
filter = (Word8 -> Bool) -> ByteString -> ByteString
L.filter
    break :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
break = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
L.break
    span :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
span = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
L.span
    dropWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
L.dropWhile
    takeWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
L.takeWhile
    splitAt :: Index ByteString -> ByteString -> (ByteString, ByteString)
splitAt = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt
    take :: Index ByteString -> ByteString -> ByteString
take = Int64 -> ByteString -> ByteString
L.take
    drop :: Index ByteString -> ByteString -> ByteString
drop = Int64 -> ByteString -> ByteString
L.drop
    partition :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
partition = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
L.partition
    uncons :: ByteString -> Maybe (Element ByteString, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
L.uncons
    unsnoc :: ByteString -> Maybe (ByteString, Element ByteString)
unsnoc ByteString
s
        | ByteString -> Bool
L.null ByteString
s = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (HasCallStack => ByteString -> ByteString
L.init ByteString
s, HasCallStack => ByteString -> Word8
L.last ByteString
s)
    groupBy :: (Element ByteString -> Element ByteString -> Bool)
-> ByteString -> [ByteString]
groupBy = (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
L.groupBy
    tailEx :: ByteString -> ByteString
tailEx = HasCallStack => ByteString -> ByteString
L.tail
    initEx :: ByteString -> ByteString
initEx = HasCallStack => ByteString -> ByteString
L.init
    splitWhen :: (Element ByteString -> Bool) -> ByteString -> [ByteString]
splitWhen Element ByteString -> Bool
f ByteString
s | ByteString -> Bool
L.null ByteString
s = [ByteString
L.empty]
                  | Bool
otherwise = (Word8 -> Bool) -> ByteString -> [ByteString]
L.splitWith Element ByteString -> Bool
f ByteString
s
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE drop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE replicate #-}
    {-# INLINE groupBy #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE splitWhen #-}

    indexEx :: ByteString -> Index ByteString -> Element ByteString
indexEx = HasCallStack => ByteString -> Int64 -> Word8
L.index
    unsafeIndex :: ByteString -> Index ByteString -> Element ByteString
unsafeIndex = HasCallStack => ByteString -> Int64 -> Word8
L.index
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance SemiSequence TL.Text where
    type Index TL.Text = Int64
    intersperse :: Element Text -> Text -> Text
intersperse = Char -> Text -> Text
TL.intersperse
    reverse :: Text -> Text
reverse = Text -> Text
TL.reverse
    find :: (Element Text -> Bool) -> Text -> Maybe (Element Text)
find = (Char -> Bool) -> Text -> Maybe Char
TL.find
    cons :: Element Text -> Text -> Text
cons = Char -> Text -> Text
TL.cons
    snoc :: Text -> Element Text -> Text
snoc = Text -> Char -> Text
TL.snoc
    sortBy :: (Element Text -> Element Text -> Ordering) -> Text -> Text
sortBy = forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence TL.Text where
    fromList :: [Element Text] -> Text
fromList = [Char] -> Text
TL.pack
    lengthIndex :: Text -> Index Text
lengthIndex = Text -> Int64
TL.length
    replicate :: Index Text -> Element Text -> Text
replicate Index Text
i Element Text
c = Int64 -> Text -> Text
TL.replicate Index Text
i (Char -> Text
TL.singleton Element Text
c)
    filter :: (Element Text -> Bool) -> Text -> Text
filter = (Char -> Bool) -> Text -> Text
TL.filter
    break :: (Element Text -> Bool) -> Text -> (Text, Text)
break = (Char -> Bool) -> Text -> (Text, Text)
TL.break
    span :: (Element Text -> Bool) -> Text -> (Text, Text)
span = (Char -> Bool) -> Text -> (Text, Text)
TL.span
    dropWhile :: (Element Text -> Bool) -> Text -> Text
dropWhile = (Char -> Bool) -> Text -> Text
TL.dropWhile
    takeWhile :: (Element Text -> Bool) -> Text -> Text
takeWhile = (Char -> Bool) -> Text -> Text
TL.takeWhile
    splitAt :: Index Text -> Text -> (Text, Text)
splitAt = Int64 -> Text -> (Text, Text)
TL.splitAt
    take :: Index Text -> Text -> Text
take = Int64 -> Text -> Text
TL.take
    drop :: Index Text -> Text -> Text
drop = Int64 -> Text -> Text
TL.drop
    partition :: (Element Text -> Bool) -> Text -> (Text, Text)
partition = (Char -> Bool) -> Text -> (Text, Text)
TL.partition
    uncons :: Text -> Maybe (Element Text, Text)
uncons = Text -> Maybe (Char, Text)
TL.uncons
    unsnoc :: Text -> Maybe (Text, Element Text)
unsnoc Text
t
        | Text -> Bool
TL.null Text
t = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (Text -> Text
TL.init Text
t, Text -> Char
TL.last Text
t)
    groupBy :: (Element Text -> Element Text -> Bool) -> Text -> [Text]
groupBy = (Char -> Char -> Bool) -> Text -> [Text]
TL.groupBy
    tailEx :: Text -> Text
tailEx = Text -> Text
TL.tail
    initEx :: Text -> Text
initEx = Text -> Text
TL.init
    splitWhen :: (Element Text -> Bool) -> Text -> [Text]
splitWhen = (Char -> Bool) -> Text -> [Text]
TL.split
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE drop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE replicate #-}
    {-# INLINE groupBy #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE splitWhen #-}

    indexEx :: Text -> Index Text -> Element Text
indexEx = Text -> Int64 -> Char
TL.index
    unsafeIndex :: Text -> Index Text -> Element Text
unsafeIndex = Text -> Int64 -> Char
TL.index
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance SemiSequence (Seq.Seq a) where
    type Index (Seq.Seq a) = Int
    cons :: Element (Seq a) -> Seq a -> Seq a
cons = forall a. a -> Seq a -> Seq a
(Seq.<|)
    snoc :: Seq a -> Element (Seq a) -> Seq a
snoc = forall a. Seq a -> a -> Seq a
(Seq.|>)
    reverse :: Seq a -> Seq a
reverse = forall a. Seq a -> Seq a
Seq.reverse
    sortBy :: (Element (Seq a) -> Element (Seq a) -> Ordering) -> Seq a -> Seq a
sortBy = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy

    intersperse :: Element (Seq a) -> Seq a -> Seq a
intersperse = forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
    find :: (Element (Seq a) -> Bool) -> Seq a -> Maybe (Element (Seq a))
find = forall seq.
MonoFoldable seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
defaultFind
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence (Seq.Seq a) where
    fromList :: [Element (Seq a)] -> Seq a
fromList = forall a. [a] -> Seq a
Seq.fromList
    lengthIndex :: Seq a -> Index (Seq a)
lengthIndex = forall a. Seq a -> Int
Seq.length
    replicate :: Index (Seq a) -> Element (Seq a) -> Seq a
replicate = forall a. Int -> a -> Seq a
Seq.replicate
    replicateM :: forall (m :: * -> *).
Monad m =>
Index (Seq a) -> m (Element (Seq a)) -> m (Seq a)
replicateM = forall (m :: * -> *) a. Applicative m => Int -> m a -> m (Seq a)
Seq.replicateM
    filter :: (Element (Seq a) -> Bool) -> Seq a -> Seq a
filter = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter
    --filterM = Seq.filterM
    break :: (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
break = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl
    span :: (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
span = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl
    dropWhile :: (Element (Seq a) -> Bool) -> Seq a -> Seq a
dropWhile = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL
    takeWhile :: (Element (Seq a) -> Bool) -> Seq a -> Seq a
takeWhile = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL
    splitAt :: Index (Seq a) -> Seq a -> (Seq a, Seq a)
splitAt = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt
    take :: Index (Seq a) -> Seq a -> Seq a
take = forall a. Int -> Seq a -> Seq a
Seq.take
    drop :: Index (Seq a) -> Seq a -> Seq a
drop = forall a. Int -> Seq a -> Seq a
Seq.drop
    partition :: (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
partition = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition
    uncons :: Seq a -> Maybe (Element (Seq a), Seq a)
uncons Seq a
s =
        case forall a. Seq a -> ViewL a
Seq.viewl Seq a
s of
            ViewL a
Seq.EmptyL -> forall a. Maybe a
Nothing
            a
x Seq.:< Seq a
xs -> forall a. a -> Maybe a
Just (a
x, Seq a
xs)
    unsnoc :: Seq a -> Maybe (Seq a, Element (Seq a))
unsnoc Seq a
s =
        case forall a. Seq a -> ViewR a
Seq.viewr Seq a
s of
            ViewR a
Seq.EmptyR -> forall a. Maybe a
Nothing
            Seq a
xs Seq.:> a
x -> forall a. a -> Maybe a
Just (Seq a
xs, a
x)
    --groupBy = Seq.groupBy
    tailEx :: Seq a -> Seq a
tailEx = forall a. Int -> Seq a -> Seq a
Seq.drop Int
1
    initEx :: Seq a -> Seq a
initEx Seq a
xs = forall a. Int -> Seq a -> Seq a
Seq.take (forall a. Seq a -> Int
Seq.length Seq a
xs forall a. Num a => a -> a -> a
- Int
1) Seq a
xs
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE drop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE replicate #-}
    {-# INLINE replicateM #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}

    index :: Seq a -> Index (Seq a) -> Maybe (Element (Seq a))
index = forall a. Seq a -> Int -> Maybe a
(Seq.!?)
    indexEx :: Seq a -> Index (Seq a) -> Element (Seq a)
indexEx = forall a. Seq a -> Int -> a
Seq.index
    unsafeIndex :: Seq a -> Index (Seq a) -> Element (Seq a)
unsafeIndex = forall a. Seq a -> Int -> a
Seq.index
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance SemiSequence (V.Vector a) where
    type Index (V.Vector a) = Int
    reverse :: Vector a -> Vector a
reverse = forall a. Vector a -> Vector a
V.reverse
    find :: (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
find = forall a. (a -> Bool) -> Vector a -> Maybe a
V.find
    cons :: Element (Vector a) -> Vector a -> Vector a
cons = forall a. a -> Vector a -> Vector a
V.cons
    snoc :: Vector a -> Element (Vector a) -> Vector a
snoc = forall a. Vector a -> a -> Vector a
V.snoc

    sortBy :: (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
sortBy = forall (v :: * -> *) e.
Vector v e =>
(e -> e -> Ordering) -> v e -> v e
vectorSortBy
    intersperse :: Element (Vector a) -> Vector a -> Vector a
intersperse = forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance IsSequence (V.Vector a) where
    fromList :: [Element (Vector a)] -> Vector a
fromList = forall a. [a] -> Vector a
V.fromList
    lengthIndex :: Vector a -> Index (Vector a)
lengthIndex = forall a. Vector a -> Int
V.length
    replicate :: Index (Vector a) -> Element (Vector a) -> Vector a
replicate = forall a. Int -> a -> Vector a
V.replicate
    replicateM :: forall (m :: * -> *).
Monad m =>
Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
replicateM = forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM
    filter :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
filter = forall a. (a -> Bool) -> Vector a -> Vector a
V.filter
    filterM :: forall (m :: * -> *).
Monad m =>
(Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
filterM = forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM
    break :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
break = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.break
    span :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
span = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.span
    dropWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
dropWhile = forall a. (a -> Bool) -> Vector a -> Vector a
V.dropWhile
    takeWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
takeWhile = forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile
    splitAt :: Index (Vector a) -> Vector a -> (Vector a, Vector a)
splitAt = forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt
    take :: Index (Vector a) -> Vector a -> Vector a
take = forall a. Int -> Vector a -> Vector a
V.take
    drop :: Index (Vector a) -> Vector a -> Vector a
drop = forall a. Int -> Vector a -> Vector a
V.drop
    unsafeTake :: Index (Vector a) -> Vector a -> Vector a
unsafeTake = forall a. Int -> Vector a -> Vector a
V.unsafeTake
    unsafeDrop :: Index (Vector a) -> Vector a -> Vector a
unsafeDrop = forall a. Int -> Vector a -> Vector a
V.unsafeDrop
    partition :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
partition = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.partition
    uncons :: Vector a -> Maybe (Element (Vector a), Vector a)
uncons Vector a
v
        | forall a. Vector a -> Bool
V.null Vector a
v = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Vector a -> a
V.head Vector a
v, forall a. Vector a -> Vector a
V.tail Vector a
v)
    unsnoc :: Vector a -> Maybe (Vector a, Element (Vector a))
unsnoc Vector a
v
        | forall a. Vector a -> Bool
V.null Vector a
v = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Vector a -> Vector a
V.init Vector a
v, forall a. Vector a -> a
V.last Vector a
v)
    --groupBy = V.groupBy
    tailEx :: Vector a -> Vector a
tailEx = forall a. Vector a -> Vector a
V.tail
    initEx :: Vector a -> Vector a
initEx = forall a. Vector a -> Vector a
V.init
    unsafeTail :: Vector a -> Vector a
unsafeTail = forall a. Vector a -> Vector a
V.unsafeTail
    unsafeInit :: Vector a -> Vector a
unsafeInit = forall a. Vector a -> Vector a
V.unsafeInit
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE unsafeTake #-}
    {-# INLINE drop #-}
    {-# INLINE unsafeDrop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE filterM #-}
    {-# INLINE replicate #-}
    {-# INLINE replicateM #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE unsafeTail #-}
    {-# INLINE unsafeInit #-}

    index :: Vector a -> Index (Vector a) -> Maybe (Element (Vector a))
index = forall a. Vector a -> Int -> Maybe a
(V.!?)
    indexEx :: Vector a -> Index (Vector a) -> Element (Vector a)
indexEx = forall a. Vector a -> Int -> a
(V.!)
    unsafeIndex :: Vector a -> Index (Vector a) -> Element (Vector a)
unsafeIndex = forall a. Vector a -> Int -> a
V.unsafeIndex
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance U.Unbox a => SemiSequence (U.Vector a) where
    type Index (U.Vector a) = Int

    intersperse :: Element (Vector a) -> Vector a -> Vector a
intersperse = forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
    reverse :: Vector a -> Vector a
reverse = forall a. Unbox a => Vector a -> Vector a
U.reverse
    find :: (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
find = forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe a
U.find
    cons :: Element (Vector a) -> Vector a -> Vector a
cons = forall a. Unbox a => a -> Vector a -> Vector a
U.cons
    snoc :: Vector a -> Element (Vector a) -> Vector a
snoc = forall a. Unbox a => Vector a -> a -> Vector a
U.snoc
    sortBy :: (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
sortBy = forall (v :: * -> *) e.
Vector v e =>
(e -> e -> Ordering) -> v e -> v e
vectorSortBy
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance U.Unbox a => IsSequence (U.Vector a) where
    fromList :: [Element (Vector a)] -> Vector a
fromList = forall a. Unbox a => [a] -> Vector a
U.fromList
    lengthIndex :: Vector a -> Index (Vector a)
lengthIndex = forall a. Unbox a => Vector a -> Int
U.length
    replicate :: Index (Vector a) -> Element (Vector a) -> Vector a
replicate = forall a. Unbox a => Int -> a -> Vector a
U.replicate
    replicateM :: forall (m :: * -> *).
Monad m =>
Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
replicateM = forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
U.replicateM
    filter :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
filter = forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.filter
    filterM :: forall (m :: * -> *).
Monad m =>
(Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
filterM = forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(a -> m Bool) -> Vector a -> m (Vector a)
U.filterM
    break :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
break = forall a.
Unbox a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
U.break
    span :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
span = forall a.
Unbox a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
U.span
    dropWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
dropWhile = forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.dropWhile
    takeWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
takeWhile = forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.takeWhile
    splitAt :: Index (Vector a) -> Vector a -> (Vector a, Vector a)
splitAt = forall a. Unbox a => Int -> Vector a -> (Vector a, Vector a)
U.splitAt
    take :: Index (Vector a) -> Vector a -> Vector a
take = forall a. Unbox a => Int -> Vector a -> Vector a
U.take
    drop :: Index (Vector a) -> Vector a -> Vector a
drop = forall a. Unbox a => Int -> Vector a -> Vector a
U.drop
    unsafeTake :: Index (Vector a) -> Vector a -> Vector a
unsafeTake = forall a. Unbox a => Int -> Vector a -> Vector a
U.unsafeTake
    unsafeDrop :: Index (Vector a) -> Vector a -> Vector a
unsafeDrop = forall a. Unbox a => Int -> Vector a -> Vector a
U.unsafeDrop
    partition :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
partition = forall a.
Unbox a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
U.partition
    uncons :: Vector a -> Maybe (Element (Vector a), Vector a)
uncons Vector a
v
        | forall a. Unbox a => Vector a -> Bool
U.null Vector a
v = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Unbox a => Vector a -> a
U.head Vector a
v, forall a. Unbox a => Vector a -> Vector a
U.tail Vector a
v)
    unsnoc :: Vector a -> Maybe (Vector a, Element (Vector a))
unsnoc Vector a
v
        | forall a. Unbox a => Vector a -> Bool
U.null Vector a
v = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Unbox a => Vector a -> Vector a
U.init Vector a
v, forall a. Unbox a => Vector a -> a
U.last Vector a
v)
    --groupBy = U.groupBy
    tailEx :: Vector a -> Vector a
tailEx = forall a. Unbox a => Vector a -> Vector a
U.tail
    initEx :: Vector a -> Vector a
initEx = forall a. Unbox a => Vector a -> Vector a
U.init
    unsafeTail :: Vector a -> Vector a
unsafeTail = forall a. Unbox a => Vector a -> Vector a
U.unsafeTail
    unsafeInit :: Vector a -> Vector a
unsafeInit = forall a. Unbox a => Vector a -> Vector a
U.unsafeInit
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE unsafeTake #-}
    {-# INLINE drop #-}
    {-# INLINE unsafeDrop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE filterM #-}
    {-# INLINE replicate #-}
    {-# INLINE replicateM #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE unsafeTail #-}
    {-# INLINE unsafeInit #-}

    index :: Vector a -> Index (Vector a) -> Maybe (Element (Vector a))
index = forall a. Unbox a => Vector a -> Int -> Maybe a
(U.!?)
    indexEx :: Vector a -> Index (Vector a) -> Element (Vector a)
indexEx = forall a. Unbox a => Vector a -> Int -> a
(U.!)
    unsafeIndex :: Vector a -> Index (Vector a) -> Element (Vector a)
unsafeIndex = forall a. Unbox a => Vector a -> Int -> a
U.unsafeIndex
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

instance VS.Storable a => SemiSequence (VS.Vector a) where
    type Index (VS.Vector a) = Int
    reverse :: Vector a -> Vector a
reverse = forall a. Storable a => Vector a -> Vector a
VS.reverse
    find :: (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
find = forall a. Storable a => (a -> Bool) -> Vector a -> Maybe a
VS.find
    cons :: Element (Vector a) -> Vector a -> Vector a
cons = forall a. Storable a => a -> Vector a -> Vector a
VS.cons
    snoc :: Vector a -> Element (Vector a) -> Vector a
snoc = forall a. Storable a => Vector a -> a -> Vector a
VS.snoc

    intersperse :: Element (Vector a) -> Vector a -> Vector a
intersperse = forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
    sortBy :: (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
sortBy = forall (v :: * -> *) e.
Vector v e =>
(e -> e -> Ordering) -> v e -> v e
vectorSortBy
    {-# INLINE intersperse #-}
    {-# INLINE reverse #-}
    {-# INLINE find #-}
    {-# INLINE sortBy #-}
    {-# INLINE cons #-}
    {-# INLINE snoc #-}

instance VS.Storable a => IsSequence (VS.Vector a) where
    fromList :: [Element (Vector a)] -> Vector a
fromList = forall a. Storable a => [a] -> Vector a
VS.fromList
    lengthIndex :: Vector a -> Index (Vector a)
lengthIndex = forall a. Storable a => Vector a -> Int
VS.length
    replicate :: Index (Vector a) -> Element (Vector a) -> Vector a
replicate = forall a. Storable a => Int -> a -> Vector a
VS.replicate
    replicateM :: forall (m :: * -> *).
Monad m =>
Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
replicateM = forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
VS.replicateM
    filter :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
filter = forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.filter
    filterM :: forall (m :: * -> *).
Monad m =>
(Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
filterM = forall (m :: * -> *) a.
(Monad m, Storable a) =>
(a -> m Bool) -> Vector a -> m (Vector a)
VS.filterM
    break :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
break = forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
VS.break
    span :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
span = forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
VS.span
    dropWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
dropWhile = forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.dropWhile
    takeWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
takeWhile = forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.takeWhile
    splitAt :: Index (Vector a) -> Vector a -> (Vector a, Vector a)
splitAt = forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
VS.splitAt
    take :: Index (Vector a) -> Vector a -> Vector a
take = forall a. Storable a => Int -> Vector a -> Vector a
VS.take
    drop :: Index (Vector a) -> Vector a -> Vector a
drop = forall a. Storable a => Int -> Vector a -> Vector a
VS.drop
    unsafeTake :: Index (Vector a) -> Vector a -> Vector a
unsafeTake = forall a. Storable a => Int -> Vector a -> Vector a
VS.unsafeTake
    unsafeDrop :: Index (Vector a) -> Vector a -> Vector a
unsafeDrop = forall a. Storable a => Int -> Vector a -> Vector a
VS.unsafeDrop
    partition :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
partition = forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
VS.partition
    uncons :: Vector a -> Maybe (Element (Vector a), Vector a)
uncons Vector a
v
        | forall a. Storable a => Vector a -> Bool
VS.null Vector a
v = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Storable a => Vector a -> a
VS.head Vector a
v, forall a. Storable a => Vector a -> Vector a
VS.tail Vector a
v)
    unsnoc :: Vector a -> Maybe (Vector a, Element (Vector a))
unsnoc Vector a
v
        | forall a. Storable a => Vector a -> Bool
VS.null Vector a
v = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Storable a => Vector a -> Vector a
VS.init Vector a
v, forall a. Storable a => Vector a -> a
VS.last Vector a
v)
    --groupBy = U.groupBy
    tailEx :: Vector a -> Vector a
tailEx = forall a. Storable a => Vector a -> Vector a
VS.tail
    initEx :: Vector a -> Vector a
initEx = forall a. Storable a => Vector a -> Vector a
VS.init
    unsafeTail :: Vector a -> Vector a
unsafeTail = forall a. Storable a => Vector a -> Vector a
VS.unsafeTail
    unsafeInit :: Vector a -> Vector a
unsafeInit = forall a. Storable a => Vector a -> Vector a
VS.unsafeInit
    {-# INLINE fromList #-}
    {-# INLINE break #-}
    {-# INLINE span #-}
    {-# INLINE dropWhile #-}
    {-# INLINE takeWhile #-}
    {-# INLINE splitAt #-}
    {-# INLINE take #-}
    {-# INLINE unsafeTake #-}
    {-# INLINE drop #-}
    {-# INLINE unsafeDrop #-}
    {-# INLINE partition #-}
    {-# INLINE uncons #-}
    {-# INLINE unsnoc #-}
    {-# INLINE filter #-}
    {-# INLINE filterM #-}
    {-# INLINE replicate #-}
    {-# INLINE replicateM #-}
    {-# INLINE tailEx #-}
    {-# INLINE initEx #-}
    {-# INLINE unsafeTail #-}
    {-# INLINE unsafeInit #-}

    index :: Vector a -> Index (Vector a) -> Maybe (Element (Vector a))
index = forall a. Storable a => Vector a -> Int -> Maybe a
(VS.!?)
    indexEx :: Vector a -> Index (Vector a) -> Element (Vector a)
indexEx = forall a. Storable a => Vector a -> Int -> a
(VS.!)
    unsafeIndex :: Vector a -> Index (Vector a) -> Element (Vector a)
unsafeIndex = forall a. Storable a => Vector a -> Int -> a
VS.unsafeIndex
    {-# INLINE index #-}
    {-# INLINE indexEx #-}
    {-# INLINE unsafeIndex #-}

-- | @'splitElem'@ splits a sequence into components delimited by separator
-- element. It's equivalent to 'splitWhen' with equality predicate:
--
-- > splitElem sep === splitWhen (== sep)
--
-- Since 0.9.3
splitElem :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> [seq]
splitElem :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
Element seq -> seq -> [seq]
splitElem Element seq
x = forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> [seq]
splitWhen (forall a. Eq a => a -> a -> Bool
== Element seq
x)

-- | @'splitSeq'@ splits a sequence into components delimited by
-- separator subsequence. 'splitSeq' is the right inverse of 'intercalate':
--
-- > ointercalate x . splitSeq x === id
--
-- 'splitElem' can be considered a special case of 'splitSeq'
--
-- > splitSeq (singleton sep) === splitElem sep
--
-- @'splitSeq' mempty@ is another special case: it splits just before each
-- element, and in line with 'splitWhen' rules, it has at least one output
-- component:
--
-- @
-- > 'splitSeq' "" ""
-- [""]
-- > 'splitSeq' "" "a"
-- ["", "a"]
-- > 'splitSeq' "" "ab"
-- ["", "a", "b"]
-- @
--
-- Since 0.9.3
splitSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> [seq]
splitSeq :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> [seq]
splitSeq seq
sep = forall a b. (a -> b) -> [a] -> [b]
List.map forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn (forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
sep) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

-- | @'replaceSeq' old new@ replaces all @old@ subsequences with @new@.
--
-- > replaceSeq old new === ointercalate new . splitSeq old
--
-- @since 1.0.1

replaceSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq -> seq
replaceSeq :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> seq -> seq
replaceSeq seq
old seq
new = forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
ointercalate seq
new forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> [seq]
splitSeq seq
old

-- | 'stripPrefix' drops the given prefix from a sequence.
-- It returns 'Nothing' if the sequence did not start with the prefix
-- given, or 'Just' the sequence after the prefix, if it does.
--
-- @
-- > 'stripPrefix' "foo" "foobar"
-- 'Just' "bar"
-- > 'stripPrefix' "abc" "foobar"
-- 'Nothing'
-- @
stripPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq
stripPrefix :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripPrefix seq
x seq
y = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall seq. IsSequence seq => [Element seq] -> seq
fromList (forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x forall a. Eq a => [a] -> [a] -> Maybe [a]
`List.stripPrefix` forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y)

-- | 'stripSuffix' drops the given suffix from a sequence.
-- It returns 'Nothing' if the sequence did not end with the suffix
-- given, or 'Just' the sequence before the suffix, if it does.
--
-- @
-- > 'stripSuffix' "bar" "foobar"
-- 'Just' "foo"
-- > 'stripSuffix' "abc" "foobar"
-- 'Nothing'
-- @
stripSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq
stripSuffix :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripSuffix seq
x seq
y =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall seq. IsSequence seq => [Element seq] -> seq
fromList (forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripSuffixList` forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y)
  where
    stripSuffixList :: Eq a => [a] -> [a] -> Maybe [a]
    stripSuffixList :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffixList [a]
x' [a]
y' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall seq. SemiSequence seq => seq -> seq
reverse (forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripPrefix (forall seq. SemiSequence seq => seq -> seq
reverse [a]
x') (forall seq. SemiSequence seq => seq -> seq
reverse [a]
y'))

-- | 'dropPrefix' drops the given prefix from a sequence.  It returns the
-- original sequence if the sequence doesn't start with the given prefix.
--
-- @
-- > 'dropPrefix' \"foo\" \"foobar\"
-- \"bar\"
-- > 'dropPrefix' \"abc\" \"foobar\"
-- \"foobar\"
-- @
--
-- @since 1.0.7.0
dropPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq
dropPrefix :: forall seq. (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq
dropPrefix seq
x seq
y = forall a. a -> Maybe a -> a
fromMaybe seq
y (forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripPrefix seq
x seq
y)

-- | 'dropSuffix' drops the given suffix from a sequence.  It returns the
-- original sequence if the sequence doesn't end with the given suffix.
--
-- @
-- > 'dropSuffix' \"bar\" \"foobar\"
-- \"foo\"
-- > 'dropSuffix' \"abc\" \"foobar\"
-- \"foobar\"
-- @
--
-- @since 1.0.7.0
dropSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq
dropSuffix :: forall seq. (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq
dropSuffix seq
x seq
y = forall a. a -> Maybe a -> a
fromMaybe seq
y (forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripSuffix seq
x seq
y)

-- | 'ensurePrefix' will add a prefix to a sequence if it doesn't
-- exist, and otherwise have no effect.
--
-- @
-- > 'ensurePrefix' "foo" "foobar"
-- "foobar"
-- > 'ensurePrefix' "abc" "foobar"
-- "abcfoobar"
-- @
--
-- @since 1.0.3
ensurePrefix :: (Eq (Element seq), IsSequence seq) => seq -> seq -> seq
ensurePrefix :: forall seq. (Eq (Element seq), IsSequence seq) => seq -> seq -> seq
ensurePrefix seq
prefix seq
seq = if forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isPrefixOf seq
prefix seq
seq then seq
seq else seq
prefix forall a. Semigroup a => a -> a -> a
<> seq
seq

-- | Append a suffix to a sequence, unless it already has that suffix.
--
-- @
-- > 'ensureSuffix' "bar" "foobar"
-- "foobar"
-- > 'ensureSuffix' "abc" "foobar"
-- "foobarabc"
-- @
--
-- @since 1.0.3
ensureSuffix :: (Eq (Element seq), IsSequence seq) => seq -> seq -> seq
ensureSuffix :: forall seq. (Eq (Element seq), IsSequence seq) => seq -> seq -> seq
ensureSuffix seq
suffix seq
seq = if forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isSuffixOf seq
suffix seq
seq then seq
seq else seq
seq forall a. Semigroup a => a -> a -> a
<> seq
suffix

-- | 'isPrefixOf' takes two sequences and returns 'True' if the first
-- sequence is a prefix of the second.
isPrefixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool
isPrefixOf :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isPrefixOf seq
x seq
y = forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y

-- | 'isSuffixOf' takes two sequences and returns 'True' if the first
-- sequence is a suffix of the second.
isSuffixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool
isSuffixOf :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isSuffixOf seq
x seq
y = forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y

-- | 'isInfixOf' takes two sequences and returns 'true' if the first
-- sequence is contained, wholly and intact, anywhere within the second.
isInfixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool
isInfixOf :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isInfixOf seq
x seq
y = forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y

-- | Equivalent to @'groupBy' (==)@
group :: (IsSequence seq, Eq (Element seq)) => seq -> [seq]
group :: forall seq. (IsSequence seq, Eq (Element seq)) => seq -> [seq]
group = forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Bool) -> seq -> [seq]
groupBy forall a. Eq a => a -> a -> Bool
(==)

-- | Similar to standard 'group', but operates on the whole collection,
-- not just the consecutive items.
--
-- Equivalent to @'groupAllOn' id@
groupAll :: (IsSequence seq, Eq (Element seq)) => seq -> [seq]
groupAll :: forall seq. (IsSequence seq, Eq (Element seq)) => seq -> [seq]
groupAll = forall seq b.
(IsSequence seq, Eq b) =>
(Element seq -> b) -> seq -> [seq]
groupAllOn forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- |
--
-- @since 0.10.2
delete :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> seq
delete :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
Element seq -> seq -> seq
delete = forall seq.
(IsSequence seq, Eq (Element seq)) =>
(Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
deleteBy forall a. Eq a => a -> a -> Bool
(==)

-- |
--
-- @since 0.10.2
deleteBy :: (IsSequence seq, Eq (Element seq)) => (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
deleteBy :: forall seq.
(IsSequence seq, Eq (Element seq)) =>
(Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
deleteBy Element seq -> Element seq -> Bool
eq Element seq
x = forall seq. IsSequence seq => [Element seq] -> seq
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy Element seq -> Element seq -> Bool
eq Element seq
x forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

{-# INLINE [0] splitElem #-}
{-# INLINE [0] splitSeq #-}
{-# INLINE [0] replaceSeq #-}
{-# INLINE [0] isPrefixOf #-}
{-# INLINE [0] isSuffixOf #-}
{-# INLINE [0] isInfixOf #-}
{-# INLINE [0] stripPrefix #-}
{-# INLINE [0] stripSuffix #-}
{-# INLINE [0] group #-}
{-# INLINE [0] groupAll #-}
{-# INLINE [0] delete #-}
{-# INLINE [0] deleteBy #-}

{-# RULES "list splitSeq" splitSeq = List.splitOn #-}
{-# RULES "list stripPrefix" stripPrefix = List.stripPrefix #-}
{-# RULES "list isPrefixOf" isPrefixOf = List.isPrefixOf #-}
{-# RULES "list isSuffixOf" isSuffixOf = List.isSuffixOf #-}
{-# RULES "list isInfixOf" isInfixOf = List.isInfixOf #-}
{-# RULES "list delete" delete = List.delete #-}
{-# RULES "list deleteBy" deleteBy = List.deleteBy #-}

{-# RULES "strict ByteString splitElem" splitElem = splitElemStrictBS #-}
{-# RULES "strict ByteString stripPrefix" stripPrefix = stripPrefixStrictBS #-}
{-# RULES "strict ByteString stripSuffix" stripSuffix = stripSuffixStrictBS #-}
{-# RULES "strict ByteString group" group = S.group #-}
{-# RULES "strict ByteString isPrefixOf" isPrefixOf = S.isPrefixOf #-}
{-# RULES "strict ByteString isSuffixOf" isSuffixOf = S.isSuffixOf #-}
{-# RULES "strict ByteString isInfixOf" isInfixOf = S.isInfixOf #-}

splitElemStrictBS :: Word8 -> S.ByteString -> [S.ByteString]
splitElemStrictBS :: Word8 -> ByteString -> [ByteString]
splitElemStrictBS Word8
sep ByteString
s
  | ByteString -> Bool
S.null ByteString
s = [ByteString
S.empty]
  | Bool
otherwise = Word8 -> ByteString -> [ByteString]
S.split Word8
sep ByteString
s

stripPrefixStrictBS :: S.ByteString -> S.ByteString -> Maybe S.ByteString
stripPrefixStrictBS :: ByteString -> ByteString -> Maybe ByteString
stripPrefixStrictBS ByteString
x ByteString
y
    | ByteString
x ByteString -> ByteString -> Bool
`S.isPrefixOf` ByteString
y = forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
x) ByteString
y)
    | Bool
otherwise = forall a. Maybe a
Nothing

stripSuffixStrictBS :: S.ByteString -> S.ByteString -> Maybe S.ByteString
stripSuffixStrictBS :: ByteString -> ByteString -> Maybe ByteString
stripSuffixStrictBS ByteString
x ByteString
y
    | ByteString
x ByteString -> ByteString -> Bool
`S.isSuffixOf` ByteString
y = forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
y forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
x) ByteString
y)
    | Bool
otherwise = forall a. Maybe a
Nothing

{-# RULES "lazy ByteString splitElem" splitElem = splitSeqLazyBS #-}
{-# RULES "lazy ByteString stripPrefix" stripPrefix = stripPrefixLazyBS #-}
{-# RULES "lazy ByteString stripSuffix" stripSuffix = stripSuffixLazyBS #-}
{-# RULES "lazy ByteString group" group = L.group #-}
{-# RULES "lazy ByteString isPrefixOf" isPrefixOf = L.isPrefixOf #-}
{-# RULES "lazy ByteString isSuffixOf" isSuffixOf = L.isSuffixOf #-}

splitSeqLazyBS :: Word8 -> L.ByteString -> [L.ByteString]
splitSeqLazyBS :: Word8 -> ByteString -> [ByteString]
splitSeqLazyBS Word8
sep ByteString
s
  | ByteString -> Bool
L.null ByteString
s = [ByteString
L.empty]
  | Bool
otherwise = Word8 -> ByteString -> [ByteString]
L.split Word8
sep ByteString
s

stripPrefixLazyBS :: L.ByteString -> L.ByteString -> Maybe L.ByteString
stripPrefixLazyBS :: ByteString -> ByteString -> Maybe ByteString
stripPrefixLazyBS ByteString
x ByteString
y
    | ByteString
x ByteString -> ByteString -> Bool
`L.isPrefixOf` ByteString
y = forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
L.drop (ByteString -> Int64
L.length ByteString
x) ByteString
y)
    | Bool
otherwise = forall a. Maybe a
Nothing

stripSuffixLazyBS :: L.ByteString -> L.ByteString -> Maybe L.ByteString
stripSuffixLazyBS :: ByteString -> ByteString -> Maybe ByteString
stripSuffixLazyBS ByteString
x ByteString
y
    | ByteString
x ByteString -> ByteString -> Bool
`L.isSuffixOf` ByteString
y = forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
L.take (ByteString -> Int64
L.length ByteString
y forall a. Num a => a -> a -> a
- ByteString -> Int64
L.length ByteString
x) ByteString
y)
    | Bool
otherwise = forall a. Maybe a
Nothing

{-# RULES "strict Text splitSeq" splitSeq = splitSeqStrictText #-}
{-# RULES "strict Text replaceSeq" replaceSeq = replaceSeqStrictText #-}
{-# RULES "strict Text stripPrefix" stripPrefix = T.stripPrefix #-}
{-# RULES "strict Text stripSuffix" stripSuffix = T.stripSuffix #-}
{-# RULES "strict Text group" group = T.group #-}
{-# RULES "strict Text isPrefixOf" isPrefixOf = T.isPrefixOf #-}
{-# RULES "strict Text isSuffixOf" isSuffixOf = T.isSuffixOf #-}
{-# RULES "strict Text isInfixOf" isInfixOf = T.isInfixOf #-}

splitSeqStrictText :: T.Text -> T.Text -> [T.Text]
splitSeqStrictText :: Text -> Text -> [Text]
splitSeqStrictText Text
sep
    | Text -> Bool
T.null Text
sep = (:) Text
T.empty forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall seq. MonoPointed seq => Element seq -> seq
singleton forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Char]
T.unpack
    | Bool
otherwise = Text -> Text -> [Text]
T.splitOn Text
sep

replaceSeqStrictText :: T.Text -> T.Text -> T.Text -> T.Text
replaceSeqStrictText :: Text -> Text -> Text -> Text
replaceSeqStrictText Text
old Text
new
    | Text -> Bool
T.null Text
old = Text -> [Text] -> Text
T.intercalate Text
new forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> [Text]
splitSeqStrictText Text
old
    | Bool
otherwise = Text -> Text -> Text -> Text
T.replace Text
old Text
new

{-# RULES "lazy Text splitSeq" splitSeq = splitSeqLazyText #-}
{-# RULES "lazy Text replaceSeq" replaceSeq = replaceSeqLazyText #-}
{-# RULES "lazy Text stripPrefix" stripPrefix = TL.stripPrefix #-}
{-# RULES "lazy Text stripSuffix" stripSuffix = TL.stripSuffix #-}
{-# RULES "lazy Text group" group = TL.group #-}
{-# RULES "lazy Text isPrefixOf" isPrefixOf = TL.isPrefixOf #-}
{-# RULES "lazy Text isSuffixOf" isSuffixOf = TL.isSuffixOf #-}
{-# RULES "lazy Text isInfixOf" isInfixOf = TL.isInfixOf #-}

splitSeqLazyText :: TL.Text -> TL.Text -> [TL.Text]
splitSeqLazyText :: Text -> Text -> [Text]
splitSeqLazyText Text
sep
    | Text -> Bool
TL.null Text
sep = (:) Text
TL.empty forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall seq. MonoPointed seq => Element seq -> seq
singleton forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Char]
TL.unpack
    | Bool
otherwise = Text -> Text -> [Text]
TL.splitOn Text
sep

replaceSeqLazyText :: TL.Text -> TL.Text -> TL.Text -> TL.Text
replaceSeqLazyText :: Text -> Text -> Text -> Text
replaceSeqLazyText Text
old Text
new
    | Text -> Bool
TL.null Text
old = Text -> [Text] -> Text
TL.intercalate Text
new forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> [Text]
splitSeqLazyText Text
old
    | Bool
otherwise = Text -> Text -> Text -> Text
TL.replace Text
old Text
new

-- | Sort a ordered sequence.
--
-- @
-- > 'sort' [4,3,1,2]
-- [1,2,3,4]
-- @
sort :: (SemiSequence seq, Ord (Element seq)) => seq -> seq
sort :: forall seq. (SemiSequence seq, Ord (Element seq)) => seq -> seq
sort = forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE [0] sort #-}

{-# RULES "strict ByteString sort" sort = S.sort #-}
{-# RULES "boxed Vector sort" forall (v :: V.Vector a). sort v = vectorSort v #-}
{-# RULES "unboxed Vector sort" forall (v :: U.Unbox a => U.Vector a). sort v = vectorSort v #-}
{-# RULES "storable Vector sort" forall (v :: VS.Storable a => VS.Vector a). sort v = vectorSort v #-}

-- | A typeclass for sequences whose elements are 'Char's.
class (IsSequence t, IsString t, Element t ~ Char) => Textual t where
    -- | Break up a textual sequence into a list of words, which were delimited
    -- by white space.
    --
    -- @
    -- > 'words' "abc  def ghi"
    -- ["abc","def","ghi"]
    -- @
    words :: t -> [t]

    -- | Join a list of textual sequences using seperating spaces.
    --
    -- @
    -- > 'unwords' ["abc","def","ghi"]
    -- "abc def ghi"
    -- @
    unwords :: (Element seq ~ t, MonoFoldable seq) => seq -> t

    -- | Break up a textual sequence at newline characters.
    --
    --
    -- @
    -- > 'lines' "hello\\nworld"
    -- ["hello","world"]
    -- @
    lines :: t -> [t]

    -- | Join a list of textual sequences using newlines.
    --
    -- @
    -- > 'unlines' ["abc","def","ghi"]
    -- "abc\\ndef\\nghi"
    -- @
    unlines :: (Element seq ~ t, MonoFoldable seq) => seq -> t

    -- | Convert a textual sequence to lower-case.
    --
    -- @
    -- > 'toLower' "HELLO WORLD"
    -- "hello world"
    -- @
    toLower :: t -> t

    -- | Convert a textual sequence to upper-case.
    --
    -- @
    -- > 'toUpper' "hello world"
    -- "HELLO WORLD"
    -- @
    toUpper :: t -> t

    -- | Convert a textual sequence to folded-case.
    --
    -- Slightly different from 'toLower', see @"Data.Text".'Data.Text.toCaseFold'@
    toCaseFold :: t -> t

    -- | Split a textual sequence into two parts, split at the first space.
    --
    -- @
    -- > 'breakWord' "hello world"
    -- ("hello","world")
    -- @
    breakWord :: t -> (t, t)
    breakWord = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
dropWhile Char -> Bool
isSpace) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
break Char -> Bool
isSpace
    {-# INLINE breakWord #-}

    -- | Split a textual sequence into two parts, split at the newline.
    --
    -- @
    -- > 'breakLine' "abc\\ndef"
    -- ("abc","def")
    -- @
    breakLine :: t -> (t, t)
    breakLine =
        (forall {seq}. (Element seq ~ Char, IsSequence seq) => seq -> seq
killCR forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall seq. IsSequence seq => Index seq -> seq -> seq
drop Index t
1) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
break (forall a. Eq a => a -> a -> Bool
== Char
'\n')
      where
        killCR :: seq -> seq
killCR seq
t =
            case forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc seq
t of
                Just (seq
t', Char
Element seq
'\r') -> seq
t'
                Maybe (seq, Element seq)
_ -> seq
t

instance (c ~ Char) => Textual [c] where
    words :: [c] -> [[c]]
words = [Char] -> [[Char]]
List.words
    unwords :: forall seq. (Element seq ~ [c], MonoFoldable seq) => seq -> [c]
unwords = [[Char]] -> [Char]
List.unwords forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    lines :: [c] -> [[c]]
lines = [Char] -> [[Char]]
List.lines
    unlines :: forall seq. (Element seq ~ [c], MonoFoldable seq) => seq -> [c]
unlines = [[Char]] -> [Char]
List.unlines forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    toLower :: [c] -> [c]
toLower = Text -> [Char]
TL.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
TL.toLower forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> Text
TL.pack
    toUpper :: [c] -> [c]
toUpper = Text -> [Char]
TL.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
TL.toUpper forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> Text
TL.pack
    toCaseFold :: [c] -> [c]
toCaseFold = Text -> [Char]
TL.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
TL.toCaseFold forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> Text
TL.pack
    {-# INLINE words #-}
    {-# INLINE unwords #-}
    {-# INLINE lines #-}
    {-# INLINE unlines #-}
    {-# INLINE toLower #-}
    {-# INLINE toUpper #-}
    {-# INLINE toCaseFold #-}

instance Textual T.Text where
    words :: Text -> [Text]
words = Text -> [Text]
T.words
    unwords :: forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
unwords = [Text] -> Text
T.unwords forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    lines :: Text -> [Text]
lines = Text -> [Text]
T.lines
    unlines :: forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
unlines = [Text] -> Text
T.unlines forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    toLower :: Text -> Text
toLower = Text -> Text
T.toLower
    toUpper :: Text -> Text
toUpper = Text -> Text
T.toUpper
    toCaseFold :: Text -> Text
toCaseFold = Text -> Text
T.toCaseFold
    {-# INLINE words #-}
    {-# INLINE unwords #-}
    {-# INLINE lines #-}
    {-# INLINE unlines #-}
    {-# INLINE toLower #-}
    {-# INLINE toUpper #-}
    {-# INLINE toCaseFold #-}

instance Textual TL.Text where
    words :: Text -> [Text]
words = Text -> [Text]
TL.words
    unwords :: forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
unwords = [Text] -> Text
TL.unwords forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    lines :: Text -> [Text]
lines = Text -> [Text]
TL.lines
    unlines :: forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
unlines = [Text] -> Text
TL.unlines forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    toLower :: Text -> Text
toLower = Text -> Text
TL.toLower
    toUpper :: Text -> Text
toUpper = Text -> Text
TL.toUpper
    toCaseFold :: Text -> Text
toCaseFold = Text -> Text
TL.toCaseFold
    {-# INLINE words #-}
    {-# INLINE unwords #-}
    {-# INLINE lines #-}
    {-# INLINE unlines #-}
    {-# INLINE toLower #-}
    {-# INLINE toUpper #-}
    {-# INLINE toCaseFold #-}

-- | Takes all of the `Just` values from a sequence of @Maybe t@s and
-- concatenates them into an unboxed sequence of @t@s.
--
-- Since 0.6.2
catMaybes :: (IsSequence (f (Maybe t)), Functor f,
              Element (f (Maybe t)) ~ Maybe t)
          => f (Maybe t) -> f t
catMaybes :: forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
 Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter forall a. Maybe a -> Bool
isJust

-- | Same as @sortBy . comparing@.
--
-- Since 0.7.0
sortOn :: (Ord o, SemiSequence seq) => (Element seq -> o) -> seq -> seq
sortOn :: forall o seq.
(Ord o, SemiSequence seq) =>
(Element seq -> o) -> seq -> seq
sortOn = forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing
{-# INLINE sortOn #-}

-- | Lazy sequences containing strict chunks of data.
--
-- @since 1.0.0
class (IsSequence lazy, IsSequence strict) => LazySequence lazy strict | lazy -> strict, strict -> lazy where
    toChunks :: lazy -> [strict]
    fromChunks :: [strict] -> lazy
    toStrict :: lazy -> strict
    fromStrict :: strict -> lazy

instance LazySequence L.ByteString S.ByteString where
    toChunks :: ByteString -> [ByteString]
toChunks = ByteString -> [ByteString]
L.toChunks
    fromChunks :: [ByteString] -> ByteString
fromChunks = [ByteString] -> ByteString
L.fromChunks
    toStrict :: ByteString -> ByteString
toStrict = [ByteString] -> ByteString
S.concat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> [ByteString]
L.toChunks
    fromStrict :: ByteString -> ByteString
fromStrict = [ByteString] -> ByteString
L.fromChunks forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return

instance LazySequence TL.Text T.Text where
    toChunks :: Text -> [Text]
toChunks = Text -> [Text]
TL.toChunks
    fromChunks :: [Text] -> Text
fromChunks = [Text] -> Text
TL.fromChunks
    toStrict :: Text -> Text
toStrict = Text -> Text
TL.toStrict
    fromStrict :: Text -> Text
fromStrict = Text -> Text
TL.fromStrict

-- | Synonym for 'fromList'
--
-- @since 1.0.0
pack :: IsSequence seq => [Element seq] -> seq
pack :: forall seq. IsSequence seq => [Element seq] -> seq
pack = forall seq. IsSequence seq => [Element seq] -> seq
fromList
{-# INLINE pack #-}

-- | Synonym for 'otoList'
--
-- @since 1.0.0
unpack :: MonoFoldable mono => mono -> [Element mono]
unpack :: forall mono. MonoFoldable mono => mono -> [Element mono]
unpack = forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE unpack #-}

-- | Repack from one type to another, dropping to a list in the middle.
--
-- @repack = pack . unpack@.
--
-- @since 1.0.0
repack :: (MonoFoldable a, IsSequence b, Element a ~ Element b) => a -> b
repack :: forall a b.
(MonoFoldable a, IsSequence b, Element a ~ Element b) =>
a -> b
repack = forall seq. IsSequence seq => [Element seq] -> seq
pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
unpack

-- | Textual data which can be encoded to and decoded from UTF8.
--
-- @since 1.0.0
class (Textual textual, IsSequence binary) => Utf8 textual binary | textual -> binary, binary -> textual where
    -- | Encode from textual to binary using UTF-8 encoding
    --
    -- @since 1.0.0
    encodeUtf8 :: textual -> binary
    -- | Note that this function is required to be pure. In the case of
    -- a decoding error, Unicode replacement characters must be used.
    --
    -- @since 1.0.0
    decodeUtf8 :: binary -> textual
instance (c ~ Char, w ~ Word8) => Utf8 [c] [w] where
    encodeUtf8 :: [c] -> [w]
encodeUtf8 = ByteString -> [Word8]
L.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
TL.encodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> Text
TL.pack
    decodeUtf8 :: [w] -> [c]
decodeUtf8 = Text -> [Char]
TL.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OnDecodeError -> ByteString -> Text
TL.decodeUtf8With OnDecodeError
lenientDecode forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
L.pack
instance Utf8 T.Text S.ByteString where
    encodeUtf8 :: Text -> ByteString
encodeUtf8 = Text -> ByteString
T.encodeUtf8
    decodeUtf8 :: ByteString -> Text
decodeUtf8 = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
lenientDecode
instance Utf8 TL.Text L.ByteString where
    encodeUtf8 :: Text -> ByteString
encodeUtf8 = Text -> ByteString
TL.encodeUtf8
    decodeUtf8 :: ByteString -> Text
decodeUtf8 = OnDecodeError -> ByteString -> Text
TL.decodeUtf8With OnDecodeError
lenientDecode