-- | Generic strings using backed by a contiguous array of unboxed characters.
module MCSP.Data.String (
    -- * Unboxed string
    String (.., Unboxed, Null, NonNull, Head, Last, Singleton, (:<), (:>), (:<:), (:>:)),
    Unbox,

    -- ** Text IO
    module MCSP.Data.String.Text,

    -- * Accessors

    -- ** Length information
    length,
    null,

    -- ** Indexing
    (!),
    (!?),
    head,
    last,
    unsafeIndex,
    single,
    indexM,
    headM,
    lastM,

    -- ** Substrings (slicing)
    slice,
    init,
    tail,
    take,
    drop,
    splitAt,
    uncons,
    unsnoc,
    unsafeSlice,

    -- * Construction

    -- ** Initialisation
    empty,
    singleton,
    replicate,
    generate,

    -- ** Monadic initialisation
    replicateM,
    generateM,
    create,

    -- ** Unfolding
    unfoldr,
    unfoldrExactN,
    unfoldrM,
    unfoldrExactNM,

    -- ** Enumeration
    enumFromN,
    enumFromStepN,

    -- ** Concatenation
    cons,
    snoc,
    (++),
    concat,
    concatNE,

    -- ** Restricting memory usage
    force,

    -- * Modifying vectors

    -- ** Bulk updates
    (//),
    update,

    -- ** Accumulations
    accum,
    accumulate,

    -- ** Permutations
    reverse,
    backpermute,

    -- ** Safe destructive updates
    modify,

    -- * Elementwise operations

    -- ** Indexing
    indexed,

    -- ** Mapping
    map,
    map_,
    imap,
    imap_,
    concatMap,
    concatMap_,
    mapM,
    mapM_,
    forM,
    iforM,

    -- ** Zipping
    zipWith,
    zipWith3,
    zip,
    zip3,
    zipWithM,
    zipWithM_,
    unzip,
    unzip3,

    -- * Working with predicates

    -- ** Filtering
    filter,
    ifilter,
    filterM,
    uniq,
    mapMaybe,
    mapMaybeM,
    takeWhile,
    dropWhile,

    -- ** Partitioning
    partition,
    partitionWith,
    unstablePartition,
    span,
    break,
    groupBy,
    group,

    -- ** Searching
    elem,
    notElem,
    find,
    findIndex,
    findIndexR,
    findIndices,
    elemIndex,
    elemIndices,

    -- * Utilities
    eqBy,
    cmpBy,
    convert,
) where

import Control.Applicative (Alternative, (<$>))
import Control.Applicative qualified as Applicative (empty)
import Control.Arrow ((&&&))
import Control.DeepSeq (NFData (..), NFData1 (..))
import Control.Monad (Monad)
import Control.Monad.ST (ST)
import Data.Bool (Bool (..), otherwise, (&&))
import Data.Char (Char)
import Data.Data (Typeable)
import Data.Either (Either)
import Data.Eq (Eq (..))
import Data.Foldable qualified as Foldable (Foldable (..))
import Data.Function (id, (.))
import Data.Int (Int)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid (..))
import Data.Ord (Ord (..), Ordering)
import Data.Semigroup (Semigroup (..))
import Data.String (IsString (..))
import Data.Type.Equality (type (~))
import Data.Word (Word8)
import GHC.Base (undefined, ($!))
import GHC.IsList (IsList (..))
import GHC.Num (Num, (-))
import Text.ParserCombinators.ReadPrec (lift)
import Text.Read (Read (..))
import Text.Show (Show (..))

import Data.Vector.Generic qualified as Generic
import Data.Vector.Generic.Mutable qualified as Mutable
import Data.Vector.Unboxed (MVector, Unbox, Vector)

import MCSP.Data.String.Text

-- --------------- --
-- Data definition --
-- --------------- --

-- | An unboxed string of characters @a@.
--
-- Implemented as a contiguous vector of unboxed characters.
data String a
    = -- | Construct a string from a unboxed vector.
      --
      -- Note that `Unbox` is only required for constructing the string. All other operations should
      -- be possible without that constraint.
      Unbox a => String !(Vector a)
    deriving newtype (Typeable)

