{-# 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
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 :: 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
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 :: 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
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
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)
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)
splitOn :: (Element c -> Bool) -> c -> [c]
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)
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)
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)
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
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
intersperse :: Element c -> c -> c
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)
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)
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 :: (Element c -> Bool) -> c -> c
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 :: c -> c
uncons :: c -> Maybe (Element c, c)
unsnoc :: c -> Maybe (c, Element c)
snoc :: c -> Element c -> c
cons :: Element c -> c -> c
find :: (Element c -> Bool) -> c -> Maybe (Element c)
sortBy :: (Element c -> Element c -> Ordering) -> c -> c
singleton :: Element c -> c
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)
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)
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)
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)
replicate :: CountOf (Element c) -> Element c -> c
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
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
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
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
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
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