-- |
-- Module      : Foundation.Collection.Sequential
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- Different collections (list, vector, string, ..) unified under 1 API.
-- an API to rules them all, and in the darkness bind them.
--
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
module Foundation.Collection.Sequential
    ( Sequential(..)
    ) where

import           Basement.Compat.Base
import           Basement.Numerical.Subtractive
import           Basement.Types.OffsetSize
import           Basement.Types.AsciiString (AsciiString(..))
import           Foundation.Collection.Element
import           Foundation.Collection.Collection
import qualified Foundation.Collection.List as ListExtra
import qualified Data.List
import qualified Basement.UArray as UV
import qualified Basement.Block as BLK
import qualified Basement.BoxedArray as BA
import qualified Basement.String as S

-- | A set of methods for ordered colection
class (IsList c, Item c ~ Element c, Monoid c, Collection c) => Sequential c where
    {-# MINIMAL ((take, drop) | splitAt)
              , ((revTake, revDrop) | revSplitAt)
              , splitOn
              , (break | span)
              , (breakEnd | spanEnd)
              , intersperse
              , filter, reverse
              , uncons, unsnoc, snoc, cons
              , find, sortBy, singleton
              , replicate
              #-}

    -- | Take the first @n elements of a collection
    take :: CountOf (Element c) -> c -> c
    take CountOf (Element c)
n = (c, c) -> c
forall a b. (a, b) -> a
fst ((c, c) -> c) -> (c -> (c, c)) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CountOf (Element c) -> c -> (c, c)
forall c. Sequential c => CountOf (Element c) -> c -> (c, c)
splitAt CountOf (Element c)
n

    -- | Take the last @n elements of a collection
    revTake :: CountOf (Element c) -> c -> c
    revTake CountOf (Element c)
n = (c, c) -> c
forall a b. (a, b) -> a
fst ((c, c) -> c) -> (c -> (c, c)) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CountOf (Element c) -> c -> (c, c)
forall c. Sequential c => CountOf (Element c) -> c -> (c, c)
revSplitAt CountOf (Element c)
n

    -- | Drop the first @n elements of a collection
    drop :: CountOf (Element c) -> c -> c
    drop CountOf (Element c)
n = (c, c) -> c
forall a b. (a, b) -> b
snd ((c, c) -> c) -> (c -> (c, c)) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CountOf (Element c) -> c -> (c, c)
forall c. Sequential c => CountOf (Element c) -> c -> (c, c)
splitAt CountOf (Element c)
n

    -- | Drop the last @n elements of a collection
    revDrop :: CountOf (Element c) -> c -> c
    revDrop CountOf (Element c)
n = (c, c) -> c
forall a b. (a, b) -> b
snd ((c, c) -> c) -> (c -> (c, c)) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CountOf (Element c) -> c -> (c, c)
forall c. Sequential c => CountOf (Element c) -> c -> (c, c)
revSplitAt CountOf (Element c)
n

    -- | Split the collection at the @n'th elements
    splitAt :: CountOf (Element c) -> c -> (c,c)
    splitAt CountOf (Element c)
n c
c = (CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
take CountOf (Element c)
n c
c, CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
drop CountOf (Element c)
n c
c)

    -- | Split the collection at the @n'th elements from the end
    revSplitAt :: CountOf (Element c) -> c -> (c,c)
    revSplitAt CountOf (Element c)
n c
c = (CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
revTake CountOf (Element c)
n c
c, CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
revDrop CountOf (Element c)
n c
c)

    -- | Split on a specific elements returning a list of colletion
    splitOn :: (Element c -> Bool) -> c -> [c]

    -- | Split a collection when the predicate return true
    break :: (Element c -> Bool) -> c -> (c,c)
    break Element c -> Bool
predicate = (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
span (Bool -> Bool
not (Bool -> Bool) -> (Element c -> Bool) -> Element c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element c -> Bool
predicate)

    -- | Split a collection when the predicate return true starting from the end of the collection
    breakEnd :: (Element c -> Bool) -> c -> (c,c)
    breakEnd Element c -> Bool
predicate = (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
spanEnd (Bool -> Bool
not (Bool -> Bool) -> (Element c -> Bool) -> Element c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element c -> Bool
predicate)

    -- | Split a collection at the given element
    breakElem :: Eq (Element c) => Element c -> c -> (c,c)
    breakElem Element c
c = (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
break (Element c -> Element c -> Bool
forall a. Eq a => a -> a -> Bool
== Element c
c)

    -- | Return the longest prefix in the collection that satisfy the predicate
    takeWhile :: (Element c -> Bool) -> c -> c
    takeWhile Element c -> Bool
predicate = (c, c) -> c
forall a b. (a, b) -> a
fst ((c, c) -> c) -> (c -> (c, c)) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
span Element c -> Bool
predicate

    -- | Return the longest prefix in the collection that satisfy the predicate
    dropWhile :: (Element c -> Bool) -> c -> c
    dropWhile Element c -> Bool
predicate = (c, c) -> c
forall a b. (a, b) -> b
snd ((c, c) -> c) -> (c -> (c, c)) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
span Element c -> Bool
predicate

    -- | The 'intersperse' function takes an element and a list and
    -- \`intersperses\' that element between the elements of the list.
    -- For example,
    --
    -- > intersperse ',' "abcde" == "a,b,c,d,e"
    intersperse :: Element c -> c -> c

    -- | 'intercalate' @xs xss@ is equivalent to @('mconcat' ('intersperse' xs xss))@.
    -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
    -- result.
    intercalate :: Monoid (Item c) => Element c -> c -> Element c
    intercalate Element c
xs c
xss = c -> Element c
forall c. (Monoid (Item c), Sequential c) => c -> Element c
mconcatCollection (Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
intersperse Element c
xs c
xss)

    -- | Split a collection while the predicate return true
    span :: (Element c -> Bool) -> c -> (c,c)
    span Element c -> Bool
predicate = (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
break (Bool -> Bool
not (Bool -> Bool) -> (Element c -> Bool) -> Element c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element c -> Bool
predicate)

    -- | Split a collection while the predicate return true starting from the end of the collection
    spanEnd :: (Element c -> Bool) -> c -> (c,c)
    spanEnd Element c -> Bool
predicate = (Element c -> Bool) -> c -> (c, c)
forall c. Sequential c => (Element c -> Bool) -> c -> (c, c)
breakEnd (Bool -> Bool
not (Bool -> Bool) -> (Element c -> Bool) -> Element c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element c -> Bool
predicate)

    -- | Filter all the elements that satisfy the predicate
    filter :: (Element c -> Bool) -> c -> c

    -- | Partition the elements that satisfy the predicate and those that don't
    partition :: (Element c -> Bool) -> c -> (c,c)
    partition Element c -> Bool
predicate c
c = ((Element c -> Bool) -> c -> c
forall c. Sequential c => (Element c -> Bool) -> c -> c
filter Element c -> Bool
predicate c
c, (Element c -> Bool) -> c -> c
forall c. Sequential c => (Element c -> Bool) -> c -> c
filter (Bool -> Bool
not (Bool -> Bool) -> (Element c -> Bool) -> Element c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element c -> Bool
predicate) c
c)

    -- | Reverse a collection
    reverse :: c -> c

    -- | Decompose a collection into its first element and the remaining collection.
    -- If the collection is empty, returns Nothing.
    uncons :: c -> Maybe (Element c, c)

    -- | Decompose a collection into a collection without its last element, and the last element
    -- If the collection is empty, returns Nothing.
    unsnoc :: c -> Maybe (c, Element c)

    -- | Prepend an element to an ordered collection
    snoc :: c -> Element c -> c

    -- | Append an element to an ordered collection
    cons :: Element c -> c -> c

    -- | Find an element in an ordered collection
    find :: (Element c -> Bool) -> c -> Maybe (Element c)

    -- | Sort an ordered collection using the specified order function
    sortBy :: (Element c -> Element c -> Ordering) -> c -> c

    -- | Create a collection with a single element
    singleton :: Element c -> c

    -- | get the first element of a non-empty collection
    head :: NonEmpty c -> Element c
    head NonEmpty c
nel = Element c
-> ((Element c, c) -> Element c)
-> Maybe (Element c, c)
-> Element c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Element c
forall a. HasCallStack => [Char] -> a
error [Char]
"head") (Element c, c) -> Element c
forall a b. (a, b) -> a
fst (Maybe (Element c, c) -> Element c)
-> Maybe (Element c, c) -> Element c
forall a b. (a -> b) -> a -> b
$ c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons (NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty NonEmpty c
nel)

    -- | get the last element of a non-empty collection
    last :: NonEmpty c -> Element c
    last NonEmpty c
nel = Element c
-> ((c, Element c) -> Element c)
-> Maybe (c, Element c)
-> Element c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Element c
forall a. HasCallStack => [Char] -> a
error [Char]
"last") (c, Element c) -> Element c
forall a b. (a, b) -> b
snd (Maybe (c, Element c) -> Element c)
-> Maybe (c, Element c) -> Element c
forall a b. (a -> b) -> a -> b
$ c -> Maybe (c, Element c)
forall c. Sequential c => c -> Maybe (c, Element c)
unsnoc (NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty NonEmpty c
nel)

    -- | Extract the elements after the first element of a non-empty collection.
    tail :: NonEmpty c -> c
    tail NonEmpty c
nel = c -> ((Element c, c) -> c) -> Maybe (Element c, c) -> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> c
forall a. HasCallStack => [Char] -> a
error [Char]
"tail") (Element c, c) -> c
forall a b. (a, b) -> b
snd (Maybe (Element c, c) -> c) -> Maybe (Element c, c) -> c
forall a b. (a -> b) -> a -> b
$ c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons (NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty NonEmpty c
nel)

    -- | Extract the elements before the last element of a non-empty collection.
    init :: NonEmpty c -> c
    init NonEmpty c
nel = c -> ((c, Element c) -> c) -> Maybe (c, Element c) -> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> c
forall a. HasCallStack => [Char] -> a
error [Char]
"init") (c, Element c) -> c
forall a b. (a, b) -> a
fst (Maybe (c, Element c) -> c) -> Maybe (c, Element c) -> c
forall a b. (a -> b) -> a -> b
$ c -> Maybe (c, Element c)
forall c. Sequential c => c -> Maybe (c, Element c)
unsnoc (NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty NonEmpty c
nel)

    -- | Create a collection where the element in parameter is repeated N time
    replicate :: CountOf (Element c) -> Element c -> c

    -- | Takes two collections and returns True iff the first collection is a prefix of the second.
    isPrefixOf :: Eq (Element c) => c -> c -> Bool
    default isPrefixOf :: Eq c => c -> c -> Bool
    isPrefixOf c
c1 c
c2
        | CountOf (Element c)
len1 CountOf (Element c) -> CountOf (Element c) -> Bool
forall a. Ord a => a -> a -> Bool
> CountOf (Element c)
len2  = Bool
False
        | CountOf (Element c)
len1 CountOf (Element c) -> CountOf (Element c) -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf (Element c)
len2 = c
c1 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
c2
        | Bool
otherwise    = c
c1 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
take CountOf (Element c)
len1 c
c2
      where
        len1 :: CountOf (Element c)
len1 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
c1
        len2 :: CountOf (Element c)
len2 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
c2

    -- | Takes two collections and returns True iff the first collection is a suffix of the second.
    isSuffixOf :: Eq (Element c) => c -> c -> Bool
    default isSuffixOf :: Eq c => c -> c -> Bool
    isSuffixOf c
c1 c
c2
        | CountOf (Element c)
len1 CountOf (Element c) -> CountOf (Element c) -> Bool
forall a. Ord a => a -> a -> Bool
> CountOf (Element c)
len2  = Bool
False
        | CountOf (Element c)
len1 CountOf (Element c) -> CountOf (Element c) -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf (Element c)
len2 = c
c1 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
c2
        | Bool
otherwise    = c
c1 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
revTake CountOf (Element c)
len1 c
c2
      where
        len1 :: CountOf (Element c)
len1 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
c1
        len2 :: CountOf (Element c)
len2 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
c2

    -- | Takes two collections and returns True iff the first collection is an infix of the second.
    isInfixOf :: Eq (Element c) => c -> c -> Bool
    default isInfixOf :: Eq c => c -> c -> Bool
    isInfixOf c
c1 c
c2 = Maybe (CountOf (Element c)) -> c -> Bool
loop (CountOf (Element c)
len2 CountOf (Element c)
-> CountOf (Element c) -> Difference (CountOf (Element c))
forall a. Subtractive a => a -> a -> Difference a
- CountOf (Element c)
len1) c
c2
      where len1 :: CountOf (Element c)
len1 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
c1
            len2 :: CountOf (Element c)
len2 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
c2
            loop :: Maybe (CountOf (Element c)) -> c -> Bool
loop (Just CountOf (Element c)
cnt) c
c2' = c
c1 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
take CountOf (Element c)
len1 c
c2' Bool -> Bool -> Bool
|| Maybe (CountOf (Element c)) -> c -> Bool
loop (CountOf (Element c)
cnt CountOf (Element c)
-> CountOf (Element c) -> Difference (CountOf (Element c))
forall a. Subtractive a => a -> a -> Difference a
- CountOf (Element c)
1) (CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
drop CountOf (Element c)
1 c
c2')
            loop Maybe (CountOf (Element c))
Nothing    c
_   = Bool
False

    -- | Try to strip a prefix from a collection
    stripPrefix :: Eq (Element c) => c -> c -> Maybe c
    stripPrefix c
pre c
s
        | c -> c -> Bool
forall c. (Sequential c, Eq (Element c)) => c -> c -> Bool
isPrefixOf c
pre c
s = c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
drop (c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
pre) c
s
        | Bool
otherwise        = Maybe c
forall a. Maybe a
Nothing

    -- | Try to strip a suffix from a collection
    stripSuffix :: Eq (Element c) => c -> c -> Maybe c
    stripSuffix c
suf c
s
        | c -> c -> Bool
forall c. (Sequential c, Eq (Element c)) => c -> c -> Bool
isSuffixOf c
suf c
s = c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ CountOf (Element c) -> c -> c
forall c. Sequential c => CountOf (Element c) -> c -> c
revDrop (c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length c
suf) c
s
        | Bool
otherwise        = Maybe c
forall a. Maybe a
Nothing

-- Temporary utility functions
mconcatCollection :: (Monoid (Item c), Sequential c) => c -> Element c
mconcatCollection :: c -> Element c
mconcatCollection c
c = [Element c] -> Element c
forall a. Monoid a => [a] -> a
mconcat (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)

instance Sequential [a] where
    take :: CountOf (Element [a]) -> [a] -> [a]
take (CountOf Int
n) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Data.List.take Int
n
    drop :: CountOf (Element [a]) -> [a] -> [a]
drop (CountOf Int
n) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Data.List.drop Int
n
    revTake :: CountOf (Element [a]) -> [a] -> [a]
revTake (CountOf Int
n) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
ListExtra.revTake Int
n
    revDrop :: CountOf (Element [a]) -> [a] -> [a]
revDrop (CountOf Int
n) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
ListExtra.revDrop Int
n
    splitAt :: CountOf (Element [a]) -> [a] -> ([a], [a])
splitAt (CountOf Int
n) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
Data.List.splitAt Int
n
    revSplitAt :: CountOf (Element [a]) -> [a] -> ([a], [a])
revSplitAt (CountOf Int
n) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
ListExtra.revSplitAt Int
n
    splitOn :: (Element [a] -> Bool) -> [a] -> [[a]]
splitOn = (Element [a] -> Bool) -> [a] -> [[a]]
forall x. (x -> Bool) -> [x] -> [[x]]
ListExtra.wordsWhen
    break :: (Element [a] -> Bool) -> [a] -> ([a], [a])
break = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.break
    breakEnd :: (Element [a] -> Bool) -> [a] -> ([a], [a])
breakEnd = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
ListExtra.breakEnd
    intersperse :: Element [a] -> [a] -> [a]
intersperse = Element [a] -> [a] -> [a]
forall a. a -> [a] -> [a]
Data.List.intersperse
    span :: (Element [a] -> Bool) -> [a] -> ([a], [a])
span = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.span
    dropWhile :: (Element [a] -> Bool) -> [a] -> [a]
dropWhile = (Element [a] -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
Data.List.dropWhile
    takeWhile :: (Element [a] -> Bool) -> [a] -> [a]
takeWhile = (Element [a] -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
Data.List.takeWhile
    filter :: (Element [a] -> Bool) -> [a] -> [a]
filter = (Element [a] -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
Data.List.filter
    partition :: (Element [a] -> Bool) -> [a] -> ([a], [a])
partition = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition
    reverse :: [a] -> [a]
reverse = [a] -> [a]
forall a. [a] -> [a]
Data.List.reverse
    uncons :: [a] -> Maybe (Element [a], [a])
uncons = [a] -> Maybe (Element [a], [a])
forall a. [a] -> Maybe (a, [a])
ListExtra.uncons
    unsnoc :: [a] -> Maybe ([a], Element [a])
unsnoc = [a] -> Maybe ([a], Element [a])
forall a. [a] -> Maybe ([a], a)
ListExtra.unsnoc
    snoc :: [a] -> Element [a] -> [a]
snoc [a]
c Element [a]
e = [a]
c [a] -> [a] -> [a]
forall a. Monoid a => a -> a -> a
`mappend` [a
Element [a]
e]
    cons :: Element [a] -> [a] -> [a]
cons Element [a]
e [a]
c = a
Element [a]
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
c
    find :: (Element [a] -> Bool) -> [a] -> Maybe (Element [a])
find = (Element [a] -> Bool) -> [a] -> Maybe (Element [a])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find
    sortBy :: (Element [a] -> Element [a] -> Ordering) -> [a] -> [a]
sortBy = (Element [a] -> Element [a] -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy
    singleton :: Element [a] -> [a]
singleton = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])
    replicate :: CountOf (Element [a]) -> Element [a] -> [a]
replicate (CountOf Int
i) = Int -> a -> [a]
forall a. Int -> a -> [a]
Data.List.replicate Int
i
    isPrefixOf :: [a] -> [a] -> Bool
isPrefixOf = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isPrefixOf
    isSuffixOf :: [a] -> [a] -> Bool
isSuffixOf = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isSuffixOf

instance UV.PrimType ty => Sequential (BLK.Block ty) where
    splitAt :: CountOf (Element (Block ty)) -> Block ty -> (Block ty, Block ty)
splitAt CountOf (Element (Block ty))
n = CountOf ty -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
BLK.splitAt CountOf ty
CountOf (Element (Block ty))
n
    revSplitAt :: CountOf (Element (Block ty)) -> Block ty -> (Block ty, Block ty)
revSplitAt CountOf (Element (Block ty))
n = CountOf ty -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
BLK.revSplitAt CountOf ty
CountOf (Element (Block ty))
n
    splitOn :: (Element (Block ty) -> Bool) -> Block ty -> [Block ty]
splitOn = (Element (Block ty) -> Bool) -> Block ty -> [Block ty]
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> [Block ty]
BLK.splitOn
    break :: (Element (Block ty) -> Bool) -> Block ty -> (Block ty, Block ty)
break = (Element (Block ty) -> Bool) -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
BLK.break
    breakEnd :: (Element (Block ty) -> Bool) -> Block ty -> (Block ty, Block ty)
breakEnd = (Element (Block ty) -> Bool) -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
BLK.breakEnd
    intersperse :: Element (Block ty) -> Block ty -> Block ty
intersperse = Element (Block ty) -> Block ty -> Block ty
forall ty. PrimType ty => ty -> Block ty -> Block ty
BLK.intersperse
    span :: (Element (Block ty) -> Bool) -> Block ty -> (Block ty, Block ty)
span = (Element (Block ty) -> Bool) -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
BLK.span
    filter :: (Element (Block ty) -> Bool) -> Block ty -> Block ty
filter = (Element (Block ty) -> Bool) -> Block ty -> Block ty
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Block ty
BLK.filter
    reverse :: Block ty -> Block ty
reverse = Block ty -> Block ty
forall ty. PrimType ty => Block ty -> Block ty
BLK.reverse
    uncons :: Block ty -> Maybe (Element (Block ty), Block ty)
uncons = Block ty -> Maybe (Element (Block ty), Block ty)
forall ty. PrimType ty => Block ty -> Maybe (ty, Block ty)
BLK.uncons
    unsnoc :: Block ty -> Maybe (Block ty, Element (Block ty))
unsnoc = Block ty -> Maybe (Block ty, Element (Block ty))
forall ty. PrimType ty => Block ty -> Maybe (Block ty, ty)
BLK.unsnoc
    snoc :: Block ty -> Element (Block ty) -> Block ty
snoc = Block ty -> Element (Block ty) -> Block ty
forall ty. PrimType ty => Block ty -> ty -> Block ty
BLK.snoc
    cons :: Element (Block ty) -> Block ty -> Block ty
cons = Element (Block ty) -> Block ty -> Block ty
forall ty. PrimType ty => ty -> Block ty -> Block ty
BLK.cons
    find :: (Element (Block ty) -> Bool)
-> Block ty -> Maybe (Element (Block ty))
find = (Element (Block ty) -> Bool)
-> Block ty -> Maybe (Element (Block ty))
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Maybe ty
BLK.find
    sortBy :: (Element (Block ty) -> Element (Block ty) -> Ordering)
-> Block ty -> Block ty
sortBy = (Element (Block ty) -> Element (Block ty) -> Ordering)
-> Block ty -> Block ty
forall ty.
PrimType ty =>
(ty -> ty -> Ordering) -> Block ty -> Block ty
BLK.sortBy
    singleton :: Element (Block ty) -> Block ty
singleton = Element (Block ty) -> Block ty
forall ty. PrimType ty => ty -> Block ty
BLK.singleton
    replicate :: CountOf (Element (Block ty)) -> Element (Block ty) -> Block ty
replicate = CountOf (Element (Block ty)) -> Element (Block ty) -> Block ty
forall ty. PrimType ty => CountOf ty -> ty -> Block ty
BLK.replicate

instance UV.PrimType ty => Sequential (UV.UArray ty) where
    take :: CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
take = CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
forall ty. CountOf ty -> UArray ty -> UArray ty
UV.take
    revTake :: CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
revTake = CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
forall ty. CountOf ty -> UArray ty -> UArray ty
UV.revTake
    drop :: CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
drop = CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
forall ty. CountOf ty -> UArray ty -> UArray ty
UV.drop
    revDrop :: CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
revDrop = CountOf (Element (UArray ty)) -> UArray ty -> UArray ty
forall ty. CountOf ty -> UArray ty -> UArray ty
UV.revDrop
    splitAt :: CountOf (Element (UArray ty))
-> UArray ty -> (UArray ty, UArray ty)
splitAt = CountOf (Element (UArray ty))
-> UArray ty -> (UArray ty, UArray ty)
forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
UV.splitAt
    revSplitAt :: CountOf (Element (UArray ty))
-> UArray ty -> (UArray ty, UArray ty)
revSplitAt = CountOf (Element (UArray ty))
-> UArray ty -> (UArray ty, UArray ty)
forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
UV.revSplitAt
    splitOn :: (Element (UArray ty) -> Bool) -> UArray ty -> [UArray ty]
splitOn = (Element (UArray ty) -> Bool) -> UArray ty -> [UArray ty]
forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> [UArray ty]
UV.splitOn
    break :: (Element (UArray ty) -> Bool)
-> UArray ty -> (UArray ty, UArray ty)
break = (Element (UArray ty) -> Bool)
-> UArray ty -> (UArray ty, UArray ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
UV.break
    breakEnd :: (Element (UArray ty) -> Bool)
-> UArray ty -> (UArray ty, UArray ty)
breakEnd = (Element (UArray ty) -> Bool)
-> UArray ty -> (UArray ty, UArray ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
UV.breakEnd
    breakElem :: Element (UArray ty) -> UArray ty -> (UArray ty, UArray ty)
breakElem = Element (UArray ty) -> UArray ty -> (UArray ty, UArray ty)
forall ty. PrimType ty => ty -> UArray ty -> (UArray ty, UArray ty)
UV.breakElem
    intersperse :: Element (UArray ty) -> UArray ty -> UArray ty
intersperse = Element (UArray ty) -> UArray ty -> UArray ty
forall ty. PrimType ty => ty -> UArray ty -> UArray ty
UV.intersperse
    span :: (Element (UArray ty) -> Bool)
-> UArray ty -> (UArray ty, UArray ty)
span = (Element (UArray ty) -> Bool)
-> UArray ty -> (UArray ty, UArray ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
UV.span
    filter :: (Element (UArray ty) -> Bool) -> UArray ty -> UArray ty
filter = (Element (UArray ty) -> Bool) -> UArray ty -> UArray ty
forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> UArray ty
UV.filter
    reverse :: UArray ty -> UArray ty
reverse = UArray ty -> UArray ty
forall ty. PrimType ty => UArray ty -> UArray ty
UV.reverse
    uncons :: UArray ty -> Maybe (Element (UArray ty), UArray ty)
uncons = UArray ty -> Maybe (Element (UArray ty), UArray ty)
forall ty. PrimType ty => UArray ty -> Maybe (ty, UArray ty)
UV.uncons
    unsnoc :: UArray ty -> Maybe (UArray ty, Element (UArray ty))
unsnoc = UArray ty -> Maybe (UArray ty, Element (UArray ty))
forall ty. PrimType ty => UArray ty -> Maybe (UArray ty, ty)
UV.unsnoc
    snoc :: UArray ty -> Element (UArray ty) -> UArray ty
snoc = UArray ty -> Element (UArray ty) -> UArray ty
forall ty. PrimType ty => UArray ty -> ty -> UArray ty
UV.snoc
    cons :: Element (UArray ty) -> UArray ty -> UArray ty
cons = Element (UArray ty) -> UArray ty -> UArray ty
forall ty. PrimType ty => ty -> UArray ty -> UArray ty
UV.cons
    find :: (Element (UArray ty) -> Bool)
-> UArray ty -> Maybe (Element (UArray ty))
find = (Element (UArray ty) -> Bool)
-> UArray ty -> Maybe (Element (UArray ty))
forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Maybe ty
UV.find
    sortBy :: (Element (UArray ty) -> Element (UArray ty) -> Ordering)
-> UArray ty -> UArray ty
sortBy = (Element (UArray ty) -> Element (UArray ty) -> Ordering)
-> UArray ty -> UArray ty
forall ty.
PrimType ty =>
(ty -> ty -> Ordering) -> UArray ty -> UArray ty
UV.sortBy
    singleton :: Element (UArray ty) -> UArray ty
singleton = [ty] -> UArray ty
forall l. IsList l => [Item l] -> l
fromList ([ty] -> UArray ty) -> (ty -> [ty]) -> ty -> UArray ty
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ty -> [ty] -> [ty]
forall a. a -> [a] -> [a]
:[])
    replicate :: CountOf (Element (UArray ty)) -> Element (UArray ty) -> UArray ty
replicate = CountOf (Element (UArray ty)) -> Element (UArray ty) -> UArray ty
forall ty. PrimType ty => CountOf ty -> ty -> UArray ty
UV.replicate
    isPrefixOf :: UArray ty -> UArray ty -> Bool
isPrefixOf = UArray ty -> UArray ty -> Bool
forall ty. PrimType ty => UArray ty -> UArray ty -> Bool
UV.isPrefixOf
    isSuffixOf :: UArray ty -> UArray ty -> Bool
isSuffixOf = UArray ty -> UArray ty -> Bool
forall ty. PrimType ty => UArray ty -> UArray ty -> Bool
UV.isSuffixOf

instance Sequential (BA.Array ty) where
    take :: CountOf (Element (Array ty)) -> Array ty -> Array ty
take = CountOf (Element (Array ty)) -> Array ty -> Array ty
forall ty. CountOf ty -> Array ty -> Array ty
BA.take
    drop :: CountOf (Element (Array ty)) -> Array ty -> Array ty
drop = CountOf (Element (Array ty)) -> Array ty -> Array ty
forall ty. CountOf ty -> Array ty -> Array ty
BA.drop
    splitAt :: CountOf (Element (Array ty)) -> Array ty -> (Array ty, Array ty)
splitAt = CountOf (Element (Array ty)) -> Array ty -> (Array ty, Array ty)
forall ty. CountOf ty -> Array ty -> (Array ty, Array ty)
BA.splitAt
    revTake :: CountOf (Element (Array ty)) -> Array ty -> Array ty
revTake = CountOf (Element (Array ty)) -> Array ty -> Array ty
forall ty. CountOf ty -> Array ty -> Array ty
BA.revTake
    revDrop :: CountOf (Element (Array ty)) -> Array ty -> Array ty
revDrop = CountOf (Element (Array ty)) -> Array ty -> Array ty
forall ty. CountOf ty -> Array ty -> Array ty
BA.revDrop
    revSplitAt :: CountOf (Element (Array ty)) -> Array ty -> (Array ty, Array ty)
revSplitAt = CountOf (Element (Array ty)) -> Array ty -> (Array ty, Array ty)
forall ty. CountOf ty -> Array ty -> (Array ty, Array ty)
BA.revSplitAt
    splitOn :: (Element (Array ty) -> Bool) -> Array ty -> [Array ty]
splitOn = (Element (Array ty) -> Bool) -> Array ty -> [Array ty]
forall ty. (ty -> Bool) -> Array ty -> [Array ty]
BA.splitOn
    break :: (Element (Array ty) -> Bool) -> Array ty -> (Array ty, Array ty)
break = (Element (Array ty) -> Bool) -> Array ty -> (Array ty, Array ty)
forall ty. (ty -> Bool) -> Array ty -> (Array ty, Array ty)
BA.break
    breakEnd :: (Element (Array ty) -> Bool) -> Array ty -> (Array ty, Array ty)
breakEnd = (Element (Array ty) -> Bool) -> Array ty -> (Array ty, Array ty)
forall ty. (ty -> Bool) -> Array ty -> (Array ty, Array ty)
BA.breakEnd
    intersperse :: Element (Array ty) -> Array ty -> Array ty
intersperse = Element (Array ty) -> Array ty -> Array ty
forall ty. ty -> Array ty -> Array ty
BA.intersperse
    span :: (Element (Array ty) -> Bool) -> Array ty -> (Array ty, Array ty)
span = (Element (Array ty) -> Bool) -> Array ty -> (Array ty, Array ty)
forall ty. (ty -> Bool) -> Array ty -> (Array ty, Array ty)
BA.span
    reverse :: Array ty -> Array ty
reverse = Array ty -> Array ty
forall ty. Array ty -> Array ty
BA.reverse
    filter :: (Element (Array ty) -> Bool) -> Array ty -> Array ty
filter = (Element (Array ty) -> Bool) -> Array ty -> Array ty
forall ty. (ty -> Bool) -> Array ty -> Array ty
BA.filter
    unsnoc :: Array ty -> Maybe (Array ty, Element (Array ty))
unsnoc = Array ty -> Maybe (Array ty, Element (Array ty))
forall ty. Array ty -> Maybe (Array ty, ty)
BA.unsnoc
    uncons :: Array ty -> Maybe (Element (Array ty), Array ty)
uncons = Array ty -> Maybe (Element (Array ty), Array ty)
forall ty. Array ty -> Maybe (ty, Array ty)
BA.uncons
    snoc :: Array ty -> Element (Array ty) -> Array ty
snoc = Array ty -> Element (Array ty) -> Array ty
forall ty. Array ty -> ty -> Array ty
BA.snoc
    cons :: Element (Array ty) -> Array ty -> Array ty
cons = Element (Array ty) -> Array ty -> Array ty
forall ty. ty -> Array ty -> Array ty
BA.cons
    find :: (Element (Array ty) -> Bool)
-> Array ty -> Maybe (Element (Array ty))
find = (Element (Array ty) -> Bool)
-> Array ty -> Maybe (Element (Array ty))
forall ty. (ty -> Bool) -> Array ty -> Maybe ty
BA.find
    sortBy :: (Element (Array ty) -> Element (Array ty) -> Ordering)
-> Array ty -> Array ty
sortBy = (Element (Array ty) -> Element (Array ty) -> Ordering)
-> Array ty -> Array ty
forall ty. (ty -> ty -> Ordering) -> Array ty -> Array ty
BA.sortBy
    singleton :: Element (Array ty) -> Array ty
singleton = Element (Array ty) -> Array ty
forall ty. ty -> Array ty
BA.singleton
    replicate :: CountOf (Element (Array ty)) -> Element (Array ty) -> Array ty
replicate = CountOf (Element (Array ty)) -> Element (Array ty) -> Array ty
forall ty. CountOf ty -> ty -> Array ty
BA.replicate
    isSuffixOf :: Array ty -> Array ty -> Bool
isSuffixOf = Array ty -> Array ty -> Bool
forall ty. Eq ty => Array ty -> Array ty -> Bool
BA.isSuffixOf
    isPrefixOf :: Array ty -> Array ty -> Bool
isPrefixOf = Array ty -> Array ty -> Bool
forall ty. Eq ty => Array ty -> Array ty -> Bool
BA.isPrefixOf

instance Sequential S.String where
    take :: CountOf (Element String) -> String -> String
take = CountOf Char -> String -> String
CountOf (Element String) -> String -> String
S.take
    drop :: CountOf (Element String) -> String -> String
drop = CountOf Char -> String -> String
CountOf (Element String) -> String -> String
S.drop
    splitAt :: CountOf (Element String) -> String -> (String, String)
splitAt = CountOf Char -> String -> (String, String)
CountOf (Element String) -> String -> (String, String)
S.splitAt
    revTake :: CountOf (Element String) -> String -> String
revTake = CountOf Char -> String -> String
CountOf (Element String) -> String -> String
S.revTake
    revDrop :: CountOf (Element String) -> String -> String
revDrop = CountOf Char -> String -> String
CountOf (Element String) -> String -> String
S.revDrop
    revSplitAt :: CountOf (Element String) -> String -> (String, String)
revSplitAt = CountOf Char -> String -> (String, String)
CountOf (Element String) -> String -> (String, String)
S.revSplitAt
    splitOn :: (Element String -> Bool) -> String -> [String]
splitOn = (Char -> Bool) -> String -> [String]
(Element String -> Bool) -> String -> [String]
S.splitOn
    break :: (Element String -> Bool) -> String -> (String, String)
break = (Char -> Bool) -> String -> (String, String)
(Element String -> Bool) -> String -> (String, String)
S.break
    breakEnd :: (Element String -> Bool) -> String -> (String, String)
breakEnd = (Char -> Bool) -> String -> (String, String)
(Element String -> Bool) -> String -> (String, String)
S.breakEnd
    breakElem :: Element String -> String -> (String, String)
breakElem = Char -> String -> (String, String)
Element String -> String -> (String, String)
S.breakElem
    intersperse :: Element String -> String -> String
intersperse = Char -> String -> String
Element String -> String -> String
S.intersperse
    span :: (Element String -> Bool) -> String -> (String, String)
span = (Char -> Bool) -> String -> (String, String)
(Element String -> Bool) -> String -> (String, String)
S.span
    filter :: (Element String -> Bool) -> String -> String
filter = (Char -> Bool) -> String -> String
(Element String -> Bool) -> String -> String
S.filter
    reverse :: String -> String
reverse = String -> String
S.reverse
    unsnoc :: String -> Maybe (String, Element String)
unsnoc = String -> Maybe (String, Char)
String -> Maybe (String, Element String)
S.unsnoc
    uncons :: String -> Maybe (Element String, String)
uncons = String -> Maybe (Char, String)
String -> Maybe (Element String, String)
S.uncons
    snoc :: String -> Element String -> String
snoc = String -> Char -> String
String -> Element String -> String
S.snoc
    cons :: Element String -> String -> String
cons = Char -> String -> String
Element String -> String -> String
S.cons
    find :: (Element String -> Bool) -> String -> Maybe (Element String)
find = (Char -> Bool) -> String -> Maybe Char
(Element String -> Bool) -> String -> Maybe (Element String)
S.find
    sortBy :: (Element String -> Element String -> Ordering) -> String -> String
sortBy = (Char -> Char -> Ordering) -> String -> String
(Element String -> Element String -> Ordering) -> String -> String
S.sortBy
    singleton :: Element String -> String
singleton = Char -> String
Element String -> String
S.singleton
    replicate :: CountOf (Element String) -> Element String -> String
replicate = CountOf Char -> Char -> String
CountOf (Element String) -> Element String -> String
S.replicate
    isSuffixOf :: String -> String -> Bool
isSuffixOf = String -> String -> Bool
S.isSuffixOf
    isPrefixOf :: String -> String -> Bool
isPrefixOf = String -> String -> Bool
S.isPrefixOf
    isInfixOf :: String -> String -> Bool
isInfixOf  = String -> String -> Bool
S.isInfixOf
    stripPrefix :: String -> String -> Maybe String
stripPrefix = String -> String -> Maybe String
S.stripPrefix
    stripSuffix :: String -> String -> Maybe String
stripSuffix = String -> String -> Maybe String
S.stripSuffix

deriving instance Sequential AsciiString