{-# COMPLETE Unboxed #-}
{-# COMPLETE Null, NonNull #-}
{-# COMPLETE Null, Head #-}
{-# COMPLETE Null, Last #-}
{-# COMPLETE Null, (:<) #-}
{-# COMPLETE Null, (:>) #-}
{-# COMPLETE Null, (:<:) #-}
{-# COMPLETE Null, (:>:) #-}

-- | Proves `Unbox` from an already constructed string.
--
-- This pattern is useful for matching in operations where @Unbox a@ is required.
--
-- >>> import GHC.Base (asTypeOf)
-- >>> emptyLike s = asTypeOf empty s
-- >>> :t emptyLike
-- emptyLike :: Unbox a => String a -> String a
--
-- >>> emptyLike' s@Unboxed = asTypeOf empty s
-- >>> :t emptyLike'
-- emptyLike' :: String a -> String a
pattern Unboxed :: () => Unbox a => String a
pattern $mUnboxed :: forall {r} {a}. String a -> (Unbox a => r) -> ((# #) -> r) -> r
Unboxed <- (id -> String _)
{-# INLINE CONLIKE Unboxed #-}

-- | /O(1)/ Matches the `empty` string.
--
-- >>> [s | s@Null <- ["", "a", "ab", "", "abc"]]
-- [,]
pattern Null :: () => Unbox a => String a
pattern $mNull :: forall {r} {a}. String a -> (Unbox a => r) -> ((# #) -> r) -> r
Null <- (null &&& id -> (True, Unboxed))
{-# INLINE CONLIKE Null #-}

-- | /O(1)/ Matches any non-`empty` string.
--
-- >>> [s | NonNull s <- ["", "a", "ab", "", "abc"]]
-- [a,ab,abc]
pattern NonNull :: () => Unbox a => String a -> String a
pattern $mNonNull :: forall {r} {a}.
String a -> (Unbox a => String a -> r) -> ((# #) -> r) -> r
$bNonNull :: forall a. Unbox a => String a -> String a
NonNull s <- (null &&& id -> (False, s@Unboxed))
    where
        NonNull = String a -> String a
forall a. a -> a
id
{-# INLINE CONLIKE NonNull #-}

-- | /O(1)/ Matches the first character in a string.
--
-- >>> [c | Head c <- ["", "a", "ab", "", "abc"]]
-- "aaa"
pattern Head :: () => Unbox a => a -> String a
pattern $mHead :: forall {r} {a}.
String a -> (Unbox a => a -> r) -> ((# #) -> r) -> r
Head c <- (headM &&& id -> (Just c, Unboxed))
{-# INLINE CONLIKE Head #-}

-- | /O(1)/ Matches the last character in a string.
--
-- >>> [c | Last c <- ["", "a", "ab", "", "abc"]]
-- "abc"
pattern Last :: () => Unbox a => a -> String a
pattern $mLast :: forall {r} {a}.
String a -> (Unbox a => a -> r) -> ((# #) -> r) -> r
Last c <- (lastM &&& id -> (Just c, Unboxed))
{-# INLINE CONLIKE Last #-}

-- | /O(1)/ Matches a string composed of a single character.
--
-- >>> [c | Singleton c <- ["", "a", "ab", "", "abc"]]
-- "a"
pattern Singleton :: () => Unbox a => a -> String a
pattern $mSingleton :: forall {r} {a}.
String a -> (Unbox a => a -> r) -> ((# #) -> r) -> r
Singleton c <- (single &&& id -> (Just c, Unboxed))
{-# INLINE CONLIKE Singleton #-}

-- | /O(1)/ Matches `head` and `tail` of a string, if present.
--
-- >>> [(h,t) | h :< t <- ["", "a", "ab", "", "abc"]]
-- [('a',),('a',b),('a',bc)]
pattern (:<) :: () => Unbox a => a -> String a -> String a
pattern x $m:< :: forall {r} {a}.
String a -> (Unbox a => a -> String a -> r) -> ((# #) -> r) -> r
$b:< :: forall a. Unbox a => a -> String a -> String a
:< xs <- (uncons -> Just (x, xs@Unboxed))
    where
        a
x :< String a
xs = a -> String a -> String a
forall a. a -> String a -> String a
cons a
x String a
xs
{-# INLINE CONLIKE (:<) #-}

-- | /O(1)/ Matches `init` and `last` of a string, if present.
--
-- >>> [(i,l) | i :> l <- ["", "a", "ab", "", "abc"]]
-- [(,'a'),(a,'b'),(ab,'c')]
pattern (:>) :: () => Unbox a => String a -> a -> String a
pattern xs $m:> :: forall {r} {a}.
String a -> (Unbox a => String a -> a -> r) -> ((# #) -> r) -> r
$b:> :: forall a. Unbox a => String a -> a -> String a
:> x <- (unsnoc -> Just (xs@Unboxed, x))
    where
        String a
xs :> a
x = String a -> a -> String a
forall a. String a -> a -> String a
snoc String a
xs a
x
{-# INLINE CONLIKE (:>) #-}

-- | /O(1)/ Stringified `:<`, matching `head` and `tail`.
--
-- >>> [(h,t) | h :<: t <- ["", "a", "ab", "", "abc"]]
-- [(a,),(a,b),(a,bc)]
pattern (:<:) :: () => Unbox a => String a -> String a -> String a
pattern x $m:<: :: forall {r} {a}.
String a
-> (Unbox a => String a -> String a -> r) -> ((# #) -> r) -> r
:<: xs <- (splitAtHead -> Just (x@Unboxed, xs))
{-# INLINE CONLIKE (:<:) #-}

-- | /O(1)/ Stringified `:>`, matching `init` and `last`.
--
-- >>> [(i,l) | i :>: l <- ["", "a", "ab", "", "abc"]]
-- [(,a),(a,b),(ab,c)]
pattern (:>:) :: () => Unbox a => String a -> String a -> String a
pattern xs $m:>: :: forall {r} {a}.
String a
-> (Unbox a => String a -> String a -> r) -> ((# #) -> r) -> r
:>: x <- (splitAtLast -> Just (xs, x@Unboxed))
{-# INLINE CONLIKE (:>:) #-}

-- -------------------------- --
-- Pattern matching functions --
-- -------------------------- --

-- | (INTERNAL) /O(1)/ Stringified version of `uncons`.
--
-- >>> splitAtHead "acgt"
-- Just (a,cgt)
splitAtHead :: String a -> Maybe (String a, String a)
splitAtHead :: forall a. String a -> Maybe (String a, String a)
splitAtHead s :: String a
s@String a
Unboxed
    -- SAFETY: n > 0 guarantees head (0 .. 1) and tail (1 .. n) are present
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (String a, String a) -> Maybe (String a, String a)
forall a. a -> Maybe a
Just (Int -> Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
Generic.unsafeSlice Int
0 Int
1 String a
s, Int -> Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
Generic.unsafeSlice Int
1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String a
s)
    | Bool
otherwise = Maybe (String a, String a)
forall a. Maybe a
Nothing
  where
    n :: Int
n = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length (String a -> Int) -> String a -> Int
forall a b. (a -> b) -> a -> b
$! String a
s
{-# INLINE splitAtHead #-}

-- | (INTERNAL) /O(1)/ Stringified version of `unsnoc`.
--
-- >>> splitAtLast "acgt"
-- Just (acg,t)
splitAtLast :: String a -> Maybe (String a, String a)
splitAtLast :: forall a. String a -> Maybe (String a, String a)
splitAtLast s :: String a
s@String a
Unboxed
    -- SAFETY: n > 0 guarantees init (0 .. n-1) and last (n-1 .. n) are present
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (String a, String a) -> Maybe (String a, String a)
forall a. a -> Maybe a
Just (Int -> Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
Generic.unsafeSlice Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String a
s, Int -> Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
Generic.unsafeSlice (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1 String a
s)
    | Bool
otherwise = Maybe (String a, String a)
forall a. Maybe a
Nothing
  where
    n :: Int
n = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length (String a -> Int) -> String a -> Int
forall a b. (a -> b) -> a -> b
$! String a
s
{-# INLINE splitAtLast #-}

-- ----------------------------------- --
-- List-like and String-like instances --
-- ----------------------------------- --

instance Eq a => Eq (String a) where
    {-# SPECIALIZE instance Eq (String Char) #-}
    {-# SPECIALIZE instance Eq (String Int) #-}
    {-# SPECIALIZE instance Eq (String Word8) #-}
    (String Vector a
lhs) == :: String a -> String a -> Bool
== (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
rhs
    {-# INLINE (==) #-}
    (String Vector a
lhs) /= :: String a -> String a -> Bool
/= (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector a
rhs
    {-# INLINE (/=) #-}

instance Ord a => Ord (String a) where
    {-# SPECIALIZE instance Ord (String Char) #-}
    {-# SPECIALIZE instance Ord (String Int) #-}
    {-# SPECIALIZE instance Ord (String Word8) #-}
    (String Vector a
lhs) compare :: String a -> String a -> Ordering
`compare` (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Vector a
rhs
    {-# INLINE compare #-}
    (String Vector a
lhs) < :: String a -> String a -> Bool
< (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a
rhs
    {-# INLINE (<) #-}
    (String Vector a
lhs) <= :: String a -> String a -> Bool
<= (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Bool
forall a. Ord a => a -> a -> Bool
<= Vector a
rhs
    {-# INLINE (<=) #-}
    (String Vector a
lhs) > :: String a -> String a -> Bool
> (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a
rhs
    {-# INLINE (>) #-}
    (String Vector a
lhs) >= :: String a -> String a -> Bool
>= (String Vector a
rhs) = Vector a
lhs Vector a -> Vector a -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector a
rhs
    {-# INLINE (>=) #-}
    max :: String a -> String a -> String a
max (String Vector a
lhs) (String Vector a
rhs) = Vector a -> String a
forall a. Unbox a => Vector a -> String a
String (Vector a -> Vector a -> Vector a
forall a. Ord a => a -> a -> a
max Vector a
lhs Vector a
rhs)
    {-# INLINE max #-}
    min :: String a -> String a -> String a
min (String Vector a
lhs) (String Vector a
rhs) = Vector a -> String a
forall a. Unbox a => Vector a -> String a
String (Vector a -> Vector a -> Vector a
forall a. Ord a => a -> a -> a
min Vector a
lhs Vector a
rhs)
    {-# INLINE min #-}

instance Unbox a => IsList (String a) where
    {-# SPECIALIZE instance IsList (String Char) #-}
    {-# SPECIALIZE instance IsList (String Int) #-}
    {-# SPECIALIZE instance IsList (String Word8) #-}
    type Item (String a) = a
    fromList :: [Item (String a)] -> String a
fromList = [a] -> String a
[Item (String a)] -> String a
forall (v :: * -> *) a. Vector v a => [a] -> v a
Generic.fromList
    {-# INLINE fromList #-}
    fromListN :: Int -> [Item (String a)] -> String a
fromListN = Int -> [a] -> String a
Int -> [Item (String a)] -> String a
forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
Generic.fromListN
    {-# INLINE fromListN #-}
    toList :: String a -> [Item (String a)]
toList = String a -> [a]
String a -> [Item (String a)]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Generic.toList
    {-# INLINE toList #-}

-- | `String` `Char` can be written using `Prelude.String` syntax (@"abcd"@).
instance a ~ Char => IsString (String a) where
    {-# SPECIALIZE instance IsString (String Char) #-}
    fromString :: String -> String a
fromString = String -> String a
[Item (String a)] -> String a
forall l. IsList l => [Item l] -> l
fromList
    {-# INLINE fromString #-}

instance Foldable.Foldable String where
    fold :: forall m. Monoid m => String m -> m
fold s :: String m
s@String m
Unboxed = (m -> m) -> String m -> m
forall m (v :: * -> *) a.
(Monoid m, Vector v a) =>
(a -> m) -> v a -> m
Generic.foldMap m -> m
forall a. a -> a
id String m
s
    {-# INLINE fold #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> String a -> m
foldMap a -> m
f s :: String a
s@String a
Unboxed = (a -> m) -> String a -> m
forall m (v :: * -> *) a.
(Monoid m, Vector v a) =>
(a -> m) -> v a -> m
Generic.foldMap a -> m
f String a
s
    {-# INLINE foldMap #-}
    foldMap' :: forall m a. Monoid m => (a -> m) -> String a -> m
foldMap' a -> m
f s :: String a
s@String a
Unboxed = (a -> m) -> String a -> m
forall m (v :: * -> *) a.
(Monoid m, Vector v a) =>
(a -> m) -> v a -> m
Generic.foldMap' a -> m
f String a
s
    {-# INLINE foldMap' #-}
    foldr :: forall a b. (a -> b -> b) -> b -> String a -> b
foldr a -> b -> b
f b
x s :: String a
s@String a
Unboxed = (a -> b -> b) -> b -> String a -> b
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
Generic.foldr a -> b -> b
f b
x String a
s
    {-# INLINE foldr #-}
    foldr' :: forall a b. (a -> b -> b) -> b -> String a -> b
foldr' a -> b -> b
f b
x s :: String a
s@String a
Unboxed = (a -> b -> b) -> b -> String a -> b
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
Generic.foldr' a -> b -> b
f b
x String a
s
    {-# INLINE foldr' #-}
    foldl :: forall b a. (b -> a -> b) -> b -> String a -> b
foldl b -> a -> b
f b
x s :: String a
s@String a
Unboxed = (b -> a -> b) -> b -> String a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
Generic.foldl b -> a -> b
f b
x String a
s
    {-# INLINE foldl #-}
    foldl' :: forall b a. (b -> a -> b) -> b -> String a -> b
foldl' b -> a -> b
f b
x s :: String a
s@String a
Unboxed = (b -> a -> b) -> b -> String a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
Generic.foldl' b -> a -> b
f b
x String a
s
    {-# INLINE foldl' #-}
    foldr1 :: forall a. (a -> a -> a) -> String a -> a
foldr1 a -> a -> a
f s :: String a
s@String a
Unboxed = (a -> a -> a) -> String a -> a
forall (v :: * -> *) a. Vector v a => (a -> a -> a) -> v a -> a
Generic.foldr1 a -> a -> a
f String a
s
    {-# INLINE foldr1 #-}
    foldl1 :: forall a. (a -> a -> a) -> String a -> a
foldl1 a -> a -> a
f s :: String a
s@String a
Unboxed = (a -> a -> a) -> String a -> a
forall (v :: * -> *) a. Vector v a => (a -> a -> a) -> v a -> a
Generic.foldl1 a -> a -> a
f String a
s
    {-# INLINE foldl1 #-}
    toList :: forall a. String a -> [a]
toList s :: String a
s@String a
Unboxed = String a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Generic.toList String a
s
    {-# INLINE toList #-}
    null :: forall a. String a -> Bool
null = String a -> Bool
forall a. String a -> Bool
null
    {-# INLINE null #-}
    length :: forall a. String a -> Int
length = String a -> Int
forall a. String a -> Int
length
    {-# INLINE length #-}
    elem :: forall a. Eq a => a -> String a -> Bool
elem a
x s :: String a
s@String a
Unboxed = a -> String a -> Bool
forall (v :: * -> *) a. (Vector v a, Eq a) => a -> v a -> Bool
Generic.elem a
x String a
s
    {-# INLINE elem #-}
    maximum :: forall a. Ord a => String a -> a
maximum s :: String a
s@String a
Unboxed = String a -> a
forall (v :: * -> *) a. (Vector v a, Ord a) => v a -> a
Generic.maximum String a
s
    {-# INLINE maximum #-}
    minimum :: forall a. Ord a => String a -> a
minimum s :: String a
s@String a
Unboxed = String a -> a
forall (v :: * -> *) a. (Vector v a, Ord a) => v a -> a
Generic.minimum String a
s
    {-# INLINE minimum #-}
    sum :: forall a. Num a => String a -> a
sum s :: String a
s@String a
Unboxed = String a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
Generic.sum String a
s
    {-# INLINE sum #-}
    product :: forall a. Num a => String a -> a
product s :: String a
s@String a
Unboxed = String a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
Generic.product String a
s
    {-# INLINE product #-}

-- | `Semigroup` based on concatenation (@"a" <> "b" == "ab"@).
instance Semigroup (String a) where
    {-# SPECIALIZE instance Semigroup (String Char) #-}
    {-# SPECIALIZE instance Semigroup (String Int) #-}
    {-# SPECIALIZE instance Semigroup (String Word8) #-}
    <> :: String a -> String a -> String a
(<>) = String a -> String a -> String a
forall a. String a -> String a -> String a
(++)
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty (String a) -> String a
sconcat = NonEmpty (String a) -> String a
forall a. NonEmpty (String a) -> String a
concatNE
    {-# INLINE sconcat #-}

-- | `Monoid` based on concatenation (@mempty == ""@).
instance Unbox a => Monoid (String a) where
    {-# SPECIALIZE instance Monoid (String Char) #-}
    {-# SPECIALIZE instance Monoid (String Int) #-}
    {-# SPECIALIZE instance Monoid (String Word8) #-}
    mempty :: String a
mempty = String a
forall (v :: * -> *) a. Vector v a => v a
Generic.empty
    {-# INLINE mempty #-}
    mconcat :: [String a] -> String a
mconcat = [String a] -> String a
forall a. Unbox a => [String a] -> String a
concat
    {-# INLINE mconcat #-}

-- ---------------------- --
-- Textual Input / Output --
-- ---------------------- --

instance ShowString a => Show (String a) where
    {-# SPECIALIZE instance Show (String Char) #-}
    {-# SPECIALIZE instance Show (String Int) #-}
    {-# SPECIALIZE instance Show (String Word8) #-}
    showsPrec :: Int -> String a -> ShowS
showsPrec Int
_ = String a -> ShowS
forall a (f :: * -> *). (ShowString a, Foldable f) => f a -> ShowS
forall (f :: * -> *). Foldable f => f a -> ShowS
showStr
    {-# INLINE showsPrec #-}

instance (Unbox a, ReadString a) => Read (String a) where
    {-# SPECIALIZE instance Read (String Char) #-}
    {-# SPECIALIZE instance Read (String Int) #-}
    {-# SPECIALIZE instance Read (String Word8) #-}
    readPrec :: ReadPrec (String a)
readPrec = ReadP (String a) -> ReadPrec (String a)
forall a. ReadP a -> ReadPrec a
lift ([a] -> String a
[Item (String a)] -> String a
forall l. IsList l => [Item l] -> l
fromList ([a] -> String a) -> ReadP [a] -> ReadP (String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP [a]
forall a. ReadString a => ReadP [a]
readStr)
    {-# INLINE readPrec #-}

-- -------------------- --
-- Evaluation (DeepSeq) --

instance NFData (String a) where
    {-# SPECIALIZE instance NFData (String Char) #-}
    {-# SPECIALIZE instance NFData (String Int) #-}
    {-# SPECIALIZE instance NFData (String Word8) #-}
    rnf :: String a -> ()
rnf (String Vector a
v) = Vector a -> ()
forall a. NFData a => a -> ()
rnf Vector a
v
    {-# INLINE rnf #-}

instance NFData1 String where
    liftRnf :: forall a. (a -> ()) -> String a -> ()
liftRnf a -> ()
seq (String Vector a
v) = (a -> ()) -> Vector a -> ()
forall a. (a -> ()) -> Vector a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
seq Vector a
v
    {-# INLINE liftRnf #-}

-- --------------------------------- --
-- Generic Vector instance and types --
-- --------------------------------- --

-- | Mutable variant of `String`, so that it can implement the `Generic Vector` interface.
newtype MString s a = MString {forall s a. MString s a -> MVector s a
mContents :: MVector s a}

instance Unbox a => Mutable.MVector MString a where
    {-# SPECIALIZE instance Mutable.MVector MString Char #-}
    {-# SPECIALIZE instance Mutable.MVector MString Int #-}
    {-# SPECIALIZE instance Mutable.MVector MString Word8 #-}
    basicLength :: forall s. MString s a -> Int
basicLength (MString MVector s a
v) = MVector s a -> Int
forall s. MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
Mutable.basicLength MVector s a
v
    {-# INLINE basicLength #-}
    basicUnsafeSlice :: forall s. Int -> Int -> MString s a -> MString s a
basicUnsafeSlice Int
s Int
n (MString MVector s a
v) = MVector s a -> MString s a
forall s a. MVector s a -> MString s a
MString (Int -> Int -> MVector s a -> MVector s a
forall s. Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
Mutable.basicUnsafeSlice Int
s Int
n MVector s a
v)
    {-# INLINE basicUnsafeSlice #-}
    basicOverlaps :: forall s. MString s a -> MString s a -> Bool
basicOverlaps (MString MVector s a
lhs) (MString MVector s a
rhs) = MVector s a -> MVector s a -> Bool
forall s. MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
Mutable.basicOverlaps MVector s a
lhs MVector s a
rhs
    {-# INLINE basicOverlaps #-}
    basicUnsafeNew :: forall s. Int -> ST s (MString s a)
basicUnsafeNew Int
n = MVector s a -> MString s a
forall s a. MVector s a -> MString s a
MString (MVector s a -> MString s a)
-> ST s (MVector s a) -> ST s (MString s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s a)
forall s. Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
Mutable.basicUnsafeNew Int
n
    {-# INLINE basicUnsafeNew #-}
    basicInitialize :: forall s. MString s a -> ST s ()
basicInitialize (MString MVector s a
v) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
Mutable.basicInitialize MVector s a
v
    {-# INLINE basicInitialize #-}
    basicUnsafeReplicate :: forall s. Int -> a -> ST s (MString s a)
basicUnsafeReplicate Int
n a
x = MVector s a -> MString s a
forall s a. MVector s a -> MString s a
MString (MVector s a -> MString s a)
-> ST s (MVector s a) -> ST s (MString s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> ST s (MVector s a)
forall s. Int -> a -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
Mutable.basicUnsafeReplicate Int
n a
x
    {-# INLINE basicUnsafeReplicate #-}
    basicUnsafeRead :: forall s. MString s a -> Int -> ST s a
basicUnsafeRead (MString MVector s a
v) = MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
Mutable.basicUnsafeRead MVector s a
v
    {-# INLINE basicUnsafeRead #-}
    basicUnsafeWrite :: forall s. MString s a -> Int -> a -> ST s ()
basicUnsafeWrite (MString MVector s a
v) = MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
Mutable.basicUnsafeWrite MVector s a
v
    {-# INLINE basicUnsafeWrite #-}
    basicClear :: forall s. MString s a -> ST s ()
basicClear (MString MVector s a
v) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
Mutable.basicClear MVector s a
v
    {-# INLINE basicClear #-}
    basicSet :: forall s. MString s a -> a -> ST s ()
basicSet (MString MVector s a
v) = MVector s a -> a -> ST s ()
forall s. MVector s a -> a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
Mutable.basicSet MVector s a
v
    {-# INLINE basicSet #-}
    basicUnsafeCopy :: forall s. MString s a -> MString s a -> ST s ()
basicUnsafeCopy (MString MVector s a
tgt) (MString MVector s a
src) = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
Mutable.basicUnsafeCopy MVector s a
tgt MVector s a
src
    {-# INLINE basicUnsafeCopy #-}
    basicUnsafeMove :: forall s. MString s a -> MString s a -> ST s ()
basicUnsafeMove (MString MVector s a
tgt) (MString MVector s a
src) = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
Mutable.basicUnsafeMove MVector s a
tgt MVector s a
src
    {-# INLINE basicUnsafeMove #-}
    basicUnsafeGrow :: forall s. MString s a -> Int -> ST s (MString s a)
basicUnsafeGrow (MString MVector s a
v) Int
n = MVector s a -> MString s a
forall s a. MVector s a -> MString s a
MString (MVector s a -> MString s a)
-> ST s (MVector s a) -> ST s (MString s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s a -> Int -> ST s (MVector s a)
forall s. MVector s a -> Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
Mutable.basicUnsafeGrow MVector s a
v Int
n
    {-# INLINE basicUnsafeGrow #-}

type instance Generic.Mutable String = MString

instance Unbox a => Generic.Vector String a where
    {-# SPECIALIZE instance Generic.Vector String Char #-}
    {-# SPECIALIZE instance Generic.Vector String Int #-}
    {-# SPECIALIZE instance Generic.Vector String Word8 #-}
    basicUnsafeFreeze :: forall s. Mutable String s a -> ST s (String a)
basicUnsafeFreeze (MString MVector s a
v) = Vector a -> String a
forall a. Unbox a => Vector a -> String a
String (Vector a -> String a) -> ST s (Vector a) -> ST s (String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s a -> ST s (Vector a)
forall s. Mutable Vector s a -> ST s (Vector a)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
Generic.basicUnsafeFreeze Mutable Vector s a
MVector s a
v
    {-# INLINE basicUnsafeFreeze #-}
    basicUnsafeThaw :: forall s. String a -> ST s (Mutable String s a)
basicUnsafeThaw (String Vector a
v) = MVector s a -> MString s a
forall s a. MVector s a -> MString s a
MString (MVector s a -> MString s a)
-> ST s (MVector s a) -> ST s (MString s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> ST s (Mutable Vector s a)
forall s. Vector a -> ST s (Mutable Vector s a)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
Generic.basicUnsafeThaw Vector a
v
    {-# INLINE basicUnsafeThaw #-}
    basicLength :: String a -> Int
basicLength (String Vector a
v) = Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.basicLength Vector a
v
    {-# INLINE basicLength #-}
    basicUnsafeSlice :: Int -> Int -> String a -> String a
basicUnsafeSlice Int
s Int
n (String Vector a
v) = Vector a -> String a
forall a. Unbox a => Vector a -> String a
String (Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
Generic.basicUnsafeSlice Int
s Int
n Vector a
v)
    {-# INLINE basicUnsafeSlice #-}
    basicUnsafeIndexM :: String a -> Int -> Box a
basicUnsafeIndexM (String Vector a
v) = Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
Generic.basicUnsafeIndexM Vector a
v
    {-# INLINE basicUnsafeIndexM #-}
    basicUnsafeCopy :: forall s. Mutable String s a -> String a -> ST s ()
basicUnsafeCopy (MString MVector s a
mv) (String Vector a
v) = Mutable Vector s a -> Vector a -> ST s ()
forall s. Mutable Vector s a -> Vector a -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
Generic.basicUnsafeCopy Mutable Vector s a
MVector s a
mv Vector a
v
    {-# INLINE basicUnsafeCopy #-}
    elemseq :: forall b. String a -> a -> b -> b
elemseq String a
_ = forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
Generic.elemseq @Vector Vector a
forall a. HasCallStack => a
undefined
    {-# INLINE elemseq #-}

-- --------------------------------------- --
-- Operations with lifted Unbox constraint --
-- --------------------------------------- --

-- ------------------ --
-- Length information --

-- | /O(1)/ Yield the length of the string.
length :: String a -> Int
length :: forall a. String a -> Int
length s :: String a
s@String a
Unboxed = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length String a
s

-- | /O(1)/ Test whether a string is empty.
null :: String a -> Bool
null :: forall a. String a -> Bool
null s :: String a
s@String a
Unboxed = String a -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
Generic.null String a
s

-- -------- --
-- Indexing --

-- | /O(1)/ Indexing.
--
-- >>> "abc" ! 1
-- 'b'
(!) :: String a -> Int -> a
s :: String a
s@String a
Unboxed ! :: forall a. String a -> Int -> a
! Int
i = String a
s String a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Generic.! Int
i
{-# INLINE (!) #-}

-- | /O(1)/ Safe indexing.
--
-- >>> "abc" !? 1
-- Just 'b'
--
-- >>> "abc" !? 3
-- Nothing
(!?) :: String a -> Int -> Maybe a
s :: String a
s@String a
Unboxed !? :: forall a. String a -> Int -> Maybe a
!? Int
i = String a
s String a -> Int -> Maybe a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
Generic.!? Int
i
{-# INLINE (!?) #-}

-- | /O(1)/ First character.
--
-- >>> head "hello"
-- 'h'
head :: String a -> a
head :: forall a. String a -> a
head s :: String a
s@String a
Unboxed = String a -> a
forall (v :: * -> *) a. Vector v a => v a -> a
Generic.head String a
s
{-# INLINE head #-}

-- | /O(1)/ Last character.
--
-- >>> last "hello"
-- 'o'
last :: String a -> a
last :: forall a. String a -> a
last s :: String a
s@String a
Unboxed = String a -> a
forall (v :: * -> *) a. Vector v a => v a -> a
Generic.last String a
s
{-# INLINE last #-}

-- | /O(1)/ Unsafe indexing without bounds checking.
unsafeIndex :: String a -> Int -> a
unsafeIndex :: forall a. String a -> Int -> a
unsafeIndex s :: String a
s@String a
Unboxed = String a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Generic.unsafeIndex String a
s
{-# INLINE unsafeIndex #-}

-- | /O(1)/ The character of a singleton string.
--
-- >>> single ""
-- Nothing
--
-- >>> single "x"
-- Just 'x'
--
-- >>> single "xy"
-- Nothing
single :: String a -> Maybe a
single :: forall a. String a -> Maybe a
single s :: String a
s@String a
Unboxed
    -- SAFETY: string with n == 1 has a character at index 0
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String a -> Int -> Maybe a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
Generic.unsafeIndexM String a
s Int
0
    | Bool
otherwise = Maybe a
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
  where
    n :: Int
n = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length (String a -> Int) -> String a -> Int
forall a b. (a -> b) -> a -> b
$! String a
s
{-# INLINE single #-}

-- | /O(1)/ Indexing in a monad.
--
-- See [Data.Vactor.Unbox](https://hackage.haskell.org/package/vector-0.13.0.0/docs/Data-Vector-Unboxed.html#v:indexM).
--
-- >>> indexM @Maybe "xyz" 5
-- Nothing
indexM :: (Alternative m, Monad m) => String a -> Int -> m a
indexM :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
String a -> Int -> m a
indexM s :: String a
s@String a
Unboxed Int
i
    -- SAFETY: index i was checked manually
    | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = String a -> Int -> m a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
Generic.unsafeIndexM String a
s Int
i
    | Bool
otherwise = m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
  where
    n :: Int
n = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length (String a -> Int) -> String a -> Int
forall a b. (a -> b) -> a -> b
$! String a
s
{-# INLINE indexM #-}

-- | /O(1)/ First character of a string in a monad.
--
-- See [Data.Vactor.Unbox](https://hackage.haskell.org/package/vector-0.13.0.0/docs/Data-Vector-Unboxed.html#v:indexM).
--
-- >>> headM @Maybe ""
-- Nothing
headM :: (Alternative m, Monad m) => String a -> m a
headM :: forall (m :: * -> *) a. (Alternative m, Monad m) => String a -> m a
headM s :: String a
s@String a
Unboxed
    -- SAFETY: index 0 was checked manually
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = String a -> Int -> m a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
Generic.unsafeIndexM String a
s Int
0
    | Bool
otherwise = m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
  where
    n :: Int
n = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length (String a -> Int) -> String a -> Int
forall a b. (a -> b) -> a -> b
$! String a
s
{-# INLINE headM #-}

-- | /O(1)/ Last character of a string in a monad.
--
-- See [Data.Vactor.Unbox](https://hackage.haskell.org/package/vector-0.13.0.0/docs/Data-Vector-Unboxed.html#v:indexM).
--
-- >>> lastM @Maybe ""
-- Nothing
lastM :: (Alternative m, Monad m) => String a -> m a
lastM :: forall (m :: * -> *) a. (Alternative m, Monad m) => String a -> m a
lastM s :: String a
s@String a
Unboxed
    -- SAFETY: positive n implies n-1 is a valid index
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = String a -> Int -> m a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
Generic.unsafeIndexM String a
s (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    | Bool
otherwise = m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
  where
    n :: Int
n = String a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length (String a -> Int) -> String a -> Int
forall a b. (a -> b) -> a -> b
$! String a
s
{-# INLINE lastM #-}

-- -------------------- --
-- Substrings (slicing) --

-- | /O(1)/ Yield the slice `s[i:i+n]` of the string without copying it.
--
-- The string must contain at least `i+n` characters.
--
-- >>> slice 2 3 "genome"
-- nom
slice :: Int -> Int -> String a -> String a
slice :: forall a. Int -> Int -> String a -> String a
slice Int
i Int
n s :: String a
s@String a
Unboxed = Int -> Int -> String a -> String a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
Generic.slice Int
i Int
n String a
s
{-# INLINE slice #-}

-- | /O(1)/ Yield all but the last character without copying.
--
-- The string may not be empty.
--
-- >>> init "genome"
-- genom
init :: String a -> String a
init :: forall a. String a -> String a
init s :: String a
s@String a
Unboxed = String a -> String a
forall (v :: * -> *) a. Vector v a => v a -> v a
Generic.init String a
s
{-# INLINE init #-}

-- | /O(1)/ Yield all but the first character without copying.
--
-- The string may not be empty.
--
-- >>> tail "genome"
-- enome
tail :: String a -> String a
tail :: forall a. String a -> String a
tail s :: String a
s@String a
Unboxed = String a -> String a
forall (v :: * -> *) a. Vector v a => v a -> v a
Generic.tail String a
s
{-# INLINE tail #-}

-- | /O(1)/ Yield at the first @n@ characters without copying.
--
-- The string may contain less than @n@ characters, in which case it is returned unchanged.
--
-- >>> take 2 "hello"
-- he
--
-- >>> take 10 "hello"
-- hello
take :: Int -> String a -> String a
take :: forall a. Int -> String a -> String a
take Int
n s :: String a
s@String a
Unboxed = Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Generic.take Int
n String a
s
{-# INLINE take #-}

-- | /O(1)/ Yield all but the first @n@ characters without copying.
--
-- The string may contain less than @n@ characters, in which case an empty string is returned.
--
-- >>> drop 2 "hello"
-- llo
--
-- >>> drop 10 "hello"
-- <BLANKLINE>
drop :: Int -> String a -> String a
drop :: forall a. Int -> String a -> String a
drop Int
n s :: String a
s@String a
Unboxed = Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Generic.drop Int
n String a
s
{-# INLINE drop #-}

-- | /O(1)/ Yield the first @n@ characters paired with the remainder, without copying.
--
-- Note that `splitAt n s` is equivalent to `(take n s, drop n s)`, but slightly more efficient.
--
-- >>> splitAt 6 "babushka"
-- (babush,ka)
splitAt :: Int -> String a -> (String a, String a)
splitAt :: forall a. Int -> String a -> (String a, String a)
splitAt Int
n s :: String a
s@String a
Unboxed = Int -> String a -> (String a, String a)
forall (v :: * -> *) a. Vector v a => Int -> v a -> (v a, v a)
Generic.splitAt Int
n String a
s
{-# INLINE splitAt #-}

-- | /O(1)/ Yield the `head` and `tail` of the string, or `Nothing` if it is empty.
--
-- >>> uncons "acgt"
-- Just ('a',cgt)
uncons :: String a -> Maybe (a, String a)
uncons :: forall a. String a -> Maybe (a, String a)
uncons s :: String a
s@String a
Unboxed = String a -> Maybe (a, String a)
forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
Generic.uncons String a
s
{-# INLINE uncons #-}

-- | /O(1)/ Yield the `init` and `last` of the string, or `Nothing` if it is empty.
--
-- >>> unsnoc "acgt"
-- Just (acg,'t')
unsnoc :: String a -> Maybe (String a, a)
unsnoc :: forall a. String a -> Maybe (String a, a)
unsnoc s :: String a
s@String a
Unboxed = String a -> Maybe (String a, a)
forall (v :: * -> *) a. Vector v a => v a -> Maybe (v a, a)
Generic.unsnoc String a
s
{-# INLINE unsnoc #-}

-- | /O(1)/ Yield a slice of the string without copying.
--
-- The string must contain at least `i+n` characters, but this is not checked.
unsafeSlice :: Int -> Int -> String a -> String a
unsafeSlice :: forall a. Int -> Int -> String a -> String a
unsafeSlice Int
i Int
n s :: String a
s@String a
Unboxed = Int -> Int -> String a -> String a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
Generic.unsafeSlice Int
i Int
n String a
s
{-# INLINE unsafeSlice #-}

-- -------------- --
-- Initialisation --

-- | /O(1)/ The empty string.
--
-- >>> empty == ""
-- True
empty :: Unbox a => String a
empty :: forall a. Unbox a => String a
empty = String a
forall (v :: * -> *) a. Vector v a => v a
Generic.empty
{-# INLINE empty #-}

-- | /O(1)/ A string with exactly one character.
--
-- >>> singleton 's'
-- s
singleton :: Unbox a => a -> String a
singleton :: forall a. Unbox a => a -> String a
singleton = a -> String a
forall (v :: * -> *) a. Vector v a => a -> v a
Generic.singleton
{-# INLINE singleton #-}

-- | /O(n)/ A string of the given length with the same character in each position.
--
-- >>> replicate 10 'a'
-- aaaaaaaaaa
replicate :: Unbox a => Int -> a -> String a
replicate :: forall a. Unbox a => Int -> a -> String a
replicate = Int -> a -> String a
forall (v :: * -> *) a. Vector v a => Int -> a -> v a
Generic.replicate
{-# INLINE replicate #-}

-- | /O(n)/ Construct a string of the given length by applying the function to each index.
--
-- >>> import Prelude (head, show)
-- >>> generate 5 (\i -> Prelude.head (show i))
-- 01234
generate :: Unbox a => Int -> (Int -> a) -> String a
generate :: forall a. Unbox a => Int -> (Int -> a) -> String a
generate = Int -> (Int -> a) -> String a
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Generic.generate
{-# INLINE generate #-}

-- ---------------------- --
-- Monadic initialisation --

-- | /O(n)/ Execute the monadic action the given number of times and store the results in a string.
--
-- >>> replicateM 4 (Just 'v')
-- Just vvvv
replicateM :: (Unbox a, Monad m) => Int -> m a -> m (String a)
replicateM :: forall a (m :: * -> *).
(Unbox a, Monad m) =>
Int -> m a -> m (String a)
replicateM = Int -> m a -> m (String a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
Generic.replicateM
{-# INLINE replicateM #-}

-- | /O(n)/ Construct a string of the given length by applying the monadic action to each index.
--
-- >>> generateM 5 (\i -> Just i)
-- Just 0 1 2 3 4
generateM :: (Unbox a, Monad m) => Int -> (Int -> m a) -> m (String a)
generateM :: forall a (m :: * -> *).
(Unbox a, Monad m) =>
Int -> (Int -> m a) -> m (String a)
generateM = Int -> (Int -> m a) -> m (String a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> (Int -> m a) -> m (v a)
Generic.generateM
{-# INLINE generateM #-}

-- | /O(f(n))/ Execute the monadic action and freeze the resulting string.
--
-- >>> import Control.Applicative (pure)
-- >>> import Data.Vector.Unboxed.Mutable (new, write)
-- >>> create (do v <- new 2; write v 0 'a'; write v 1 'b'; pure v)
-- ab
create :: Unbox a => (forall s. ST s (MVector s a)) -> String a
create :: forall a. Unbox a => (forall s. ST s (MVector s a)) -> String a
create forall s. ST s (MVector s a)
f = (forall s. ST s (Mutable String s a)) -> String a
forall (v :: * -> *) a.
Vector v a =>
(forall s. ST s (Mutable v s a)) -> v a
Generic.create (MVector s a -> MString s a
forall s a. MVector s a -> MString s a
MString (MVector s a -> MString s a)
-> ST s (MVector s a) -> ST s (MString s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ST s (MVector s a)
forall s. ST s (MVector s a)
f)
{-# INLINE create #-}

-- --------- --
-- Unfolding --

-- | /O(n)/ Construct a string by repeatedly applying the generator function to a seed.
--
-- The generator function yields -- `Just` the next character and the new seed or `Nothing` if
-- there are no more characters.
--
-- >>> unfoldr @Int (\n -> if n == 0 then Nothing else Just (n, n-1)) 10
-- 10 9 8 7 6 5 4 3 2 1
unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> String a
unfoldr :: forall a b. Unbox a => (b -> Maybe (a, b)) -> b -> String a
unfoldr = (b -> Maybe (a, b)) -> b -> String a
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
Generic.unfoldr
{-# INLINE unfoldr #-}

-- | /O(n)/ Construct a vector with exactly @n@ characters by repeatedly applying the generator
-- function to a seed.
--
-- The generator function yields the next character and the new seed.
--
-- >>> unfoldrExactN @Int 3 (\n -> (n, n-1)) 10
-- 10 9 8
unfoldrExactN :: Unbox a => Int -> (b -> (a, b)) -> b -> String a
unfoldrExactN :: forall a b. Unbox a => Int -> (b -> (a, b)) -> b -> String a
unfoldrExactN = Int -> (b -> (a, b)) -> b -> String a
forall (v :: * -> *) a b.
Vector v a =>
Int -> (b -> (a, b)) -> b -> v a
Generic.unfoldrExactN
{-# INLINE unfoldrExactN #-}

-- | /O(n)/ Construct a string by repeatedly applying the generator function to a seed.
--
-- The generator function yields -- `Just` the next character and the new seed or `Nothing` if
-- there are no more characters.
--
-- >>> unfoldr @Int (\n -> if n == 0 then Nothing else Just (n, n-1)) 10
-- 10 9 8 7 6 5 4 3 2 1
unfoldrM :: (Unbox a, Monad m) => (b -> m (Maybe (a, b))) -> b -> m (String a)
unfoldrM :: forall a (m :: * -> *) b.
(Unbox a, Monad m) =>
(b -> m (Maybe (a, b))) -> b -> m (String a)
unfoldrM = (b -> m (Maybe (a, b))) -> b -> m (String a)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
(b -> m (Maybe (a, b))) -> b -> m (v a)
Generic.unfoldrM
{-# INLINE unfoldrM #-}

-- | /O(n)/ Construct a string with exactly @n@ characters by repeatedly applying the generator
-- function to a seed.
--
-- The generator function yields the next character and the new seed.
--
-- >>> unfoldrExactN @Int 3 (\n -> (n, n-1)) 10
-- 10 9 8
unfoldrExactNM :: (Unbox a, Monad m) => Int -> (b -> m (a, b)) -> b -> m (String a)
unfoldrExactNM :: forall a (m :: * -> *) b.
(Unbox a, Monad m) =>
Int -> (b -> m (a, b)) -> b -> m (String a)
unfoldrExactNM = Int -> (b -> m (a, b)) -> b -> m (String a)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Int -> (b -> m (a, b)) -> b -> m (v a)
Generic.unfoldrExactNM
{-# INLINE unfoldrExactNM #-}

-- ----------- --
-- Enumeration --

-- | /O(n)/ Yield a string of the given length, containing the characters @x@, @x+1@ etc.
--
-- This operation is usually more efficient than `Data.Vector.Generic.enumFromTo`.
--
-- >>> enumFromN @Int 5 3
-- 5 6 7
enumFromN :: (Unbox a, Num a) => a -> Int -> String a
enumFromN :: forall a. (Unbox a, Num a) => a -> Int -> String a
enumFromN = a -> Int -> String a
forall (v :: * -> *) a. (Vector v a, Num a) => a -> Int -> v a
Generic.enumFromN
{-# INLINE enumFromN #-}

-- | /O(n)/ Yield a string of the given length, containing the characters @x@, @x+y@, @x+y+y@ etc.
--
-- This operations is usually more efficient than `Data.Vector.Generic.enumFromThenTo`.
--
-- >>> enumFromStepN @Int 1 2 5
-- 1 3 5 7 9
enumFromStepN :: (Unbox a, Num a) => a -> a -> Int -> String a
enumFromStepN :: forall a. (Unbox a, Num a) => a -> a -> Int -> String a
enumFromStepN = a -> a -> Int -> String a
forall (v :: * -> *) a. (Vector v a, Num a) => a -> a -> Int -> v a
Generic.enumFromStepN
{-# INLINE enumFromStepN #-}

-- ------------- --
-- Concatenation --

-- | /O(n)/ Prepend a character.
--
-- >>> cons 'e' "xtrem"
-- extrem
cons :: a -> String a -> String a
cons :: forall a. a -> String a -> String a
cons a
ch s :: String a
s@String a
Unboxed = a -> String a -> String a
forall (v :: * -> *) a. Vector v a => a -> v a -> v a
Generic.cons a
ch String a
s
{-# INLINE cons #-}

-- | /O(n)/ Append a character.
--
-- >>> snoc "xtrem" 'a'
-- xtrema
snoc :: String a -> a -> String a
snoc :: forall a. String a -> a -> String a
snoc s :: String a
s@String a
Unboxed = String a -> a -> String a
forall (v :: * -> *) a. Vector v a => v a -> a -> v a
Generic.snoc String a
s
{-# INLINE snoc #-}

-- | /O(m+n)/ Concatenate two strings.
--
-- >>> "abc" ++ "xyz"
-- abcxyz
(++) :: String a -> String a -> String a
l :: String a
l@String a
Unboxed ++ :: forall a. String a -> String a -> String a
++ String a
r = String a
l String a -> String a -> String a
forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
Generic.++ String a
r
{-# INLINE (++) #-}

-- | /O(n)/ Concatenate all strings in the list.
--
-- This is the simplest variant, but requires `Unbox a`.
--
-- >>> concat ["abc", "123", "def"]
-- abc123def
--
-- >>> concat @Char []
-- <BLANKLINE>
concat :: Unbox a => [String a] -> String a
concat :: forall a. Unbox a => [String a] -> String a
concat = [String a] -> String a
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Generic.concat
{-# INLINE concat #-}

-- | /O(n)/ Concatenate all strings in the non-empty list.
--
-- >>> concatNE ("abc" :| ["123", "def"])
-- abc123def
concatNE :: NonEmpty (String a) -> String a
concatNE :: forall a. NonEmpty (String a) -> String a
concatNE strs :: NonEmpty (String a)
strs@(String a
Unboxed :| [String a]
_) = NonEmpty (String a) -> String a
forall (v :: * -> *) a. Vector v a => NonEmpty (v a) -> v a
Generic.concatNE NonEmpty (String a)
strs
{-# INLINE concatNE #-}

-- ------------------------ --
-- Restricting memory usage --

-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, possibly by copying it.
--
-- See [Data.Vector.Unbox](https://hackage.haskell.org/package/vector-0.13.0.0/docs/Data-Vector-Unboxed.html#v:force).
force :: String a -> String a
force :: forall a. String a -> String a
force s :: String a
s@String a
Unboxed = String a -> String a
forall (v :: * -> *) a. Vector v a => v a -> v a
Generic.force String a
s
{-# INLINE force #-}

-- ------------ --
-- Bulk updates --

-- | /O(m+n)/ For each pair `(i,a)` from the list of index/value pairs, replace the character at
-- position @i@ by @a@.
--
-- >>> "test" // [(2,'x'),(0,'y'),(2,'z')]
-- yezt
(//) :: String a -> [(Int, a)] -> String a
s :: String a
s@String a
Unboxed // :: forall a. String a -> [(Int, a)] -> String a
// [(Int, a)]
idx = String a
s String a -> [(Int, a)] -> String a
forall (v :: * -> *) a. Vector v a => v a -> [(Int, a)] -> v a
Generic.// [(Int, a)]
idx
{-# INLINE (//) #-}

-- | /O(m+min(n1,n2))/ For each index @i@ from the index list and the corresponding value a from
-- another string, replace the character of the initial string at position @i@ by @a@.
--
-- >>> update "test" [2,0,2] "xyz"
-- yezt
update :: String a -> [Int] -> String a -> String a
update :: forall a. String a -> [Int] -> String a -> String a
update s :: String a
s@String a
Unboxed [Int]
idx = String a -> String Int -> String a -> String a
forall (v :: * -> *) a.
(Vector v a, Vector v Int) =>
v a -> v Int -> v a -> v a
Generic.update_ String a
s ([Int] -> String Int
forall (v :: * -> *) a. Vector v a => [a] -> v a
Generic.fromList [Int]
idx)
{-# INLINE update #-}

-- ------------- --
-- Accumulations --

-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the character at position @i@ by @f a b@.
--
-- >>> import GHC.Num ((+))
-- >>> accum @Int (+) [1000,2000,3000] [(2,4),(1,6),(0,3),(1,10)]
-- 1003 2016 3004
accum :: (a -> b -> a) -> String a -> [(Int, b)] -> String a
accum :: forall a b. (a -> b -> a) -> String a -> [(Int, b)] -> String a
accum a -> b -> a
f s :: String a
s@String a
Unboxed = (a -> b -> a) -> String a -> [(Int, b)] -> String a
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> a) -> v a -> [(Int, b)] -> v a
Generic.accum a -> b -> a
f String a
s
{-# INLINE accum #-}

-- | /O(m+min(n1,n2))/ For each index @i@ from the index list and the corresponding value @b@ from the string,
-- replace the character of the initial string at position @i@ by @f a b@.
--
-- >>> import GHC.Num ((+))
-- >>> accumulate @Int (+) [5,9,2] [2,1,0,1] [4,6,3,7]
-- 8 22 6
accumulate :: (a -> b -> a) -> String a -> [Int] -> String b -> String a
accumulate :: forall a b.
(a -> b -> a) -> String a -> [Int] -> String b -> String a
accumulate a -> b -> a
f s :: String a
s@String a
Unboxed [Int]
idx v :: String b
v@String b
Unboxed = (a -> b -> a) -> String a -> String Int -> String b -> String a
forall (v :: * -> *) a b.
(Vector v a, Vector v Int, Vector v b) =>
(a -> b -> a) -> v a -> v Int -> v b -> v a
Generic.accumulate_ a -> b -> a
f String a
s ([Int] -> String Int
forall (v :: * -> *) a. Vector v a => [a] -> v a
Generic.fromList [Int]
idx) String b
v
{-# INLINE accumulate #-}

-- ------------ --
-- Permutations --

-- | /O(n)/ Reverse a string.
--
-- >>> reverse "abc123"
-- 321cba
reverse :: String a -> String a
reverse :: forall a. String a -> String a
reverse s :: String a
s@String a
Unboxed = String a -> String a
forall (v :: * -> *) a. Vector v a => v a -> v a
Generic.reverse String a
s
{-# INLINE reverse #-}

-- | /O(n)/ Yield the string obtained by replacing each element @i@ of the index list by `xs!i`.
--
-- This is equivalent to `map (xs!)` is, but is often much more efficient.
--
-- >>> backpermute "abcd" [0,3,2,3,1,0]
-- adcdba
backpermute :: String a -> [Int] -> String a
backpermute :: forall a. String a -> [Int] -> String a
backpermute s :: String a
s@String a
Unboxed [Int]
idx = String a -> String Int -> String a
forall (v :: * -> *) a.
(HasCallStack, Vector v a, Vector v Int) =>
v a -> v Int -> v a
Generic.backpermute String a
s ([Int] -> String Int
forall (v :: * -> *) a. Vector v a => [a] -> v a
Generic.fromList [Int]
idx)
{-# INLINE backpermute #-}

-- ------------------------ --
-- Safe destructive updates --

-- | /O(f(n))/ Apply a destructive operation to a string.
--
-- The operation will be performed in place if it is safe to do so and will modify a copy of the vector otherwise.
--
-- >>> import Data.Vector.Unboxed.Mutable (write)
-- >>> modify (\v -> write v 3 'X') (replicate 10 'a')
-- aaaXaaaaaa
modify :: (forall s. MVector s a -> ST s ()) -> String a -> String a
modify :: forall a.
(forall s. MVector s a -> ST s ()) -> String a -> String a
modify forall s. MVector s a -> ST s ()
f s :: String a
s@String a
Unboxed = (forall s. Mutable String s a -> ST s ()) -> String a -> String a
forall (v :: * -> *) a.
Vector v a =>
(forall s. Mutable v s a -> ST s ()) -> v a -> v a
Generic.modify (MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
f (MVector s a -> ST s ())
-> (MString s a -> MVector s a) -> MString s a -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MString s a -> MVector s a
forall s a. MString s a -> MVector s a
mContents) String a
s
{-# INLINE modify #-}

-- -------- --
-- Indexing --

-- | /O(n)/ Pair each character in a string with its index.
--
-- >>> indexed "greedy"
-- (0,'g') (1,'r') (2,'e') (3,'e') (4,'d') (5,'y')
indexed :: String a -> String (Int, a)
indexed :: forall a. String a -> String (Int, a)
indexed s :: String a
s@String a
Unboxed = String a -> String (Int, a)
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
Generic.indexed String a
s
{-# INLINE indexed #-}

-- ------- --
-- Mapping --

-- | /O(n)/ Map a function over a string.
--
-- >>> import Data.Char (ord)
-- >>> map ord "genome"
-- 103 101 110 111 109 101
map :: Unbox b => (a -> b) -> String a -> String b
map :: forall b a. Unbox b => (a -> b) -> String a -> String b
map a -> b
f s :: String a
s@String a
Unboxed = (a -> b) -> String a -> String b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Generic.map a -> b
f String a
s
{-# INLINE map #-}

-- | /O(n)/ Map an endofunction over a string.
--
-- >>> import Data.Char (toUpper)
-- >>> map_ toUpper "genome"
-- GENOME
map_ :: (a -> a) -> String a -> String a
map_ :: forall a. (a -> a) -> String a -> String a
map_ a -> a
f s :: String a
s@String a
Unboxed = (a -> a) -> String a -> String a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Generic.map a -> a
f String a
s
{-# INLINE map_ #-}

-- | /O(n)/ Apply a function to every character of a string and its index.
--
-- >>> import Data.Char (ord)
-- >>> import GHC.Num ((+))
-- >>> imap (\i c -> i + ord c) "genome"
-- 103 102 112 114 113 106
imap :: Unbox b => (Int -> a -> b) -> String a -> String b
imap :: forall b a. Unbox b => (Int -> a -> b) -> String a -> String b
imap Int -> a -> b
f s :: String a
s@String a
Unboxed = (Int -> a -> b) -> String a -> String b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(Int -> a -> b) -> v a -> v b
Generic.imap Int -> a -> b
f String a
s
{-# INLINE imap #-}

-- | /O(n)/ Apply an endofunction to every character of a string and its index.
--
-- >>> import Data.Char (chr, ord)
-- >>> import GHC.Num ((+))
-- >>> imap_ (\i c -> chr (i + ord c)) "genome"
-- gfprqj
imap_ :: (Int -> a -> a) -> String a -> String a
imap_ :: forall a. (Int -> a -> a) -> String a -> String a
imap_ Int -> a -> a
f s :: String a
s@String a
Unboxed = (Int -> a -> a) -> String a -> String a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(Int -> a -> b) -> v a -> v b
Generic.imap Int -> a -> a
f String a
s
{-# INLINE imap_ #-}

-- | /O(?)/ Map a function over a string and concatenate the results.
--
-- >>> concatMap (\c -> [c, c]) "genome"
-- ggeennoommee
concatMap :: Unbox b => (a -> [b]) -> String a -> String b
concatMap :: forall b a. Unbox b => (a -> [b]) -> String a -> String b
concatMap a -> [b]
f s :: String a
s@String a
Unboxed = (a -> String b) -> String a -> String b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> v b) -> v a -> v b
Generic.concatMap ([b] -> String b
[Item (String b)] -> String b
forall l. IsList l => [Item l] -> l
fromList ([b] -> String b) -> (a -> [b]) -> a -> String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [b]
f) String a
s
{-# INLINE concatMap #-}

-- | /O(?)/ Map a function over a string and concatenate the resulting strings.
--
-- >>> concatMap_ (\c -> replicate 3 c) "gen"
-- gggeeennn
concatMap_ :: (a -> String a) -> String a -> String a
concatMap_ :: forall a. (a -> String a) -> String a -> String a
concatMap_ a -> String a
f s :: String a
s@String a
Unboxed = (a -> String a) -> String a -> String a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> v b) -> v a -> v b
Generic.concatMap a -> String a
f String a
s
{-# INLINE concatMap_ #-}

-- --------------- --
-- Monadic mapping --

-- | /O(n)/ Apply the monadic action to all characters of the string, yielding a string of results.
mapM :: (Monad m, Unbox b) => (a -> m b) -> String a -> m (String b)
mapM :: forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> m b) -> String a -> m (String b)
mapM a -> m b
f s :: String a
s@String a
Unboxed = (a -> m b) -> String a -> m (String b)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m b) -> v a -> m (v b)
Generic.mapM a -> m b
f String a
s
{-# INLINE mapM #-}

-- | /O(n)/ Apply the monadic action to all characters of the string, yielding a string of results.
mapM_ :: Monad m => (a -> m a) -> String a -> m (String a)
mapM_ :: forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> String a -> m (String a)
mapM_ a -> m a
f s :: String a
s@String a
Unboxed = (a -> m a) -> String a -> m (String a)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m b) -> v a -> m (v b)
Generic.mapM a -> m a
f String a
s
{-# INLINE mapM_ #-}

-- | /O(n)/ Apply the monadic action to all characters of a string and ignore the results.
forM :: Monad m => String a -> (a -> m b) -> m ()
forM :: forall (m :: * -> *) a b. Monad m => String a -> (a -> m b) -> m ()
forM s :: String a
s@String a
Unboxed = String a -> (a -> m b) -> m ()
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
v a -> (a -> m b) -> m ()
Generic.forM_ String a
s
{-# INLINE forM #-}

-- | /O(n)/ Apply the monadic action to all characters of a string and their indices and ignore
-- the results.
iforM :: Monad m => String a -> (Int -> a -> m b) -> m ()
iforM :: forall (m :: * -> *) a b.
Monad m =>
String a -> (Int -> a -> m b) -> m ()
iforM s :: String a
s@String a
Unboxed = String a -> (Int -> a -> m b) -> m ()
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
v a -> (Int -> a -> m b) -> m ()
Generic.iforM_ String a
s
{-# INLINE iforM #-}

-- ------- --
-- Zipping --

-- | /O(min(m,n))/ Zip two strings with the given function.
zipWith :: Unbox c => (a -> b -> c) -> String a -> String b -> String c
zipWith :: forall c a b.
Unbox c =>
(a -> b -> c) -> String a -> String b -> String c
zipWith a -> b -> c
f sa :: String a
sa@String a
Unboxed sb :: String b
sb@String b
Unboxed = (a -> b -> c) -> String a -> String b -> String c
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
Generic.zipWith a -> b -> c
f String a
sa String b
sb
{-# INLINE zipWith #-}

-- | /O(min(m,n,k))/ Zip three strings with the given function.
zipWith3 :: Unbox d => (a -> b -> c -> d) -> String a -> String b -> String c -> String d
zipWith3 :: forall d a b c.
Unbox d =>
(a -> b -> c -> d) -> String a -> String b -> String c -> String d
zipWith3 a -> b -> c -> d
f sa :: String a
sa@String a
Unboxed sb :: String b
sb@String b
Unboxed sc :: String c
sc@String c
Unboxed = (a -> b -> c -> d) -> String a -> String b -> String c -> String d
forall (v :: * -> *) a b c d.
(Vector v a, Vector v b, Vector v c, Vector v d) =>
(a -> b -> c -> d) -> v a -> v b -> v c -> v d
Generic.zipWith3 a -> b -> c -> d
f String a
sa String b
sb String c
sc
{-# INLINE zipWith3 #-}

-- | /O(min(m,n))/ Zip two strings.
zip :: String a -> String b -> String (a, b)
zip :: forall a b. String a -> String b -> String (a, b)
zip sa :: String a
sa@String a
Unboxed sb :: String b
sb@String b
Unboxed = String a -> String b -> String (a, b)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v a -> v b -> v (a, b)
Generic.zip String a
sa String b
sb
{-# INLINE zip #-}

-- | /O(min(m,n))/ Zip three strings.
zip3 :: String a -> String b -> String c -> String (a, b, c)
zip3 :: forall a b c. String a -> String b -> String c -> String (a, b, c)
zip3 sa :: String a
sa@String a
Unboxed sb :: String b
sb@String b
Unboxed sc :: String c
sc@String c
Unboxed = String a -> String b -> String c -> String (a, b, c)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) =>
v a -> v b -> v c -> v (a, b, c)
Generic.zip3 String a
sa String b
sb String c
sc
{-# INLINE zip3 #-}

-- --------------- --
-- Monadic zipping --

-- | /O(min(m,n))/ Zip the two strings with the monadic action and yield a vector of results.
zipWithM :: (Monad m, Unbox c) => (a -> b -> m c) -> String a -> String b -> m (String c)
zipWithM :: forall (m :: * -> *) c a b.
(Monad m, Unbox c) =>
(a -> b -> m c) -> String a -> String b -> m (String c)
zipWithM a -> b -> m c
f sa :: String a
sa@String a
Unboxed sb :: String b
sb@String b
Unboxed = (a -> b -> m c) -> String a -> String b -> m (String c)
forall (m :: * -> *) (v :: * -> *) a b c.
(Monad m, Vector v a, Vector v b, Vector v c) =>
(a -> b -> m c) -> v a -> v b -> m (v c)
Generic.zipWithM a -> b -> m c
f String a
sa String b
sb
{-# INLINE zipWithM #-}

-- | /O(min(m,n))/ Zip the two strings with the monadic action and ignore the results.
zipWithM_ :: Monad m => (a -> b -> m c) -> String a -> String b -> m ()
zipWithM_ :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> String a -> String b -> m ()
zipWithM_ a -> b -> m c
f sa :: String a
sa@String a
Unboxed sb :: String b
sb@String b
Unboxed = (a -> b -> m c) -> String a -> String b -> m ()
forall (m :: * -> *) (v :: * -> *) a b c.
(Monad m, Vector v a, Vector v b) =>
(a -> b -> m c) -> v a -> v b -> m ()
Generic.zipWithM_ a -> b -> m c
f String a
sa String b
sb
{-# INLINE zipWithM_ #-}

-- --------- --
-- Unzipping --

-- | /O(n)/ Unzip a string of pairs.
unzip :: (Unbox a, Unbox b) => String (a, b) -> (String a, String b)
unzip :: forall a b.
(Unbox a, Unbox b) =>
String (a, b) -> (String a, String b)
unzip = String (a, b) -> (String a, String b)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
Generic.unzip
{-# INLINE unzip #-}

-- | /O(n)/ Unzip a string of triples.
unzip3 :: (Unbox a, Unbox b) => String (a, b) -> (String a, String b)
unzip3 :: forall a b.
(Unbox a, Unbox b) =>
String (a, b) -> (String a, String b)
unzip3 = String (a, b) -> (String a, String b)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
Generic.unzip
{-# INLINE unzip3 #-}

-- --------- --
-- Filtering --

-- | /O(n)/ Drop all characters that do not satisfy the predicate.
--
-- >>> import Data.Char (isUpper)
-- >>> filter isUpper "ABCdefGHI"
-- ABCGHI
filter :: (a -> Bool) -> String a -> String a
filter :: forall a. (a -> Bool) -> String a -> String a
filter a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> String a
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
Generic.filter a -> Bool
f String a
s
{-# INLINE filter #-}

-- | /O(n)/ Drop all characters that do not satisfy the predicate which is applied to the values
-- and their indices.
ifilter :: (Int -> a -> Bool) -> String a -> String a
ifilter :: forall a. (Int -> a -> Bool) -> String a -> String a
ifilter Int -> a -> Bool
f s :: String a
s@String a
Unboxed = (Int -> a -> Bool) -> String a -> String a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
Generic.ifilter Int -> a -> Bool
f String a
s
{-# INLINE ifilter #-}

-- | /O(n)/ Drop all characters that do not satisfy the monadic predicate.
filterM :: Monad m => (a -> m Bool) -> String a -> m (String a)
filterM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> String a -> m (String a)
filterM a -> m Bool
f s :: String a
s@String a
Unboxed = (a -> m Bool) -> String a -> m (String a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(a -> m Bool) -> v a -> m (v a)
Generic.filterM a -> m Bool
f String a
s
{-# INLINE filterM #-}

-- | /O(n)/ Drop repeated adjacent characters.
--
-- >>> uniq "aaaabbbcccaabc"
-- abcabc
uniq :: Eq a => String a -> String a
uniq :: forall a. Eq a => String a -> String a
uniq s :: String a
s@String a
Unboxed = String a -> String a
forall (v :: * -> *) a. (Vector v a, Eq a) => v a -> v a
Generic.uniq String a
s
{-# INLINE uniq #-}

-- | /O(n)/ Map the values and collect the `Just` results.
mapMaybe :: Unbox b => (a -> Maybe b) -> String a -> String b
mapMaybe :: forall b a. Unbox b => (a -> Maybe b) -> String a -> String b
mapMaybe a -> Maybe b
f s :: String a
s@String a
Unboxed = (a -> Maybe b) -> String a -> String b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> Maybe b) -> v a -> v b
Generic.mapMaybe a -> Maybe b
f String a
s
{-# INLINE mapMaybe #-}

-- | /O(n)/ Apply the monadic function to each element of the string and discard characters
-- returning `Nothing`.
mapMaybeM :: (Monad m, Unbox b) => (a -> m (Maybe b)) -> String a -> m (String b)
mapMaybeM :: forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> m (Maybe b)) -> String a -> m (String b)
mapMaybeM a -> m (Maybe b)
f s :: String a
s@String a
Unboxed = (a -> m (Maybe b)) -> String a -> m (String b)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m (Maybe b)) -> v a -> m (v b)
Generic.mapMaybeM a -> m (Maybe b)
f String a
s
{-# INLINE mapMaybeM #-}

-- | /O(n)/ Yield the longest prefix of characters satisfying the predicate.
--
-- The current implementation is not copy-free, unless the result string is fused away.
takeWhile :: (a -> Bool) -> String a -> String a
takeWhile :: forall a. (a -> Bool) -> String a -> String a
takeWhile a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> String a
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
Generic.takeWhile a -> Bool
f String a
s
{-# INLINE takeWhile #-}

-- | /O(n)/ Drop the longest prefix of characters that satisfy the predicate without copying.
dropWhile :: (a -> Bool) -> String a -> String a
dropWhile :: forall a. (a -> Bool) -> String a -> String a
dropWhile a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> String a
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
Generic.takeWhile a -> Bool
f String a
s
{-# INLINE dropWhile #-}

-- ------------ --
-- Partitioning --

-- | /O(n)/ Split the string in two parts, the first one containing those characters that satisfy
-- the predicate and the
-- second one those that don't.
--
-- The relative order of the characters is preserved at the cost of a sometimes reduced performance
-- compared to `unstablePartition`.
partition :: (a -> Bool) -> String a -> (String a, String a)
partition :: forall a. (a -> Bool) -> String a -> (String a, String a)
partition a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> (String a, String a)
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> (v a, v a)
Generic.partition a -> Bool
f String a
s
{-# INLINE partition #-}

-- | /O(n)/ Split the string into two parts, the first one containing the `Prelude.Left` characters
-- and the second containing the `Prelude.Right` characters.
--
-- The relative order of the characters is preserved.
partitionWith :: (Unbox b, Unbox c) => (a -> Either b c) -> String a -> (String b, String c)
partitionWith :: forall b c a.
(Unbox b, Unbox c) =>
(a -> Either b c) -> String a -> (String b, String c)
partitionWith a -> Either b c
f s :: String a
s@String a
Unboxed = (a -> Either b c) -> String a -> (String b, String c)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> Either b c) -> v a -> (v b, v c)
Generic.partitionWith a -> Either b c
f String a
s
{-# INLINE partitionWith #-}

-- | /O(n)/ Split the string in two parts, the first one containing those characters that satisfy
-- the predicate and the second one those that don't.
--
-- The order of the characters is not preserved, but the operation is often faster than
-- `partition`.
unstablePartition :: (a -> Bool) -> String a -> (String a, String a)
unstablePartition :: forall a. (a -> Bool) -> String a -> (String a, String a)
unstablePartition a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> (String a, String a)
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> (v a, v a)
Generic.unstablePartition a -> Bool
f String a
s
{-# INLINE unstablePartition #-}

-- | /O(n)/ Split the string into the longest prefix of characters that satisfy the predicate and
-- the rest without copying.
span :: (a -> Bool) -> String a -> (String a, String a)
span :: forall a. (a -> Bool) -> String a -> (String a, String a)
span a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> (String a, String a)
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> (v a, v a)
Generic.span a -> Bool
f String a
s
{-# INLINE span #-}

-- | /O(n)/ Split the string into the longest prefix of characters that do not satisfy the
-- predicate and the rest without copying.
break :: (a -> Bool) -> String a -> (String a, String a)
break :: forall a. (a -> Bool) -> String a -> (String a, String a)
break a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> (String a, String a)
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> (v a, v a)
Generic.break a -> Bool
f String a
s
{-# INLINE break #-}

-- | /O(n)/ Split a string into a list of slices.
--
-- The concatenation of this list of slices is equal to the argument string, and each slice
-- contains only equal characters, as determined by the equality predicate function.
--
-- >>> import Data.Char (isUpper)
-- >>> groupBy (\x y -> isUpper x == isUpper y) "Rio Grande"
-- [R,io ,G,rande]
groupBy :: (a -> a -> Bool) -> String a -> [String a]
groupBy :: forall a. (a -> a -> Bool) -> String a -> [String a]
groupBy a -> a -> Bool
f s :: String a
s@String a
Unboxed = (a -> a -> Bool) -> String a -> [String a]
forall (v :: * -> *) a.
Vector v a =>
(a -> a -> Bool) -> v a -> [v a]
Generic.groupBy a -> a -> Bool
f String a
s
{-# INLINE groupBy #-}

-- | /O(n)/ Split a string into a list of slices.
--
-- The concatenation of this list of slices is equal to the argument string, and each slice
-- contains only equal characters.
--
-- This is the equivalent of 'groupBy (==)'.
--
-- >>> group "Mississippi"
-- [M,i,ss,i,ss,i,pp,i]
group :: Eq a => String a -> [String a]
group :: forall a. Eq a => String a -> [String a]
group s :: String a
s@String a
Unboxed = String a -> [String a]
forall (v :: * -> *) a. (Vector v a, Eq a) => v a -> [v a]
Generic.group String a
s
{-# INLINE group #-}

-- --------- --
-- Searching --

-- | /O(n)/ Check if the string contains a character.
elem :: Eq a => a -> String a -> Bool
elem :: forall a. Eq a => a -> String a -> Bool
elem a
c s :: String a
s@String a
Unboxed = a -> String a -> Bool
forall (v :: * -> *) a. (Vector v a, Eq a) => a -> v a -> Bool
Generic.elem a
c String a
s
{-# INLINE elem #-}

-- | /O(n)/ Check if the string does not contain a character (inverse of `elem`).
notElem :: Eq a => a -> String a -> Bool
notElem :: forall a. Eq a => a -> String a -> Bool
notElem a
c s :: String a
s@String a
Unboxed = a -> String a -> Bool
forall (v :: * -> *) a. (Vector v a, Eq a) => a -> v a -> Bool
Generic.notElem a
c String a
s
{-# INLINE notElem #-}

-- | /O(n)/ Yield `Just` the first character matching the predicate or `Nothing` if no such
-- character exists.
find :: (a -> Bool) -> String a -> Maybe a
find :: forall a. (a -> Bool) -> String a -> Maybe a
find a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> Maybe a
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Maybe a
Generic.find a -> Bool
f String a
s
{-# INLINE find #-}

-- | /O(n)/ Yield `Just` the index of the first character matching the predicate or `Nothing` if no
-- such character exists.
findIndex :: (a -> Bool) -> String a -> Maybe Int
findIndex :: forall a. (a -> Bool) -> String a -> Maybe Int
findIndex a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> Maybe Int
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> Maybe Int
Generic.findIndex a -> Bool
f String a
s
{-# INLINE findIndex #-}

-- | /O(n)/ Yield `Just` the index of the last character matching the predicate or `Nothing` if no
-- such character exists.
findIndexR :: (a -> Bool) -> String a -> Maybe Int
findIndexR :: forall a. (a -> Bool) -> String a -> Maybe Int
findIndexR a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> Maybe Int
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> Maybe Int
Generic.findIndexR a -> Bool
f String a
s
{-# INLINE findIndexR #-}

-- | /O(n)/ Yield the indices of character satisfying the predicate in ascending order.
findIndices :: (a -> Bool) -> String a -> String Int
findIndices :: forall a. (a -> Bool) -> String a -> String Int
findIndices a -> Bool
f s :: String a
s@String a
Unboxed = (a -> Bool) -> String a -> String Int
forall (v :: * -> *) a.
(Vector v a, Vector v Int) =>
(a -> Bool) -> v a -> v Int
Generic.findIndices a -> Bool
f String a
s
{-# INLINE findIndices #-}

-- | /O(n)/ Yield `Just` the index of the first occurrence of the given character or `Nothing` if
-- the vector does not contain the character.
--
-- This is a specialised version of `findIndex`.
elemIndex :: Eq a => a -> String a -> Maybe Int
elemIndex :: forall a. Eq a => a -> String a -> Maybe Int
elemIndex a
c s :: String a
s@String a
Unboxed = a -> String a -> Maybe Int
forall (v :: * -> *) a. (Vector v a, Eq a) => a -> v a -> Maybe Int
Generic.elemIndex a
c String a
s
{-# INLINE elemIndex #-}

-- | /O(n)/ Yield the indices of all occurrences of the given character in ascending order.
--
-- This is a specialised version of `findIndices`.
elemIndices :: Eq a => a -> String a -> String Int
elemIndices :: forall a. Eq a => a -> String a -> String Int
elemIndices a
c s :: String a
s@String a
Unboxed = a -> String a -> String Int
forall (v :: * -> *) a.
(Vector v a, Vector v Int, Eq a) =>
a -> v a -> v Int
Generic.elemIndices a
c String a
s
{-# INLINE elemIndices #-}

-- ----------- --
-- Comparisons --

-- | /O(n)/ Check if two strings are equal using the supplied equality predicate.
--
-- >>> import Data.Char (toLower)
-- >>> eqBy (\x y -> toLower x == toLower y) "ABcd" "abcD"
-- True
eqBy :: (a -> b -> Bool) -> String a -> String b -> Bool
eqBy :: forall a b. (a -> b -> Bool) -> String a -> String b -> Bool
eqBy a -> b -> Bool
f l :: String a
l@String a
Unboxed r :: String b
r@String b
Unboxed = (a -> b -> Bool) -> String a -> String b -> Bool
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> Bool) -> v a -> v b -> Bool
Generic.eqBy a -> b -> Bool
f String a
l String b
r
{-# INLINE eqBy #-}

-- | /O(n)/ Compare two strings using the supplied comparison function for characters.
--
-- Comparison works the same as for lists.
cmpBy :: (a -> b -> Ordering) -> String a -> String b -> Ordering
cmpBy :: forall a b.
(a -> b -> Ordering) -> String a -> String b -> Ordering
cmpBy a -> b -> Ordering
f l :: String a
l@String a
Unboxed r :: String b
r@String b
Unboxed = (a -> b -> Ordering) -> String a -> String b -> Ordering
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> Ordering) -> v a -> v b -> Ordering
Generic.cmpBy a -> b -> Ordering
f String a
l String b
r
{-# INLINE cmpBy #-}

-- ------------------ --
-- Other vector types --

-- | /O(n)/ Convert to a vector of characters.
convert :: Generic.Vector v a => String a -> v a
convert :: forall (v :: * -> *) a. Vector v a => String a -> v a
convert s :: String a
s@String a
Unboxed = String a -> v a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Generic.convert String a
s
{-# INLINE convert #-}