{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
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)
class (Integral (Index seq), GrowingAppend seq) => SemiSequence seq where
type Index seq
intersperse :: Element seq -> seq -> seq
reverse :: seq -> seq
find :: (Element seq -> Bool) -> seq -> Maybe (Element seq)
sortBy :: (Element seq -> Element seq -> Ordering) -> seq -> seq
cons :: Element seq -> seq -> seq
snoc :: seq -> Element seq -> seq
singleton :: MonoPointed seq => Element seq -> seq
singleton :: Element seq -> seq
singleton = Element seq -> seq
forall mono. MonoPointed mono => Element mono -> mono
opoint
{-# INLINE singleton #-}
class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => IsSequence seq where
fromList :: [Element seq] -> seq
fromList = [seq] -> seq
forall a. Monoid a => [a] -> a
mconcat ([seq] -> seq) -> ([Element seq] -> [seq]) -> [Element seq] -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> seq) -> [Element seq] -> [seq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element seq -> seq
forall mono. MonoPointed mono => Element mono -> mono
singleton
lengthIndex :: seq -> Index seq;
lengthIndex = Int64 -> Index seq
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Index seq) -> (seq -> Int64) -> seq -> Index seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> Int64
forall mono. MonoFoldable mono => mono -> Int64
olength64;
break :: (Element seq -> Bool) -> seq -> (seq, seq)
break Element seq -> Bool
f = ([Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq)
-> ([Element seq] -> seq)
-> ([Element seq], [Element seq])
-> (seq, seq)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList) (([Element seq], [Element seq]) -> (seq, seq))
-> (seq -> ([Element seq], [Element seq])) -> seq -> (seq, seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool)
-> [Element seq] -> ([Element seq], [Element seq])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break Element seq -> Bool
f ([Element seq] -> ([Element seq], [Element seq]))
-> (seq -> [Element seq]) -> seq -> ([Element seq], [Element seq])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
span :: (Element seq -> Bool) -> seq -> (seq, seq)
span Element seq -> Bool
f = ([Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq)
-> ([Element seq] -> seq)
-> ([Element seq], [Element seq])
-> (seq, seq)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList) (([Element seq], [Element seq]) -> (seq, seq))
-> (seq -> ([Element seq], [Element seq])) -> seq -> (seq, seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool)
-> [Element seq] -> ([Element seq], [Element seq])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span Element seq -> Bool
f ([Element seq] -> ([Element seq], [Element seq]))
-> (seq -> [Element seq]) -> seq -> ([Element seq], [Element seq])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
dropWhile :: (Element seq -> Bool) -> seq -> seq
dropWhile Element seq -> Bool
f = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool) -> [Element seq] -> [Element seq]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile Element seq -> Bool
f ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
takeWhile :: (Element seq -> Bool) -> seq -> seq
takeWhile Element seq -> Bool
f = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool) -> [Element seq] -> [Element seq]
forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile Element seq -> Bool
f ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
splitAt :: Index seq -> seq -> (seq, seq)
splitAt Index seq
i = ([Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq)
-> ([Element seq] -> seq)
-> ([Element seq], [Element seq])
-> (seq, seq)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList) (([Element seq], [Element seq]) -> (seq, seq))
-> (seq -> ([Element seq], [Element seq])) -> seq -> (seq, seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index seq -> [Element seq] -> ([Element seq], [Element seq])
forall i a. Integral i => i -> [a] -> ([a], [a])
List.genericSplitAt Index seq
i ([Element seq] -> ([Element seq], [Element seq]))
-> (seq -> [Element seq]) -> seq -> ([Element seq], [Element seq])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
unsafeSplitAt :: Index seq -> seq -> (seq, seq)
unsafeSplitAt Index seq
i seq
seq = (Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
unsafeTake Index seq
i seq
seq, Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
unsafeDrop Index seq
i seq
seq)
take :: Index seq -> seq -> seq
take Index seq
i = (seq, seq) -> seq
forall a b. (a, b) -> a
fst ((seq, seq) -> seq) -> (seq -> (seq, seq)) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index seq -> seq -> (seq, seq)
forall seq. IsSequence seq => Index seq -> seq -> (seq, seq)
splitAt Index seq
i
unsafeTake :: Index seq -> seq -> seq
unsafeTake = Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
take
drop :: Index seq -> seq -> seq
drop Index seq
i = (seq, seq) -> seq
forall a b. (a, b) -> b
snd ((seq, seq) -> seq) -> (seq -> (seq, seq)) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index seq -> seq -> (seq, seq)
forall seq. IsSequence seq => Index seq -> seq -> (seq, seq)
splitAt Index seq
i
unsafeDrop :: Index seq -> seq -> seq
unsafeDrop = Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
drop
dropEnd :: Index seq -> seq -> seq
dropEnd Index seq
i seq
s = (seq, seq) -> seq
forall a b. (a, b) -> a
fst ((seq, seq) -> seq) -> (seq, seq) -> seq
forall a b. (a -> b) -> a -> b
$ Index seq -> seq -> (seq, seq)
forall seq. IsSequence seq => Index seq -> seq -> (seq, seq)
splitAt (seq -> Index seq
forall seq. IsSequence seq => seq -> Index seq
lengthIndex seq
s Index seq -> Index seq -> Index seq
forall a. Num a => a -> a -> a
- Index seq
i) seq
s
partition :: (Element seq -> Bool) -> seq -> (seq, seq)
partition Element seq -> Bool
f = ([Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq)
-> ([Element seq] -> seq)
-> ([Element seq], [Element seq])
-> (seq, seq)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList) (([Element seq], [Element seq]) -> (seq, seq))
-> (seq -> ([Element seq], [Element seq])) -> seq -> (seq, seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool)
-> [Element seq] -> ([Element seq], [Element seq])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition Element seq -> Bool
f ([Element seq] -> ([Element seq], [Element seq]))
-> (seq -> [Element seq]) -> seq -> ([Element seq], [Element seq])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
uncons :: seq -> Maybe (Element seq, seq)
uncons = ((Element seq, [Element seq]) -> (Element seq, seq))
-> Maybe (Element seq, [Element seq]) -> Maybe (Element seq, seq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Element seq] -> seq)
-> (Element seq, [Element seq]) -> (Element seq, seq)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList) (Maybe (Element seq, [Element seq]) -> Maybe (Element seq, seq))
-> (seq -> Maybe (Element seq, [Element seq]))
-> seq
-> Maybe (Element seq, seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Element seq] -> Maybe (Element seq, [Element seq])
forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons ([Element seq] -> Maybe (Element seq, [Element seq]))
-> (seq -> [Element seq])
-> seq
-> Maybe (Element seq, [Element seq])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
unsnoc :: seq -> Maybe (seq, Element seq)
unsnoc = (([Element seq], Element seq) -> (seq, Element seq))
-> Maybe ([Element seq], Element seq) -> Maybe (seq, Element seq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Element seq] -> seq)
-> ([Element seq], Element seq) -> (seq, Element seq)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList) (Maybe ([Element seq], Element seq) -> Maybe (seq, Element seq))
-> (seq -> Maybe ([Element seq], Element seq))
-> seq
-> Maybe (seq, Element seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Element seq] -> Maybe ([Element seq], Element seq)
forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc ([Element seq] -> Maybe ([Element seq], Element seq))
-> (seq -> [Element seq])
-> seq
-> Maybe ([Element seq], Element seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
filter :: (Element seq -> Bool) -> seq -> seq
filter Element seq -> Bool
f = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool) -> [Element seq] -> [Element seq]
forall a. (a -> Bool) -> [a] -> [a]
List.filter Element seq -> Bool
f ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
filterM :: Monad m => (Element seq -> m Bool) -> seq -> m seq
filterM Element seq -> m Bool
f = ([Element seq] -> seq) -> m [Element seq] -> m seq
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList (m [Element seq] -> m seq)
-> (seq -> m [Element seq]) -> seq -> m seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element [Element seq] -> m Bool)
-> [Element seq] -> m [Element seq]
forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
(Element seq -> m Bool) -> seq -> m seq
filterM Element seq -> m Bool
Element [Element seq] -> m Bool
f ([Element seq] -> m [Element seq])
-> (seq -> [Element seq]) -> seq -> m [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
replicate :: Index seq -> Element seq -> seq
replicate Index seq
i = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq)
-> (Element seq -> [Element seq]) -> Element seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index seq -> Element seq -> [Element seq]
forall i a. Integral i => i -> a -> [a]
List.genericReplicate Index seq
i
replicateM :: Monad m => Index seq -> m (Element seq) -> m seq
replicateM Index seq
i = ([Element seq] -> seq) -> m [Element seq] -> m seq
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList (m [Element seq] -> m seq)
-> (m (Element seq) -> m [Element seq]) -> m (Element seq) -> m seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> m (Element seq) -> m [Element seq]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Control.Monad.replicateM (Index seq -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Index seq
i)
groupBy :: (Element seq -> Element seq -> Bool) -> seq -> [seq]
groupBy Element seq -> Element seq -> Bool
f = ([Element seq] -> seq) -> [[Element seq]] -> [seq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([[Element seq]] -> [seq])
-> (seq -> [[Element seq]]) -> seq -> [seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Element seq -> Bool)
-> [Element seq] -> [[Element seq]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy Element seq -> Element seq -> Bool
f ([Element seq] -> [[Element seq]])
-> (seq -> [Element seq]) -> seq -> [[Element seq]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
groupAllOn :: Eq b => (Element seq -> b) -> seq -> [seq]
groupAllOn Element seq -> b
f = ([Element seq] -> seq) -> [[Element seq]] -> [seq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([[Element seq]] -> [seq])
-> (seq -> [[Element seq]]) -> seq -> [seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element [Element seq] -> b) -> [Element seq] -> [[Element seq]]
forall seq b.
(IsSequence seq, Eq b) =>
(Element seq -> b) -> seq -> [seq]
groupAllOn Element seq -> b
Element [Element seq] -> b
f ([Element seq] -> [[Element seq]])
-> (seq -> [Element seq]) -> seq -> [[Element seq]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
subsequences :: seq -> [seq]
subsequences = ([Element seq] -> seq) -> [[Element seq]] -> [seq]
forall a b. (a -> b) -> [a] -> [b]
List.map [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([[Element seq]] -> [seq])
-> (seq -> [[Element seq]]) -> seq -> [seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Element seq] -> [[Element seq]]
forall a. [a] -> [[a]]
List.subsequences ([Element seq] -> [[Element seq]])
-> (seq -> [Element seq]) -> seq -> [[Element seq]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
permutations :: seq -> [seq]
permutations = ([Element seq] -> seq) -> [[Element seq]] -> [seq]
forall a b. (a -> b) -> [a] -> [b]
List.map [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([[Element seq]] -> [seq])
-> (seq -> [[Element seq]]) -> seq -> [seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Element seq] -> [[Element seq]]
forall a. [a] -> [[a]]
List.permutations ([Element seq] -> [[Element seq]])
-> (seq -> [Element seq]) -> seq -> [[Element seq]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
tailEx :: seq -> seq
tailEx = (Element seq, seq) -> seq
forall a b. (a, b) -> b
snd ((Element seq, seq) -> seq)
-> (seq -> (Element seq, seq)) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq, seq)
-> ((Element seq, seq) -> (Element seq, seq))
-> Maybe (Element seq, seq)
-> (Element seq, seq)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> (Element seq, seq)
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequences.tailEx") (Element seq, seq) -> (Element seq, seq)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Maybe (Element seq, seq) -> (Element seq, seq))
-> (seq -> Maybe (Element seq, seq)) -> seq -> (Element seq, seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> Maybe (Element seq, seq)
forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons
tailMay :: seq -> Maybe seq
tailMay seq
seq
| seq -> Bool
forall mono. MonoFoldable mono => mono -> Bool
onull seq
seq = Maybe seq
forall a. Maybe a
Nothing
| Bool
otherwise = seq -> Maybe seq
forall a. a -> Maybe a
Just (seq -> seq
forall seq. IsSequence seq => seq -> seq
tailEx seq
seq)
{-# INLINE tailMay #-}
initEx :: seq -> seq
initEx = (seq, Element seq) -> seq
forall a b. (a, b) -> a
fst ((seq, Element seq) -> seq)
-> (seq -> (seq, Element seq)) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (seq, Element seq)
-> ((seq, Element seq) -> (seq, Element seq))
-> Maybe (seq, Element seq)
-> (seq, Element seq)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> (seq, Element seq)
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequences.initEx") (seq, Element seq) -> (seq, Element seq)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Maybe (seq, Element seq) -> (seq, Element seq))
-> (seq -> Maybe (seq, Element seq)) -> seq -> (seq, Element seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> Maybe (seq, Element seq)
forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc
initMay :: IsSequence seq => seq -> Maybe seq
initMay seq
seq
| seq -> Bool
forall mono. MonoFoldable mono => mono -> Bool
onull seq
seq = Maybe seq
forall a. Maybe a
Nothing
| Bool
otherwise = seq -> Maybe seq
forall a. a -> Maybe a
Just (seq -> seq
forall seq. IsSequence seq => seq -> seq
initEx seq
seq)
{-# INLINE initMay #-}
unsafeTail :: seq -> seq
unsafeTail = seq -> seq
forall seq. IsSequence seq => seq -> seq
tailEx
unsafeInit :: seq -> seq
unsafeInit = seq -> seq
forall seq. IsSequence seq => seq -> seq
initEx
index :: seq -> Index seq -> Maybe (Element seq)
index seq
seq' Index seq
idx
| Index seq
idx Index seq -> Index seq -> Bool
forall a. Ord a => a -> a -> Bool
< Index seq
0 = Maybe (Element seq)
forall a. Maybe a
Nothing
| Bool
otherwise = seq -> Maybe (Element seq)
forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay (Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
drop Index seq
idx seq
seq')
indexEx :: seq -> Index seq -> Element seq
indexEx seq
seq' Index seq
idx = Element seq
-> (Element seq -> Element seq)
-> Maybe (Element seq)
-> Element seq
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Element seq
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequences.indexEx") Element seq -> Element seq
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (seq -> Index seq -> Maybe (Element seq)
forall seq.
IsSequence seq =>
seq -> Index seq -> Maybe (Element seq)
index seq
seq' Index seq
idx)
unsafeIndex :: seq -> Index seq -> Element seq
unsafeIndex = seq -> Index seq -> Element seq
forall seq. IsSequence seq => seq -> Index seq -> Element seq
indexEx
splitWhen :: (Element seq -> Bool) -> seq -> [seq]
splitWhen = (Element seq -> Bool) -> seq -> [seq]
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 #-}
defaultFind :: MonoFoldable seq => (Element seq -> Bool) -> seq -> Maybe (Element seq)
defaultFind :: (Element seq -> Bool) -> seq -> Maybe (Element seq)
defaultFind Element seq -> Bool
f = (Element seq -> Bool) -> [Element seq] -> Maybe (Element seq)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find Element seq -> Bool
f ([Element seq] -> Maybe (Element seq))
-> (seq -> [Element seq]) -> seq -> Maybe (Element seq)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultFind #-}
defaultIntersperse :: IsSequence seq => Element seq -> seq -> seq
defaultIntersperse :: Element seq -> seq -> seq
defaultIntersperse Element seq
e = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element seq -> [Element seq] -> [Element seq]
forall a. a -> [a] -> [a]
List.intersperse Element seq
e ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultIntersperse #-}
defaultReverse :: IsSequence seq => seq -> seq
defaultReverse :: seq -> seq
defaultReverse = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Element seq] -> [Element seq]
forall a. [a] -> [a]
List.reverse ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultReverse #-}
defaultSortBy :: IsSequence seq => (Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy :: (Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy Element seq -> Element seq -> Ordering
f = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element [Element seq] -> Element [Element seq] -> Ordering)
-> [Element seq] -> [Element seq]
forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element seq -> Element seq -> Ordering
Element [Element seq] -> Element [Element seq] -> Ordering
f ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultSortBy #-}
defaultSplitWhen :: IsSequence seq => (Element seq -> Bool) -> seq -> [seq]
defaultSplitWhen :: (Element seq -> Bool) -> seq -> [seq]
defaultSplitWhen Element seq -> Bool
f = ([Element seq] -> seq) -> [[Element seq]] -> [seq]
forall a b. (a -> b) -> [a] -> [b]
List.map [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([[Element seq]] -> [seq])
-> (seq -> [[Element seq]]) -> seq -> [seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Bool) -> [Element seq] -> [[Element seq]]
forall a. (a -> Bool) -> [a] -> [[a]]
List.splitWhen Element seq -> Bool
f ([Element seq] -> [[Element seq]])
-> (seq -> [Element seq]) -> seq -> [[Element seq]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultSplitWhen #-}
vectorSortBy :: VG.Vector v e => (e -> e -> Ordering) -> v e -> v e
vectorSortBy :: (e -> e -> Ordering) -> v e -> v e
vectorSortBy e -> e -> Ordering
f = (forall s. Mutable v s e -> ST s ()) -> v e -> v e
forall (v :: * -> *) a.
Vector v a =>
(forall s. Mutable v s a -> ST s ()) -> v a -> v a
VG.modify ((e -> e -> Ordering) -> Mutable v (PrimState (ST s)) e -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VAM.sortBy e -> e -> Ordering
f)
{-# INLINE vectorSortBy #-}
vectorSort :: (VG.Vector v e, Ord e) => v e -> v e
vectorSort :: v e -> v e
vectorSort = (forall s. Mutable v s e -> ST s ()) -> v e -> v e
forall (v :: * -> *) a.
Vector v a =>
(forall s. Mutable v s a -> ST s ()) -> v a -> v a
VG.modify forall s. Mutable v s e -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
VAM.sort
{-# INLINE vectorSort #-}
defaultCons :: IsSequence seq => Element seq -> seq -> seq
defaultCons :: Element seq -> seq -> seq
defaultCons Element seq
e = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq
eElement seq -> [Element seq] -> [Element seq]
forall a. a -> [a] -> [a]
:) ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE defaultCons #-}
defaultSnoc :: IsSequence seq => seq -> Element seq -> seq
defaultSnoc :: seq -> Element seq -> seq
defaultSnoc seq
seq Element seq
e = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList (seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
seq [Element seq] -> [Element seq] -> [Element seq]
forall a. [a] -> [a] -> [a]
List.++ [Element seq
e])
{-# INLINE defaultSnoc #-}
tailDef :: IsSequence seq => seq -> seq
tailDef :: seq -> seq
tailDef seq
xs = case seq -> Maybe (Element seq, seq)
forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons seq
xs of
Maybe (Element seq, seq)
Nothing -> seq
forall a. Monoid a => a
mempty
Just (Element seq, seq)
tuple -> (Element seq, seq) -> seq
forall a b. (a, b) -> b
snd (Element seq, seq)
tuple
{-# INLINE tailDef #-}
initDef :: IsSequence seq => seq -> seq
initDef :: seq -> seq
initDef seq
xs = case seq -> Maybe (seq, Element seq)
forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc seq
xs of
Maybe (seq, Element seq)
Nothing -> seq
forall a. Monoid a => a
mempty
Just (seq, Element seq)
tuple -> (seq, Element seq) -> seq
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 = Element [a] -> [a] -> [a]
forall a. a -> [a] -> [a]
List.intersperse
reverse :: [a] -> [a]
reverse = [a] -> [a]
forall a. [a] -> [a]
List.reverse
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
List.find
sortBy :: (Element [a] -> Element [a] -> Ordering) -> [a] -> [a]
sortBy Element [a] -> Element [a] -> Ordering
f = Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> ([a] -> Vector 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
. (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element [a] -> Element [a] -> Ordering
Element (Vector a) -> Element (Vector a) -> Ordering
f (Vector a -> Vector a) -> ([a] -> Vector a) -> [a] -> Vector a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
cons :: Element [a] -> [a] -> [a]
cons = (:)
snoc :: [a] -> Element [a] -> [a]
snoc = [a] -> Element [a] -> [a]
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 = [Element [a]] -> [a]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
lengthIndex :: [a] -> Index [a]
lengthIndex = [a] -> Index [a]
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length
filter :: (Element [a] -> Bool) -> [a] -> [a]
filter = (Element [a] -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.filter
filterM :: (Element [a] -> m Bool) -> [a] -> m [a]
filterM = (Element [a] -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Control.Monad.filterM
break :: (Element [a] -> Bool) -> [a] -> ([a], [a])
break = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break
span :: (Element [a] -> Bool) -> [a] -> ([a], [a])
span = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span
dropWhile :: (Element [a] -> Bool) -> [a] -> [a]
dropWhile = (Element [a] -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile
takeWhile :: (Element [a] -> Bool) -> [a] -> [a]
takeWhile = (Element [a] -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile
splitAt :: Index [a] -> [a] -> ([a], [a])
splitAt = Index [a] -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
List.splitAt
take :: Index [a] -> [a] -> [a]
take = Index [a] -> [a] -> [a]
forall a. Int -> [a] -> [a]
List.take
drop :: Index [a] -> [a] -> [a]
drop = Index [a] -> [a] -> [a]
forall a. Int -> [a] -> [a]
List.drop
uncons :: [a] -> Maybe (Element [a], [a])
uncons [] = Maybe (Element [a], [a])
forall a. Maybe a
Nothing
uncons (a
x:[a]
xs) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs)
unsnoc :: [a] -> Maybe ([a], Element [a])
unsnoc [] = Maybe ([a], Element [a])
forall a. Maybe a
Nothing
unsnoc (a
x0:[a]
xs0) =
([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a] -> [a]) -> a -> [a] -> ([a], a)
forall a c. ([a] -> c) -> a -> [a] -> (c, a)
loop [a] -> [a]
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 ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) a
y [a]
z
partition :: (Element [a] -> Bool) -> [a] -> ([a], [a])
partition = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition
replicate :: Index [a] -> Element [a] -> [a]
replicate = Index [a] -> Element [a] -> [a]
forall a. Int -> a -> [a]
List.replicate
replicateM :: Index [a] -> m (Element [a]) -> m [a]
replicateM = Index [a] -> m (Element [a]) -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Control.Monad.replicateM
groupBy :: (Element [a] -> Element [a] -> Bool) -> [a] -> [[a]]
groupBy = (Element [a] -> Element [a] -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy
groupAllOn :: (Element [a] -> b) -> [a] -> [[a]]
groupAllOn Element [a] -> b
f (a
head : [a]
tail) =
(a
head a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
matches) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (Element [a] -> b) -> [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) = (Element [a] -> Bool) -> [a] -> ([a], [a])
forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
partition ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Element [a] -> b
f a
Element [a]
head) (b -> Bool) -> (a -> b) -> a -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
Element [a] -> b
f) [a]
tail
groupAllOn Element [a] -> b
_ [] = []
splitWhen :: (Element [a] -> Bool) -> [a] -> [[a]]
splitWhen = (Element [a] -> Bool) -> [a] -> [[a]]
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 = Element (NonEmpty a) -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse
reverse :: NonEmpty a -> NonEmpty a
reverse = NonEmpty a -> NonEmpty a
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 = (Element [a] -> Bool) -> [a] -> Maybe (Element [a])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find Element [a] -> Bool
Element (NonEmpty a) -> Bool
x ([a] -> Maybe a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Maybe a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList
cons :: Element (NonEmpty a) -> NonEmpty a -> NonEmpty a
cons = Element (NonEmpty a) -> NonEmpty a -> NonEmpty a
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 = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NE.fromList ([a] -> NonEmpty a) -> [a] -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ ([a] -> a -> [a]) -> a -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> a -> [a]
forall seq. SemiSequence seq => seq -> Element seq -> seq
snoc a
Element (NonEmpty a)
x ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
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 = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NE.fromList ([a] -> NonEmpty a)
-> (NonEmpty a -> [a]) -> NonEmpty a -> NonEmpty a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element [a] -> Element [a] -> Ordering) -> [a] -> [a]
forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element [a] -> Element [a] -> Ordering
Element (NonEmpty a) -> Element (NonEmpty a) -> Ordering
f ([a] -> [a]) -> (NonEmpty a -> [a]) -> NonEmpty a -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty a -> [a]
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
Element ByteString -> 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
(Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
S.find
cons :: Element ByteString -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
Element ByteString -> ByteString -> ByteString
S.cons
snoc :: ByteString -> Element ByteString -> ByteString
snoc = ByteString -> Word8 -> ByteString
ByteString -> Element ByteString -> ByteString
S.snoc
sortBy :: (Element ByteString -> Element ByteString -> Ordering)
-> ByteString -> ByteString
sortBy = (Element ByteString -> Element ByteString -> Ordering)
-> ByteString -> ByteString
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
[Element ByteString] -> ByteString
S.pack
lengthIndex :: ByteString -> Index ByteString
lengthIndex = ByteString -> Int
ByteString -> Index ByteString
S.length
replicate :: Index ByteString -> Element ByteString -> ByteString
replicate = Int -> Word8 -> ByteString
Index ByteString -> Element ByteString -> ByteString
S.replicate
filter :: (Element ByteString -> Bool) -> ByteString -> ByteString
filter = (Word8 -> Bool) -> ByteString -> ByteString
(Element ByteString -> Bool) -> ByteString -> ByteString
S.filter
break :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
break = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
(Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
S.break
span :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
span = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
(Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
S.span
dropWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
(Element ByteString -> Bool) -> ByteString -> ByteString
S.dropWhile
takeWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
(Element ByteString -> Bool) -> ByteString -> ByteString
S.takeWhile
splitAt :: Index ByteString -> ByteString -> (ByteString, ByteString)
splitAt = Int -> ByteString -> (ByteString, ByteString)
Index ByteString -> ByteString -> (ByteString, ByteString)
S.splitAt
take :: Index ByteString -> ByteString -> ByteString
take = Int -> ByteString -> ByteString
Index ByteString -> ByteString -> ByteString
S.take
unsafeTake :: Index ByteString -> ByteString -> ByteString
unsafeTake = Int -> ByteString -> ByteString
Index ByteString -> ByteString -> ByteString
SU.unsafeTake
drop :: Index ByteString -> ByteString -> ByteString
drop = Int -> ByteString -> ByteString
Index ByteString -> ByteString -> ByteString
S.drop
unsafeDrop :: Index ByteString -> ByteString -> ByteString
unsafeDrop = Int -> ByteString -> ByteString
Index ByteString -> ByteString -> ByteString
SU.unsafeDrop
partition :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
partition = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
(Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
S.partition
uncons :: ByteString -> Maybe (Element ByteString, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
ByteString -> Maybe (Element ByteString, ByteString)
S.uncons
unsnoc :: ByteString -> Maybe (ByteString, Element ByteString)
unsnoc ByteString
s
| ByteString -> Bool
S.null ByteString
s = Maybe (ByteString, Element ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = (ByteString, Word8) -> Maybe (ByteString, Word8)
forall a. a -> Maybe a
Just (ByteString -> ByteString
S.init ByteString
s, ByteString -> Word8
S.last ByteString
s)
groupBy :: (Element ByteString -> Element ByteString -> Bool)
-> ByteString -> [ByteString]
groupBy = (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
(Element ByteString -> Element ByteString -> Bool)
-> ByteString -> [ByteString]
S.groupBy
tailEx :: ByteString -> ByteString
tailEx = ByteString -> ByteString
S.tail
initEx :: ByteString -> ByteString
initEx = 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 Word8 -> Bool
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
| Int
Index ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
Index ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
S.length ByteString
bs = Maybe (Element ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (ByteString -> Int -> Word8
SU.unsafeIndex ByteString
bs Int
Index ByteString
i)
indexEx :: ByteString -> Index ByteString -> Element ByteString
indexEx = ByteString -> Int -> Word8
ByteString -> Index ByteString -> Element ByteString
S.index
unsafeIndex :: ByteString -> Index ByteString -> Element ByteString
unsafeIndex = ByteString -> Int -> Word8
ByteString -> Index ByteString -> Element ByteString
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
Element Text -> 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
(Element Text -> Bool) -> Text -> Maybe (Element Text)
T.find
cons :: Element Text -> Text -> Text
cons = Char -> Text -> Text
Element Text -> Text -> Text
T.cons
snoc :: Text -> Element Text -> Text
snoc = Text -> Char -> Text
Text -> Element Text -> Text
T.snoc
sortBy :: (Element Text -> Element Text -> Ordering) -> Text -> Text
sortBy = (Element Text -> Element Text -> Ordering) -> Text -> Text
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
[Element Text] -> Text
T.pack
lengthIndex :: Text -> Index Text
lengthIndex = Text -> Int
Text -> Index Text
T.length
replicate :: Index Text -> Element Text -> Text
replicate Index Text
i Element Text
c = Int -> Text -> Text
T.replicate Int
Index Text
i (Char -> Text
T.singleton Char
Element Text
c)
filter :: (Element Text -> Bool) -> Text -> Text
filter = (Char -> Bool) -> Text -> Text
(Element Text -> Bool) -> Text -> Text
T.filter
break :: (Element Text -> Bool) -> Text -> (Text, Text)
break = (Char -> Bool) -> Text -> (Text, Text)
(Element Text -> Bool) -> Text -> (Text, Text)
T.break
span :: (Element Text -> Bool) -> Text -> (Text, Text)
span = (Char -> Bool) -> Text -> (Text, Text)
(Element Text -> Bool) -> Text -> (Text, Text)
T.span
dropWhile :: (Element Text -> Bool) -> Text -> Text
dropWhile = (Char -> Bool) -> Text -> Text
(Element Text -> Bool) -> Text -> Text
T.dropWhile
takeWhile :: (Element Text -> Bool) -> Text -> Text
takeWhile = (Char -> Bool) -> Text -> Text
(Element Text -> Bool) -> Text -> Text
T.takeWhile
splitAt :: Index Text -> Text -> (Text, Text)
splitAt = Int -> Text -> (Text, Text)
Index Text -> Text -> (Text, Text)
T.splitAt
take :: Index Text -> Text -> Text
take = Int -> Text -> Text
Index Text -> Text -> Text
T.take
drop :: Index Text -> Text -> Text
drop = Int -> Text -> Text
Index Text -> Text -> Text
T.drop
dropEnd :: Index Text -> Text -> Text
dropEnd = Int -> Text -> Text
Index Text -> Text -> Text
T.dropEnd
partition :: (Element Text -> Bool) -> Text -> (Text, Text)
partition = (Char -> Bool) -> Text -> (Text, Text)
(Element Text -> Bool) -> Text -> (Text, Text)
T.partition
uncons :: Text -> Maybe (Element Text, Text)
uncons = Text -> Maybe (Char, Text)
Text -> Maybe (Element Text, Text)
T.uncons
unsnoc :: Text -> Maybe (Text, Element Text)
unsnoc Text
t
| Text -> Bool
T.null Text
t = Maybe (Text, Element Text)
forall a. Maybe a
Nothing
| Bool
otherwise = (Text, Char) -> Maybe (Text, Char)
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]
(Element Text -> Element Text -> 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]
(Element Text -> 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
| Int
Index Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
Index Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
t = Maybe (Element Text)
forall a. Maybe a
Nothing
| Bool
otherwise = Char -> Maybe Char
forall a. a -> Maybe a
Just (Text -> Int -> Char
T.index Text
t Int
Index Text
i)
indexEx :: Text -> Index Text -> Element Text
indexEx = Text -> Int -> Char
Text -> Index Text -> Element Text
T.index
unsafeIndex :: Text -> Index Text -> Element Text
unsafeIndex = Text -> Int -> Char
Text -> Index Text -> Element Text
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
Element ByteString -> 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
(Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
L.find
cons :: Element ByteString -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
Element ByteString -> ByteString -> ByteString
L.cons
snoc :: ByteString -> Element ByteString -> ByteString
snoc = ByteString -> Word8 -> ByteString
ByteString -> Element ByteString -> ByteString
L.snoc
sortBy :: (Element ByteString -> Element ByteString -> Ordering)
-> ByteString -> ByteString
sortBy = (Element ByteString -> Element ByteString -> Ordering)
-> ByteString -> ByteString
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
[Element ByteString] -> ByteString
L.pack
lengthIndex :: ByteString -> Index ByteString
lengthIndex = ByteString -> Int64
ByteString -> Index ByteString
L.length
replicate :: Index ByteString -> Element ByteString -> ByteString
replicate = Int64 -> Word8 -> ByteString
Index ByteString -> Element ByteString -> ByteString
L.replicate
filter :: (Element ByteString -> Bool) -> ByteString -> ByteString
filter = (Word8 -> Bool) -> ByteString -> ByteString
(Element ByteString -> Bool) -> ByteString -> ByteString
L.filter
break :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
break = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
(Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
L.break
span :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
span = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
(Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
L.span
dropWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
(Element ByteString -> Bool) -> ByteString -> ByteString
L.dropWhile
takeWhile :: (Element ByteString -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
(Element ByteString -> Bool) -> ByteString -> ByteString
L.takeWhile
splitAt :: Index ByteString -> ByteString -> (ByteString, ByteString)
splitAt = Int64 -> ByteString -> (ByteString, ByteString)
Index ByteString -> ByteString -> (ByteString, ByteString)
L.splitAt
take :: Index ByteString -> ByteString -> ByteString
take = Int64 -> ByteString -> ByteString
Index ByteString -> ByteString -> ByteString
L.take
drop :: Index ByteString -> ByteString -> ByteString
drop = Int64 -> ByteString -> ByteString
Index ByteString -> ByteString -> ByteString
L.drop
partition :: (Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
partition = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
(Element ByteString -> Bool)
-> ByteString -> (ByteString, ByteString)
L.partition
uncons :: ByteString -> Maybe (Element ByteString, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
ByteString -> Maybe (Element ByteString, ByteString)
L.uncons
unsnoc :: ByteString -> Maybe (ByteString, Element ByteString)
unsnoc ByteString
s
| ByteString -> Bool
L.null ByteString
s = Maybe (ByteString, Element ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = (ByteString, Word8) -> Maybe (ByteString, Word8)
forall a. a -> Maybe a
Just (ByteString -> ByteString
L.init ByteString
s, ByteString -> Word8
L.last ByteString
s)
groupBy :: (Element ByteString -> Element ByteString -> Bool)
-> ByteString -> [ByteString]
groupBy = (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
(Element ByteString -> Element ByteString -> Bool)
-> ByteString -> [ByteString]
L.groupBy
tailEx :: ByteString -> ByteString
tailEx = ByteString -> ByteString
L.tail
initEx :: ByteString -> ByteString
initEx = 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 Word8 -> Bool
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 = ByteString -> Int64 -> Word8
ByteString -> Index ByteString -> Element ByteString
L.index
unsafeIndex :: ByteString -> Index ByteString -> Element ByteString
unsafeIndex = ByteString -> Int64 -> Word8
ByteString -> Index ByteString -> Element ByteString
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
Element Text -> 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
(Element Text -> Bool) -> Text -> Maybe (Element Text)
TL.find
cons :: Element Text -> Text -> Text
cons = Char -> Text -> Text
Element Text -> Text -> Text
TL.cons
snoc :: Text -> Element Text -> Text
snoc = Text -> Char -> Text
Text -> Element Text -> Text
TL.snoc
sortBy :: (Element Text -> Element Text -> Ordering) -> Text -> Text
sortBy = (Element Text -> Element Text -> Ordering) -> Text -> Text
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
[Element Text] -> Text
TL.pack
lengthIndex :: Text -> Index Text
lengthIndex = Text -> Int64
Text -> Index Text
TL.length
replicate :: Index Text -> Element Text -> Text
replicate Index Text
i Element Text
c = Int64 -> Text -> Text
TL.replicate Int64
Index Text
i (Char -> Text
TL.singleton Char
Element Text
c)
filter :: (Element Text -> Bool) -> Text -> Text
filter = (Char -> Bool) -> Text -> Text
(Element Text -> Bool) -> Text -> Text
TL.filter
break :: (Element Text -> Bool) -> Text -> (Text, Text)
break = (Char -> Bool) -> Text -> (Text, Text)
(Element Text -> Bool) -> Text -> (Text, Text)
TL.break
span :: (Element Text -> Bool) -> Text -> (Text, Text)
span = (Char -> Bool) -> Text -> (Text, Text)
(Element Text -> Bool) -> Text -> (Text, Text)
TL.span
dropWhile :: (Element Text -> Bool) -> Text -> Text
dropWhile = (Char -> Bool) -> Text -> Text
(Element Text -> Bool) -> Text -> Text
TL.dropWhile
takeWhile :: (Element Text -> Bool) -> Text -> Text
takeWhile = (Char -> Bool) -> Text -> Text
(Element Text -> Bool) -> Text -> Text
TL.takeWhile
splitAt :: Index Text -> Text -> (Text, Text)
splitAt = Int64 -> Text -> (Text, Text)
Index Text -> Text -> (Text, Text)
TL.splitAt
take :: Index Text -> Text -> Text
take = Int64 -> Text -> Text
Index Text -> Text -> Text
TL.take
drop :: Index Text -> Text -> Text
drop = Int64 -> Text -> Text
Index Text -> Text -> Text
TL.drop
partition :: (Element Text -> Bool) -> Text -> (Text, Text)
partition = (Char -> Bool) -> Text -> (Text, Text)
(Element Text -> Bool) -> Text -> (Text, Text)
TL.partition
uncons :: Text -> Maybe (Element Text, Text)
uncons = Text -> Maybe (Char, Text)
Text -> Maybe (Element Text, Text)
TL.uncons
unsnoc :: Text -> Maybe (Text, Element Text)
unsnoc Text
t
| Text -> Bool
TL.null Text
t = Maybe (Text, Element Text)
forall a. Maybe a
Nothing
| Bool
otherwise = (Text, Char) -> Maybe (Text, Char)
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]
(Element Text -> Element Text -> 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]
(Element Text -> 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
Text -> Index Text -> Element Text
TL.index
unsafeIndex :: Text -> Index Text -> Element Text
unsafeIndex = Text -> Int64 -> Char
Text -> Index Text -> Element Text
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 = Element (Seq a) -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(Seq.<|)
snoc :: Seq a -> Element (Seq a) -> Seq a
snoc = Seq a -> Element (Seq a) -> Seq a
forall a. Seq a -> a -> Seq a
(Seq.|>)
reverse :: Seq a -> Seq a
reverse = Seq a -> Seq a
forall a. Seq a -> Seq a
Seq.reverse
sortBy :: (Element (Seq a) -> Element (Seq a) -> Ordering) -> Seq a -> Seq a
sortBy = (Element (Seq a) -> Element (Seq a) -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy
intersperse :: Element (Seq a) -> Seq a -> Seq a
intersperse = Element (Seq a) -> Seq a -> Seq a
forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
find :: (Element (Seq a) -> Bool) -> Seq a -> Maybe (Element (Seq a))
find = (Element (Seq a) -> Bool) -> Seq a -> Maybe (Element (Seq a))
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 = [Element (Seq a)] -> Seq a
forall a. [a] -> Seq a
Seq.fromList
lengthIndex :: Seq a -> Index (Seq a)
lengthIndex = Seq a -> Index (Seq a)
forall a. Seq a -> Int
Seq.length
replicate :: Index (Seq a) -> Element (Seq a) -> Seq a
replicate = Index (Seq a) -> Element (Seq a) -> Seq a
forall a. Int -> a -> Seq a
Seq.replicate
replicateM :: Index (Seq a) -> m (Element (Seq a)) -> m (Seq a)
replicateM = Index (Seq a) -> m (Element (Seq a)) -> m (Seq a)
forall (m :: * -> *) a. Applicative m => Int -> m a -> m (Seq a)
Seq.replicateM
filter :: (Element (Seq a) -> Bool) -> Seq a -> Seq a
filter = (Element (Seq a) -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter
break :: (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
break = (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl
span :: (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
span = (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl
dropWhile :: (Element (Seq a) -> Bool) -> Seq a -> Seq a
dropWhile = (Element (Seq a) -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL
takeWhile :: (Element (Seq a) -> Bool) -> Seq a -> Seq a
takeWhile = (Element (Seq a) -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL
splitAt :: Index (Seq a) -> Seq a -> (Seq a, Seq a)
splitAt = Index (Seq a) -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt
take :: Index (Seq a) -> Seq a -> Seq a
take = Index (Seq a) -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.take
drop :: Index (Seq a) -> Seq a -> Seq a
drop = Index (Seq a) -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop
partition :: (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
partition = (Element (Seq a) -> Bool) -> Seq a -> (Seq a, Seq a)
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 Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
s of
ViewL a
Seq.EmptyL -> Maybe (Element (Seq a), Seq a)
forall a. Maybe a
Nothing
a
x Seq.:< Seq a
xs -> (a, Seq a) -> Maybe (a, Seq a)
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 Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
s of
ViewR a
Seq.EmptyR -> Maybe (Seq a, Element (Seq a))
forall a. Maybe a
Nothing
Seq a
xs Seq.:> a
x -> (Seq a, a) -> Maybe (Seq a, a)
forall a. a -> Maybe a
Just (Seq a
xs, a
x)
tailEx :: Seq a -> Seq a
tailEx = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1
initEx :: Seq a -> Seq a
initEx Seq a
xs = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.take (Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
xs Int -> Int -> Int
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 = Seq a -> Index (Seq a) -> Maybe (Element (Seq a))
forall a. Seq a -> Int -> Maybe a
(Seq.!?)
indexEx :: Seq a -> Index (Seq a) -> Element (Seq a)
indexEx = Seq a -> Index (Seq a) -> Element (Seq a)
forall a. Seq a -> Int -> a
Seq.index
unsafeIndex :: Seq a -> Index (Seq a) -> Element (Seq a)
unsafeIndex = Seq a -> Index (Seq a) -> Element (Seq a)
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 = Vector a -> Vector a
forall a. Vector a -> Vector a
V.reverse
find :: (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
find = (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find
cons :: Element (Vector a) -> Vector a -> Vector a
cons = Element (Vector a) -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons
snoc :: Vector a -> Element (Vector a) -> Vector a
snoc = Vector a -> Element (Vector a) -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc
sortBy :: (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
sortBy = (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
forall (v :: * -> *) e.
Vector v e =>
(e -> e -> Ordering) -> v e -> v e
vectorSortBy
intersperse :: Element (Vector a) -> Vector a -> Vector a
intersperse = Element (Vector a) -> Vector a -> Vector a
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 = [Element (Vector a)] -> Vector a
forall a. [a] -> Vector a
V.fromList
lengthIndex :: Vector a -> Index (Vector a)
lengthIndex = Vector a -> Index (Vector a)
forall a. Vector a -> Int
V.length
replicate :: Index (Vector a) -> Element (Vector a) -> Vector a
replicate = Index (Vector a) -> Element (Vector a) -> Vector a
forall a. Int -> a -> Vector a
V.replicate
replicateM :: Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
replicateM = Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM
filter :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
filter = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter
filterM :: (Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
filterM = (Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.break
span :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
span = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.span
dropWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
dropWhile = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.dropWhile
takeWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
takeWhile = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile
splitAt :: Index (Vector a) -> Vector a -> (Vector a, Vector a)
splitAt = Index (Vector a) -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt
take :: Index (Vector a) -> Vector a -> Vector a
take = Index (Vector a) -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take
drop :: Index (Vector a) -> Vector a -> Vector a
drop = Index (Vector a) -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop
unsafeTake :: Index (Vector a) -> Vector a -> Vector a
unsafeTake = Index (Vector a) -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.unsafeTake
unsafeDrop :: Index (Vector a) -> Vector a -> Vector a
unsafeDrop = Index (Vector a) -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.unsafeDrop
partition :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
partition = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
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
| Vector a -> Bool
forall a. Vector a -> Bool
V.null Vector a
v = Maybe (Element (Vector a), Vector a)
forall a. Maybe a
Nothing
| Bool
otherwise = (a, Vector a) -> Maybe (a, Vector a)
forall a. a -> Maybe a
Just (Vector a -> a
forall a. Vector a -> a
V.head Vector a
v, Vector a -> Vector a
forall a. Vector a -> Vector a
V.tail Vector a
v)
unsnoc :: Vector a -> Maybe (Vector a, Element (Vector a))
unsnoc Vector a
v
| Vector a -> Bool
forall a. Vector a -> Bool
V.null Vector a
v = Maybe (Vector a, Element (Vector a))
forall a. Maybe a
Nothing
| Bool
otherwise = (Vector a, a) -> Maybe (Vector a, a)
forall a. a -> Maybe a
Just (Vector a -> Vector a
forall a. Vector a -> Vector a
V.init Vector a
v, Vector a -> a
forall a. Vector a -> a
V.last Vector a
v)
tailEx :: Vector a -> Vector a
tailEx = Vector a -> Vector a
forall a. Vector a -> Vector a
V.tail
initEx :: Vector a -> Vector a
initEx = Vector a -> Vector a
forall a. Vector a -> Vector a
V.init
unsafeTail :: Vector a -> Vector a
unsafeTail = Vector a -> Vector a
forall a. Vector a -> Vector a
V.unsafeTail
unsafeInit :: Vector a -> Vector a
unsafeInit = Vector a -> Vector a
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 = Vector a -> Index (Vector a) -> Maybe (Element (Vector a))
forall a. Vector a -> Int -> Maybe a
(V.!?)
indexEx :: Vector a -> Index (Vector a) -> Element (Vector a)
indexEx = Vector a -> Index (Vector a) -> Element (Vector a)
forall a. Vector a -> Int -> a
(V.!)
unsafeIndex :: Vector a -> Index (Vector a) -> Element (Vector a)
unsafeIndex = Vector a -> Index (Vector a) -> Element (Vector a)
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 = Element (Vector a) -> Vector a -> Vector a
forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
reverse :: Vector a -> Vector a
reverse = Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
U.reverse
find :: (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
find = (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe a
U.find
cons :: Element (Vector a) -> Vector a -> Vector a
cons = Element (Vector a) -> Vector a -> Vector a
forall a. Unbox a => a -> Vector a -> Vector a
U.cons
snoc :: Vector a -> Element (Vector a) -> Vector a
snoc = Vector a -> Element (Vector a) -> Vector a
forall a. Unbox a => Vector a -> a -> Vector a
U.snoc
sortBy :: (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
sortBy = (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
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 = [Element (Vector a)] -> Vector a
forall a. Unbox a => [a] -> Vector a
U.fromList
lengthIndex :: Vector a -> Index (Vector a)
lengthIndex = Vector a -> Index (Vector a)
forall a. Unbox a => Vector a -> Int
U.length
replicate :: Index (Vector a) -> Element (Vector a) -> Vector a
replicate = Index (Vector a) -> Element (Vector a) -> Vector a
forall a. Unbox a => Int -> a -> Vector a
U.replicate
replicateM :: Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
replicateM = Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.filter
filterM :: (Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
filterM = (Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
forall a.
Unbox a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
U.span
dropWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
dropWhile = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.dropWhile
takeWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
takeWhile = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.takeWhile
splitAt :: Index (Vector a) -> Vector a -> (Vector a, Vector a)
splitAt = Index (Vector a) -> Vector a -> (Vector a, Vector a)
forall a. Unbox a => Int -> Vector a -> (Vector a, Vector a)
U.splitAt
take :: Index (Vector a) -> Vector a -> Vector a
take = Index (Vector a) -> Vector a -> Vector a
forall a. Unbox a => Int -> Vector a -> Vector a
U.take
drop :: Index (Vector a) -> Vector a -> Vector a
drop = Index (Vector a) -> Vector a -> Vector a
forall a. Unbox a => Int -> Vector a -> Vector a
U.drop
unsafeTake :: Index (Vector a) -> Vector a -> Vector a
unsafeTake = Index (Vector a) -> Vector a -> Vector a
forall a. Unbox a => Int -> Vector a -> Vector a
U.unsafeTake
unsafeDrop :: Index (Vector a) -> Vector a -> Vector a
unsafeDrop = Index (Vector a) -> Vector a -> Vector a
forall a. Unbox a => Int -> Vector a -> Vector a
U.unsafeDrop
partition :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
partition = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
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
| Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector a
v = Maybe (Element (Vector a), Vector a)
forall a. Maybe a
Nothing
| Bool
otherwise = (a, Vector a) -> Maybe (a, Vector a)
forall a. a -> Maybe a
Just (Vector a -> a
forall a. Unbox a => Vector a -> a
U.head Vector a
v, Vector a -> Vector a
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
| Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector a
v = Maybe (Vector a, Element (Vector a))
forall a. Maybe a
Nothing
| Bool
otherwise = (Vector a, a) -> Maybe (Vector a, a)
forall a. a -> Maybe a
Just (Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
U.init Vector a
v, Vector a -> a
forall a. Unbox a => Vector a -> a
U.last Vector a
v)
tailEx :: Vector a -> Vector a
tailEx = Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
U.tail
initEx :: Vector a -> Vector a
initEx = Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
U.init
unsafeTail :: Vector a -> Vector a
unsafeTail = Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
U.unsafeTail
unsafeInit :: Vector a -> Vector a
unsafeInit = Vector a -> Vector a
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 = Vector a -> Index (Vector a) -> Maybe (Element (Vector a))
forall a. Unbox a => Vector a -> Int -> Maybe a
(U.!?)
indexEx :: Vector a -> Index (Vector a) -> Element (Vector a)
indexEx = Vector a -> Index (Vector a) -> Element (Vector a)
forall a. Unbox a => Vector a -> Int -> a
(U.!)
unsafeIndex :: Vector a -> Index (Vector a) -> Element (Vector a)
unsafeIndex = Vector a -> Index (Vector a) -> Element (Vector a)
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 = Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
VS.reverse
find :: (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
find = (Element (Vector a) -> Bool)
-> Vector a -> Maybe (Element (Vector a))
forall a. Storable a => (a -> Bool) -> Vector a -> Maybe a
VS.find
cons :: Element (Vector a) -> Vector a -> Vector a
cons = Element (Vector a) -> Vector a -> Vector a
forall a. Storable a => a -> Vector a -> Vector a
VS.cons
snoc :: Vector a -> Element (Vector a) -> Vector a
snoc = Vector a -> Element (Vector a) -> Vector a
forall a. Storable a => Vector a -> a -> Vector a
VS.snoc
intersperse :: Element (Vector a) -> Vector a -> Vector a
intersperse = Element (Vector a) -> Vector a -> Vector a
forall seq. IsSequence seq => Element seq -> seq -> seq
defaultIntersperse
sortBy :: (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
sortBy = (Element (Vector a) -> Element (Vector a) -> Ordering)
-> Vector a -> Vector a
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 = [Element (Vector a)] -> Vector a
forall a. Storable a => [a] -> Vector a
VS.fromList
lengthIndex :: Vector a -> Index (Vector a)
lengthIndex = Vector a -> Index (Vector a)
forall a. Storable a => Vector a -> Int
VS.length
replicate :: Index (Vector a) -> Element (Vector a) -> Vector a
replicate = Index (Vector a) -> Element (Vector a) -> Vector a
forall a. Storable a => Int -> a -> Vector a
VS.replicate
replicateM :: Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
replicateM = Index (Vector a) -> m (Element (Vector a)) -> m (Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.filter
filterM :: (Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
filterM = (Element (Vector a) -> m Bool) -> Vector a -> m (Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
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 = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
VS.span
dropWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
dropWhile = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.dropWhile
takeWhile :: (Element (Vector a) -> Bool) -> Vector a -> Vector a
takeWhile = (Element (Vector a) -> Bool) -> Vector a -> Vector a
forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.takeWhile
splitAt :: Index (Vector a) -> Vector a -> (Vector a, Vector a)
splitAt = Index (Vector a) -> Vector a -> (Vector a, Vector a)
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
VS.splitAt
take :: Index (Vector a) -> Vector a -> Vector a
take = Index (Vector a) -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
VS.take
drop :: Index (Vector a) -> Vector a -> Vector a
drop = Index (Vector a) -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
VS.drop
unsafeTake :: Index (Vector a) -> Vector a -> Vector a
unsafeTake = Index (Vector a) -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
VS.unsafeTake
unsafeDrop :: Index (Vector a) -> Vector a -> Vector a
unsafeDrop = Index (Vector a) -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
VS.unsafeDrop
partition :: (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
partition = (Element (Vector a) -> Bool) -> Vector a -> (Vector a, Vector a)
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
| Vector a -> Bool
forall a. Storable a => Vector a -> Bool
VS.null Vector a
v = Maybe (Element (Vector a), Vector a)
forall a. Maybe a
Nothing
| Bool
otherwise = (a, Vector a) -> Maybe (a, Vector a)
forall a. a -> Maybe a
Just (Vector a -> a
forall a. Storable a => Vector a -> a
VS.head Vector a
v, Vector a -> Vector a
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
| Vector a -> Bool
forall a. Storable a => Vector a -> Bool
VS.null Vector a
v = Maybe (Vector a, Element (Vector a))
forall a. Maybe a
Nothing
| Bool
otherwise = (Vector a, a) -> Maybe (Vector a, a)
forall a. a -> Maybe a
Just (Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
VS.init Vector a
v, Vector a -> a
forall a. Storable a => Vector a -> a
VS.last Vector a
v)
tailEx :: Vector a -> Vector a
tailEx = Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
VS.tail
initEx :: Vector a -> Vector a
initEx = Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
VS.init
unsafeTail :: Vector a -> Vector a
unsafeTail = Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
VS.unsafeTail
unsafeInit :: Vector a -> Vector a
unsafeInit = Vector a -> Vector a
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 = Vector a -> Index (Vector a) -> Maybe (Element (Vector a))
forall a. Storable a => Vector a -> Int -> Maybe a
(VS.!?)
indexEx :: Vector a -> Index (Vector a) -> Element (Vector a)
indexEx = Vector a -> Index (Vector a) -> Element (Vector a)
forall a. Storable a => Vector a -> Int -> a
(VS.!)
unsafeIndex :: Vector a -> Index (Vector a) -> Element (Vector a)
unsafeIndex = Vector a -> Index (Vector a) -> Element (Vector a)
forall a. Storable a => Vector a -> Int -> a
VS.unsafeIndex
{-# INLINE index #-}
{-# INLINE indexEx #-}
{-# INLINE unsafeIndex #-}
splitElem :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> [seq]
splitElem :: Element seq -> seq -> [seq]
splitElem Element seq
x = (Element seq -> Bool) -> seq -> [seq]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> [seq]
splitWhen (Element seq -> Element seq -> Bool
forall a. Eq a => a -> a -> Bool
== Element seq
x)
splitSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> [seq]
splitSeq :: seq -> seq -> [seq]
splitSeq seq
sep = ([Element seq] -> seq) -> [[Element seq]] -> [seq]
forall a b. (a -> b) -> [a] -> [b]
List.map [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([[Element seq]] -> [seq])
-> (seq -> [[Element seq]]) -> seq -> [seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Element seq] -> [Element seq] -> [[Element seq]]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn (seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
sep) ([Element seq] -> [[Element seq]])
-> (seq -> [Element seq]) -> seq -> [[Element seq]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
replaceSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq -> seq
replaceSeq :: seq -> seq -> seq -> seq
replaceSeq seq
old seq
new = Element [seq] -> [seq] -> Element [seq]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
ointercalate seq
Element [seq]
new ([seq] -> seq) -> (seq -> [seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> seq -> [seq]
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> [seq]
splitSeq seq
old
stripPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq
stripPrefix :: seq -> seq -> Maybe seq
stripPrefix seq
x seq
y = ([Element seq] -> seq) -> Maybe [Element seq] -> Maybe seq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList (seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x [Element seq] -> [Element seq] -> Maybe [Element seq]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`List.stripPrefix` seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y)
stripSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq
stripSuffix :: seq -> seq -> Maybe seq
stripSuffix seq
x seq
y =
([Element seq] -> seq) -> Maybe [Element seq] -> Maybe seq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList (seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x [Element seq] -> [Element seq] -> Maybe [Element seq]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripSuffixList` seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y)
where
stripSuffixList :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffixList :: [a] -> [a] -> Maybe [a]
stripSuffixList [a]
x' [a]
y' = ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall seq. SemiSequence seq => seq -> seq
reverse ([a] -> [a] -> Maybe [a]
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripPrefix ([a] -> [a]
forall seq. SemiSequence seq => seq -> seq
reverse [a]
x') ([a] -> [a]
forall seq. SemiSequence seq => seq -> seq
reverse [a]
y'))
dropPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq
dropPrefix :: seq -> seq -> seq
dropPrefix seq
x seq
y = seq -> Maybe seq -> seq
forall a. a -> Maybe a -> a
fromMaybe seq
y (seq -> seq -> Maybe seq
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripPrefix seq
x seq
y)
dropSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq
dropSuffix :: seq -> seq -> seq
dropSuffix seq
x seq
y = seq -> Maybe seq -> seq
forall a. a -> Maybe a -> a
fromMaybe seq
y (seq -> seq -> Maybe seq
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripSuffix seq
x seq
y)
ensurePrefix :: (Eq (Element seq), IsSequence seq) => seq -> seq -> seq
ensurePrefix :: seq -> seq -> seq
ensurePrefix seq
prefix seq
seq = if seq -> seq -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isPrefixOf seq
prefix seq
seq then seq
seq else seq
prefix seq -> seq -> seq
forall a. Semigroup a => a -> a -> a
<> seq
seq
ensureSuffix :: (Eq (Element seq), IsSequence seq) => seq -> seq -> seq
ensureSuffix :: seq -> seq -> seq
ensureSuffix seq
suffix seq
seq = if seq -> seq -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isSuffixOf seq
suffix seq
seq then seq
seq else seq
seq seq -> seq -> seq
forall a. Semigroup a => a -> a -> a
<> seq
suffix
isPrefixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool
isPrefixOf :: seq -> seq -> Bool
isPrefixOf seq
x seq
y = seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x [Element seq] -> [Element seq] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y
isSuffixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool
isSuffixOf :: seq -> seq -> Bool
isSuffixOf seq
x seq
y = seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x [Element seq] -> [Element seq] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y
isInfixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool
isInfixOf :: seq -> seq -> Bool
isInfixOf seq
x seq
y = seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
x [Element seq] -> [Element seq] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` seq -> [Element seq]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList seq
y
group :: (IsSequence seq, Eq (Element seq)) => seq -> [seq]
group :: seq -> [seq]
group = (Element seq -> Element seq -> Bool) -> seq -> [seq]
forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Bool) -> seq -> [seq]
groupBy Element seq -> Element seq -> Bool
forall a. Eq a => a -> a -> Bool
(==)
groupAll :: (IsSequence seq, Eq (Element seq)) => seq -> [seq]
groupAll :: seq -> [seq]
groupAll = (Element seq -> Element seq) -> seq -> [seq]
forall seq b.
(IsSequence seq, Eq b) =>
(Element seq -> b) -> seq -> [seq]
groupAllOn Element seq -> Element seq
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
delete :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> seq
delete :: Element seq -> seq -> seq
delete = (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
forall seq.
(IsSequence seq, Eq (Element seq)) =>
(Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
deleteBy Element seq -> Element seq -> Bool
forall a. Eq a => a -> a -> Bool
(==)
deleteBy :: (IsSequence seq, Eq (Element seq)) => (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
deleteBy :: (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq
deleteBy Element seq -> Element seq -> Bool
eq Element seq
x = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element seq] -> seq) -> (seq -> [Element seq]) -> seq -> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> Element seq -> Bool)
-> Element seq -> [Element seq] -> [Element seq]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy Element seq -> Element seq -> Bool
eq Element seq
x ([Element seq] -> [Element seq])
-> (seq -> [Element seq]) -> seq -> [Element seq]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Element seq]
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 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
x) ByteString
y)
| Bool
otherwise = Maybe ByteString
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 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
x) ByteString
y)
| Bool
otherwise = Maybe ByteString
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 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
L.drop (ByteString -> Int64
L.length ByteString
x) ByteString
y)
| Bool
otherwise = Maybe ByteString
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 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
L.take (ByteString -> Int64
L.length ByteString
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
L.length ByteString
x) ByteString
y)
| Bool
otherwise = Maybe ByteString
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 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Text) -> [Char] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Text
forall mono. MonoPointed mono => Element mono -> mono
singleton ([Char] -> [Text]) -> (Text -> [Char]) -> Text -> [Text]
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 ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
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 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Text) -> [Char] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Text
forall mono. MonoPointed mono => Element mono -> mono
singleton ([Char] -> [Text]) -> (Text -> [Char]) -> Text -> [Text]
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 ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
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 :: (SemiSequence seq, Ord (Element seq)) => seq -> seq
sort :: seq -> seq
sort = (Element seq -> Element seq -> Ordering) -> seq -> seq
forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element seq -> Element seq -> Ordering
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 #-}
class (IsSequence t, IsString t, Element t ~ Char) => Textual t where
words :: t -> [t]
unwords :: (Element seq ~ t, MonoFoldable seq) => seq -> t
lines :: t -> [t]
unlines :: (Element seq ~ t, MonoFoldable seq) => seq -> t
toLower :: t -> t
toUpper :: t -> t
toCaseFold :: t -> t
breakWord :: t -> (t, t)
breakWord = (t -> t) -> (t, t) -> (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Element t -> Bool) -> t -> t
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
dropWhile Char -> Bool
Element t -> Bool
isSpace) ((t, t) -> (t, t)) -> (t -> (t, t)) -> t -> (t, t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element t -> Bool) -> t -> (t, t)
forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
break Char -> Bool
Element t -> Bool
isSpace
{-# INLINE breakWord #-}
breakLine :: t -> (t, t)
breakLine =
(t -> t
forall p. (IsSequence p, Element p ~ Char) => p -> p
killCR (t -> t) -> (t -> t) -> (t, t) -> (t, t)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Index t -> t -> t
forall seq. IsSequence seq => Index seq -> seq -> seq
drop Index t
1) ((t, t) -> (t, t)) -> (t -> (t, t)) -> t -> (t, t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element t -> Bool) -> t -> (t, t)
forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
where
killCR :: p -> p
killCR p
t =
case p -> Maybe (p, Element p)
forall seq. IsSequence seq => seq -> Maybe (seq, Element seq)
unsnoc p
t of
Just (p
t', Element p
'\r') -> p
t'
Maybe (p, Element p)
_ -> p
t
instance (c ~ Char) => Textual [c] where
words :: [c] -> [[c]]
words = [c] -> [[c]]
[Char] -> [[Char]]
List.words
unwords :: seq -> [c]
unwords = [[Char]] -> [Char]
List.unwords ([[Char]] -> [Char]) -> (seq -> [[Char]]) -> seq -> [Char]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [[Char]]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
lines :: [c] -> [[c]]
lines = [c] -> [[c]]
[Char] -> [[Char]]
List.lines
unlines :: seq -> [c]
unlines = [[Char]] -> [Char]
List.unlines ([[Char]] -> [Char]) -> (seq -> [[Char]]) -> seq -> [Char]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [[Char]]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
toLower :: [c] -> [c]
toLower = Text -> [Char]
TL.unpack (Text -> [Char]) -> ([Char] -> Text) -> [Char] -> [Char]
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 (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
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 (Text -> [Char]) -> ([Char] -> Text) -> [Char] -> [Char]
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 (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
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 (Text -> [Char]) -> ([Char] -> Text) -> [Char] -> [Char]
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 (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
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 :: seq -> Text
unwords = [Text] -> Text
T.unwords ([Text] -> Text) -> (seq -> [Text]) -> seq -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
lines :: Text -> [Text]
lines = Text -> [Text]
T.lines
unlines :: seq -> Text
unlines = [Text] -> Text
T.unlines ([Text] -> Text) -> (seq -> [Text]) -> seq -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Text]
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 :: seq -> Text
unwords = [Text] -> Text
TL.unwords ([Text] -> Text) -> (seq -> [Text]) -> seq -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
lines :: Text -> [Text]
lines = Text -> [Text]
TL.lines
unlines :: seq -> Text
unlines = [Text] -> Text
TL.unlines ([Text] -> Text) -> (seq -> [Text]) -> seq -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seq -> [Text]
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 #-}
catMaybes :: (IsSequence (f (Maybe t)), Functor f,
Element (f (Maybe t)) ~ Maybe t)
=> f (Maybe t) -> f t
catMaybes :: f (Maybe t) -> f t
catMaybes = (Maybe t -> t) -> f (Maybe t) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe t -> t
forall a. HasCallStack => Maybe a -> a
fromJust (f (Maybe t) -> f t)
-> (f (Maybe t) -> f (Maybe t)) -> f (Maybe t) -> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element (f (Maybe t)) -> Bool) -> f (Maybe t) -> f (Maybe t)
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter Element (f (Maybe t)) -> Bool
forall a. Maybe a -> Bool
isJust
sortOn :: (Ord o, SemiSequence seq) => (Element seq -> o) -> seq -> seq
sortOn :: (Element seq -> o) -> seq -> seq
sortOn = (Element seq -> Element seq -> Ordering) -> seq -> seq
forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy ((Element seq -> Element seq -> Ordering) -> seq -> seq)
-> ((Element seq -> o) -> Element seq -> Element seq -> Ordering)
-> (Element seq -> o)
-> seq
-> seq
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element seq -> o) -> Element seq -> Element seq -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing
{-# INLINE sortOn #-}
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 ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
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 ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> [ByteString]
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
pack :: IsSequence seq => [Element seq] -> seq
pack :: [Element seq] -> seq
pack = [Element seq] -> seq
forall seq. IsSequence seq => [Element seq] -> seq
fromList
{-# INLINE pack #-}
unpack :: MonoFoldable mono => mono -> [Element mono]
unpack :: mono -> [Element mono]
unpack = mono -> [Element mono]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
{-# INLINE unpack #-}
repack :: (MonoFoldable a, IsSequence b, Element a ~ Element b) => a -> b
repack :: a -> b
repack = [Element b] -> b
forall seq. IsSequence seq => [Element seq] -> seq
pack ([Element b] -> b) -> (a -> [Element b]) -> a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> [Element b]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack
class (Textual textual, IsSequence binary) => Utf8 textual binary | textual -> binary, binary -> textual where
encodeUtf8 :: textual -> binary
decodeUtf8 :: binary -> textual
instance (c ~ Char, w ~ Word8) => Utf8 [c] [w] where
encodeUtf8 :: [c] -> [w]
encodeUtf8 = ByteString -> [Word8]
L.unpack (ByteString -> [Word8])
-> ([Char] -> ByteString) -> [Char] -> [Word8]
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 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
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 (Text -> [Char]) -> ([Word8] -> Text) -> [Word8] -> [Char]
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 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
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