{-|
Module      : Z.Data.Text.Extra
Description : Fast text slice manipulation
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Various combinators works on 'Text's.

-}

module Z.Data.Text.Extra (
  -- * Slice manipulation
    cons, snoc
  , uncons, unsnoc
  , headMaybe, tailMayEmpty, lastMaybe, initMayEmpty
  , head, tail, last, init
  , inits, tails
  , take, drop, takeR, dropR
  , slice
  , splitAt
  , takeWhile, takeWhileR, dropWhile, dropWhileR, dropAround
  , break, span
  , breakR, spanR, breakOn, breakOnAll
  , group, groupBy
  , stripPrefix, stripSuffix
  , split, splitWith, splitOn
  , isPrefixOf, isSuffixOf, isInfixOf
  , commonPrefix
  , words, lines, unwords, unlines
  , padLeft, padRight
  -- * Transform
  , reverse
  , intersperse
  , intercalate
  , intercalateElem
  , transpose
  ) where

import Data.Primitive.PrimArray
import qualified Z.Data.Vector.Base as V
import qualified Z.Data.Vector.Extra as V
import qualified Z.Data.Vector.Search as V
import Data.Coerce
import qualified Data.List as List
import Z.Data.Text.Base
import Z.Data.Text.UTF8Codec
import Z.Data.Text.Search
import           Control.Monad.ST
import           Data.Char
import           Data.Word
import           Prelude                       hiding (concat, concatMap,
                                                elem, notElem, null, length, map,
                                                foldl, foldl1, foldr, foldr1,
                                                maximum, minimum, product, sum,
                                                all, any, replicate, traverse,
                                                head, tail, init, last,
                                                take, drop, splitAt,
                                                takeWhile, dropWhile,
                                                break, span, reverse,
                                                words, lines, unwords, unlines)


--------------------------------------------------------------------------------
-- Slice manipulation

-- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
-- complexity, as it requires making a copy.
cons :: Char -> Text -> Text
{-# INLINABLE cons #-}
cons :: Char -> Text -> Text
cons Char
c (Text (V.PrimVector PrimArray Word8
ba Int
s Int
l)) = PrimVector Word8 -> Text
Text (Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s Int)
-> PrimVector Word8
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
V.createN (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) (\ MArr (IArray PrimVector) s Word8
mba -> do
    Int
i <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeChar MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
mba Int
0 Char
c
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
mba Int
i PrimArray Word8
ba Int
s Int
l
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l))

-- | /O(n)/ Append a char to the end of a text.
snoc :: Text -> Char -> Text
{-# INLINABLE snoc #-}
snoc :: Text -> Char -> Text
snoc (Text (V.PrimVector PrimArray Word8
ba Int
s Int
l)) Char
c = PrimVector Word8 -> Text
Text (Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s Int)
-> PrimVector Word8
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
V.createN (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) (\ MArr (IArray PrimVector) s Word8
mba -> do
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
mba Int
0 PrimArray Word8
ba Int
s Int
l
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeChar MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
mba Int
l Char
c))

-- | /O(1)/ Extract the head and tail of a text, return 'Nothing'
-- if it is empty.
uncons :: Text -> Maybe (Char, Text)
{-# INLINE uncons #-}
uncons :: Text -> Maybe (Char, Text)
uncons (Text (V.PrimVector PrimArray Word8
ba Int
s Int
l))
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Maybe (Char, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (# Char
c, Int
i #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
ba Int
s
        in (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Char
c, PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))

-- | /O(1)/ Extract the init and last of a text, return 'Nothing'
-- if text is empty.
unsnoc :: Text -> Maybe (Text, Char)
{-# INLINE unsnoc #-}
unsnoc :: Text -> Maybe (Text, Char)
unsnoc (Text (V.PrimVector PrimArray Word8
ba Int
s Int
l))
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Maybe (Text, Char)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (# Char
c, Int
i #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeCharReverse PrimArray Word8
ba (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        in (Text, Char) -> Maybe (Text, Char)
forall a. a -> Maybe a
Just (PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)), Char
c)

-- | /O(1)/ Extract the first char of a text.
--
-- Throw 'EmptyText' if text is empty.
head :: Text -> Char
{-# INLINABLE head #-}
head :: Text -> Char
head Text
t = case Text -> Maybe (Char, Text)
uncons Text
t of { Just (Char
c, Text
_) -> Char
c; Maybe (Char, Text)
_ ->  Char
forall a. HasCallStack => a
errorEmptyText }

-- | /O(1)/ Extract the chars after the head of a text.
--
-- Throw 'EmptyText' if text is empty.
tail :: Text -> Text
{-# INLINABLE tail #-}
tail :: Text -> Text
tail Text
t = case Text -> Maybe (Char, Text)
uncons Text
t of { Maybe (Char, Text)
Nothing -> Text
forall a. HasCallStack => a
errorEmptyText; Just (Char
_, Text
t') -> Text
t' }

-- | /O(1)/ Extract the last char of a text.
--
-- Throw 'EmptyText' if text is empty.
last :: Text ->  Char
{-# INLINABLE last #-}
last :: Text -> Char
last Text
t = case Text -> Maybe (Text, Char)
unsnoc Text
t of { Just (Text
_, Char
c) -> Char
c; Maybe (Text, Char)
_ -> Char
forall a. HasCallStack => a
errorEmptyText }

-- | /O(1)/ Extract the chars before of the last one.
--
-- Throw 'EmptyText' if text is empty.
init :: Text -> Text
{-# INLINABLE init #-}
init :: Text -> Text
init Text
t = case Text -> Maybe (Text, Char)
unsnoc Text
t of { Just (Text
t', Char
_) -> Text
t'; Maybe (Text, Char)
_ -> Text
forall a. HasCallStack => a
errorEmptyText }

-- | /O(1)/ Extract the first char of a text.
headMaybe :: Text -> Maybe Char
{-# INLINABLE headMaybe #-}
headMaybe :: Text -> Maybe Char
headMaybe Text
t = case Text -> Maybe (Char, Text)
uncons Text
t of { Just (Char
c, Text
_) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c; Maybe (Char, Text)
_ -> Maybe Char
forall a. Maybe a
Nothing }

-- | /O(1)/ Extract the chars after the head of a text.
--
-- NOTE: 'tailMayEmpty' return empty text in the case of an empty text.
tailMayEmpty :: Text -> Text
{-# INLINABLE tailMayEmpty #-}
tailMayEmpty :: Text -> Text
tailMayEmpty Text
t = case Text -> Maybe (Char, Text)
uncons Text
t of { Maybe (Char, Text)
Nothing -> Text
empty; Just (Char
_, Text
t') -> Text
t' }

-- | /O(1)/ Extract the last char of a text.
lastMaybe :: Text -> Maybe Char
{-# INLINABLE lastMaybe #-}
lastMaybe :: Text -> Maybe Char
lastMaybe Text
t = case Text -> Maybe (Text, Char)
unsnoc Text
t of { Just (Text
_, Char
c) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c; Maybe (Text, Char)
_ -> Maybe Char
forall a. Maybe a
Nothing }

-- | /O(1)/ Extract the chars before of the last one.
--
-- NOTE: 'initMayEmpty' return empty text in the case of an empty text.
initMayEmpty :: Text -> Text
{-# INLINABLE initMayEmpty #-}
initMayEmpty :: Text -> Text
initMayEmpty Text
t = case Text -> Maybe (Text, Char)
unsnoc Text
t of { Just (Text
t', Char
_) -> Text
t'; Maybe (Text, Char)
_ -> Text
empty }

-- | /O(n)/ Return all initial segments of the given text, empty first.
inits :: Text -> [Text]
{-# INLINABLE inits #-}
inits :: Text -> [Text]
inits Text
t0 = Text -> [Text] -> [Text]
go Text
t0 [Text
t0]
  where go :: Text -> [Text] -> [Text]
go Text
t [Text]
acc = case Text -> Maybe (Text, Char)
unsnoc Text
t of Just (Text
t', Char
_) -> Text -> [Text] -> [Text]
go Text
t' (Text
t'Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
acc)
                                    Maybe (Text, Char)
Nothing      -> [Text]
acc

-- | /O(n)/ Return all final segments of the given text, whole text first.
tails :: Text -> [Text]
{-# INLINABLE tails #-}
tails :: Text -> [Text]
tails Text
t = Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: case Text -> Maybe (Char, Text)
uncons Text
t of Just (Char
_, Text
t') -> Text -> [Text]
tails Text
t'
                               Maybe (Char, Text)
Nothing      -> []

-- | /O(1)/ 'take' @n@, applied to a text @xs@, returns the prefix
-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
take :: Int -> Text -> Text
{-# INLINABLE take #-}
take :: Int -> Text -> Text
take Int
n t :: Text
t@(Text (V.PrimVector PrimArray Word8
ba Int
s Int
_))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
    | Bool
otherwise = case Text -> Int -> Int
charByteIndex Text
t Int
n of Int
i -> PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s))

-- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@
-- char, or @[]@ if @n > 'length' xs@.
drop :: Int -> Text -> Text
{-# INLINABLE drop #-}
drop :: Int -> Text -> Text
drop Int
n t :: Text
t@(Text (V.PrimVector PrimArray Word8
ba Int
s Int
l))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
t
    | Bool
otherwise = case Text -> Int -> Int
charByteIndex Text
t Int
n of Int
i -> PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
i (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))

-- | /O(1)/ 'takeR' @n@, applied to a text @xs@, returns the suffix
-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
takeR :: Int -> Text -> Text
{-# INLINABLE takeR #-}
takeR :: Int -> Text -> Text
takeR Int
n t :: Text
t@(Text (V.PrimVector PrimArray Word8
ba Int
s Int
l))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
    | Bool
otherwise = case Text -> Int -> Int
charByteIndexR Text
t Int
n of Int
i -> PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))

-- | /O(1)/ 'dropR' @n xs@ returns the prefix of @xs@ before the last @n@
-- char, or @[]@ if @n > 'length' xs@.
dropR :: Int -> Text -> Text
{-# INLINABLE dropR #-}
dropR :: Int -> Text -> Text
dropR Int
n t :: Text
t@(Text (V.PrimVector PrimArray Word8
ba Int
s Int
_))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
t
    | Bool
otherwise = case Text -> Int -> Int
charByteIndexR Text
t Int
n of Int
i -> PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))

-- | /O(1)/ Extract a sub-range text with give start index and length.
--
-- This function is a total function just like 'take/drop', index/length
-- exceeds range will be ingored, e.g.
--
-- @
-- slice 1 3 "hello"   == "ell"
-- slice -1 -1 "hello" == ""
-- slice -2 2 "hello"  == ""
-- slice 2 10 "hello"  == "llo"
-- @
--
-- This holds for all x y: @slice x y vs == drop x . take (x+y) vs@
slice :: Int -> Int -> Text -> Text
{-# INLINE slice #-}
slice :: Int -> Int -> Text -> Text
slice Int
x Int
y Text
t | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
            | Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
            | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> Text -> Text
take Int
end Text
t
            | Bool
otherwise = Int -> Text -> Text
take Int
y (Int -> Text -> Text
drop Int
x Text
t)
  where
    !end :: Int
end = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y

-- | /O(n)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.
splitAt :: Int -> Text -> (Text, Text)
{-# INLINE splitAt #-}
splitAt :: Int -> Text -> (Text, Text)
splitAt Int
n t :: Text
t@(Text (V.PrimVector PrimArray Word8
ba Int
s Int
l))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text
empty, Text
t)
    | Bool
otherwise = case Text -> Int -> Int
charByteIndex Text
t Int
n of
        Int
i -> (PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)), PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
i (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))


-- | /O(n)/ Applied to a predicate @p@ and a text @t@,
-- returns the longest prefix (possibly empty) of @t@ of elements that
-- satisfy @p@.
takeWhile :: (Char -> Bool) -> Text -> Text
{-# INLINE takeWhile #-}
takeWhile :: (Char -> Bool) -> Text -> Text
takeWhile Char -> Bool
f t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
_)) =
    let !i :: Int
i = (Char -> Bool) -> Text -> Int
findBytesIndex (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) Text
t in PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s Int
i)

-- | /O(n)/ Applied to a predicate @p@ and a text @t@,
-- returns the longest suffix (possibly empty) of @t@ of elements that
-- satisfy @p@.
takeWhileR :: (Char -> Bool) -> Text -> Text
{-# INLINE takeWhileR #-}
takeWhileR :: (Char -> Bool) -> Text -> Text
takeWhileR Char -> Bool
f t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
l)) =
    let !i :: Int
i = (Char -> Bool) -> Text -> Int
findBytesIndexR (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) Text
t in PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))

-- | /O(n)/ Applied to a predicate @p@ and a text @vs@,
-- returns the suffix (possibly empty) remaining after 'takeWhile' @p vs@.
dropWhile :: (Char -> Bool) -> Text -> Text
{-# INLINE dropWhile #-}
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
f t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
_ Int
l)) =
    let !i :: Int
i = (Char -> Bool) -> Text -> Int
findBytesIndex (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) Text
t in PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
i (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))

-- | /O(n)/ Applied to a predicate @p@ and a text @vs@,
-- returns the prefix (possibly empty) remaining before 'takeWhileR' @p vs@.
dropWhileR :: (Char -> Bool) -> Text -> Text
{-# INLINE dropWhileR #-}
dropWhileR :: (Char -> Bool) -> Text -> Text
dropWhileR Char -> Bool
f t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
_)) =
    let !i :: Int
i = (Char -> Bool) -> Text -> Int
findBytesIndexR (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) Text
t in PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s))

-- | /O(n)/ @dropAround f = dropWhile f . dropWhileR f@
dropAround :: (Char -> Bool) -> Text -> Text
{-# INLINE dropAround #-}
dropAround :: (Char -> Bool) -> Text -> Text
dropAround Char -> Bool
f = (Char -> Bool) -> Text -> Text
dropWhileR Char -> Bool
f (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
f

-- | /O(n)/ Split the text into the longest prefix of elements that do not satisfy the predicate and the rest without copying.
break :: (Char -> Bool) -> Text -> (Text, Text)
{-# INLINE break #-}
break :: (Char -> Bool) -> Text -> (Text, Text)
break Char -> Bool
f t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
l)) =
    let !i :: Int
i = (Char -> Bool) -> Text -> Int
findBytesIndex Char -> Bool
f Text
t
    in (PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s Int
i), PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
i (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))

-- | /O(n)/ Split the text into the longest prefix of elements that satisfy the predicate and the rest without copying.
span :: (Char -> Bool) -> Text -> (Text, Text)
{-# INLINE span #-}
span :: (Char -> Bool) -> Text -> (Text, Text)
span Char -> Bool
f = (Char -> Bool) -> Text -> (Text, Text)
break (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)

-- | 'breakR' behaves like 'break' but from the end of the text.
--
-- @breakR p == spanR (not.p)@
breakR :: (Char -> Bool) -> Text -> (Text, Text)
{-# INLINE breakR #-}
breakR :: (Char -> Bool) -> Text -> (Text, Text)
breakR Char -> Bool
f t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
l)) =
    let !i :: Int
i = (Char -> Bool) -> Text -> Int
findBytesIndexR Char -> Bool
f Text
t
    in (PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s Int
i), PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
i (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))

-- | 'spanR' behaves like 'span' but from the end of the text.
spanR :: (Char -> Bool) -> Text -> (Text, Text)
{-# INLINE spanR #-}
spanR :: (Char -> Bool) -> Text -> (Text, Text)
spanR Char -> Bool
f = (Char -> Bool) -> Text -> (Text, Text)
breakR (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)

-- | Break a text on a subtext, returning a pair of the part of the
-- text prior to the match, and the rest of the text, e.g.
--
-- > break "wor" "hello, world" = ("hello, ", "world")
--
breakOn :: Text -> Text -> (Text, Text)
{-# INLINE breakOn #-}
breakOn :: Text -> Text -> (Text, Text)
breakOn (Text PrimVector Word8
needle) (Text PrimVector Word8
haystack) =
    case PrimVector Word8
-> PrimVector Word8 -> (PrimVector Word8, PrimVector Word8)
forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> v a -> (v a, v a)
V.breakOn PrimVector Word8
needle PrimVector Word8
haystack of (PrimVector Word8
v1, PrimVector Word8
v2) -> (PrimVector Word8 -> Text
Text PrimVector Word8
v1, PrimVector Word8 -> Text
Text PrimVector Word8
v2)

-- | O(n+m) Find all non-overlapping instances of needle in haystack. Each element of the returned list consists of a pair:
--
--   * The entire string prior to the kth match (i.e. the prefix)
--   * The kth match, followed by the remainder of the string
--
-- Examples:
--
-- @
-- breakOnAll "::" ""
-- ==> []
-- breakOnAll "/" "a/b/c/"
-- ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
-- @
--
-- The result list is lazy, search is performed when you force the list.
breakOnAll :: Text  -- ^ needle to search for
           -> Text  -- ^ haystack in which to search
           -> [(Text, Text)]
{-# INLINE breakOnAll #-}
breakOnAll :: Text -> Text -> [(Text, Text)]
breakOnAll (Text PrimVector Word8
needle) (Text haystack :: PrimVector Word8
haystack@(V.PrimVector PrimArray Word8
arr Int
s Int
l)) =
    (Int -> (Text, Text)) -> [Int] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
List.map Int -> (Text, Text)
breaker (PrimVector Word8 -> PrimVector Word8 -> Bool -> [Int]
forall (v :: * -> *) a.
(Vec v a, Eq a) =>
v a -> v a -> Bool -> [Int]
V.indices PrimVector Word8
needle PrimVector Word8
haystack Bool
False)
  where
    breaker :: Int -> (Text, Text)
breaker Int
i = (PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)), PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
i (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))

-- | The group function takes a text and returns a list of texts such that the concatenation of the result is equal to the argument. Moreover, each sublist in the result contains only equal elements. For example,
--
-- @
-- group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
-- @
--
-- It is a special case of 'groupBy', which allows the programmer to supply their own equality test.
group :: Text -> [Text]
{-# INLINE group #-}
group :: Text -> [Text]
group = (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | The 'groupBy' function is the non-overloaded version of 'group'.
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
{-# INLINE groupBy #-}
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
f (Text (V.PrimVector PrimArray Word8
arr Int
s Int
l))
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = []
    | Bool
otherwise = PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
s'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
f (PrimVector Word8 -> Text
Text (PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s' (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s')))
  where
    (# Char
c0, Int
s0 #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
arr Int
s
    end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    s' :: Int
s' = PrimArray Word8 -> Int -> Int
go PrimArray Word8
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s0)
    go :: PrimArray Word8 -> Int -> Int
go PrimArray Word8
arr' !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Int
i
        | Bool
otherwise = let (# Char
c1, Int
s1 #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
arr' Int
i
                      in if Char -> Char -> Bool
f Char
c0 Char
c1 then PrimArray Word8 -> Int -> Int
go PrimArray Word8
arr' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s1) else Int
i

-- | /O(n)/ The 'stripPrefix' function takes two texts and returns 'Just'
-- the remainder of the second iff the first is its prefix, and otherwise
-- 'Nothing'.
--
stripPrefix :: Text -> Text -> Maybe Text
{-# INLINE stripPrefix #-}
stripPrefix :: Text -> Text -> Maybe Text
stripPrefix = (PrimVector Word8 -> PrimVector Word8 -> Maybe (PrimVector Word8))
-> Text -> Text -> Maybe Text
coerce ((Vec PrimVector Word8, Eq (PrimVector Word8)) =>
PrimVector Word8 -> PrimVector Word8 -> Maybe (PrimVector Word8)
forall (v :: * -> *) a.
(Vec v a, Eq (v a)) =>
v a -> v a -> Maybe (v a)
V.stripPrefix @V.PrimVector @Word8)


-- | O(n) The 'stripSuffix' function takes two texts and returns Just the remainder of the second iff the first is its suffix, and otherwise Nothing.
stripSuffix :: Text -> Text -> Maybe Text
{-# INLINE stripSuffix #-}
stripSuffix :: Text -> Text -> Maybe Text
stripSuffix = (PrimVector Word8 -> PrimVector Word8 -> Maybe (PrimVector Word8))
-> Text -> Text -> Maybe Text
coerce ((Vec PrimVector Word8, Eq (PrimVector Word8)) =>
PrimVector Word8 -> PrimVector Word8 -> Maybe (PrimVector Word8)
forall (v :: * -> *) a.
(Vec v a, Eq (v a)) =>
v a -> v a -> Maybe (v a)
V.stripSuffix @V.PrimVector @Word8)

-- | /O(n)/ Break a text into pieces separated by the delimiter element
-- consuming the delimiter. I.e.
--
-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
-- > split 'a'  "aXaXaXa"    == ["","X","X","X",""]
-- > split 'x'  "x"          == ["",""]
--
-- and
--
-- > intercalate [c] . split c == id
-- > split == splitWith . (==)
--
-- NOTE, this function behavior different with bytestring's. see
-- <https://github.com/haskell/bytestring/issues/56 #56>.
split :: Char -> Text -> [Text]
{-# INLINE split #-}
split :: Char -> Text -> [Text]
split Char
x = (Char -> Bool) -> Text -> [Text]
splitWith (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
x)

-- | /O(n)/ Splits a text into components delimited by
-- separators, where the predicate returns True for a separator char.
-- The resulting components do not contain the separators.  Two adjacent
-- separators result in an empty component in the output.  eg.
--
-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
-- > splitWith (=='a') []        == [""]
--
splitWith :: (Char -> Bool) -> Text -> [Text]
{-# INLINE splitWith #-}
splitWith :: (Char -> Bool) -> Text -> [Text]
splitWith Char -> Bool
f (Text (V.PrimVector PrimArray Word8
arr Int
s Int
l)) = Int -> Int -> [Text]
go Int
s Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> Int -> [Text]
go !Int
p !Int
q | Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = let !v :: PrimVector Word8
v = PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
p (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
p) in [PrimVector Word8 -> Text
Text PrimVector Word8
v]
             | Char -> Bool
f Char
c       = let !v :: PrimVector Word8
v = PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
p (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
p) in PrimVector Word8 -> Text
Text PrimVector Word8
vText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Int -> Int -> [Text]
go (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)
             | Bool
otherwise = Int -> Int -> [Text]
go Int
p (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)
        where (# Char
c, Int
n #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
arr Int
q

-- | /O(m+n)/ Break haystack into pieces separated by needle.
--
-- Note: An empty needle will essentially split haystack element
-- by element.
--
-- Examples:
--
-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
-- ["a","b","d","e"]
--
-- >>> splitOn "aaa"  "aaaXaaaXaaaXaaa"
-- ["","X","X","X",""]
--
-- >>> splitOn "x"  "x"
-- ["",""]
--
-- and
--
-- > intercalate s . splitOn s         == id
-- > splitOn (singleton c)             == split (==c)
splitOn :: Text -> Text -> [Text]
{-# INLINE splitOn #-}
splitOn :: Text -> Text -> [Text]
splitOn = (PrimVector Word8 -> PrimVector Word8 -> [PrimVector Word8])
-> Text -> Text -> [Text]
coerce ((Vec PrimVector Word8, Eq Word8) =>
PrimVector Word8 -> PrimVector Word8 -> [PrimVector Word8]
forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> v a -> [v a]
V.splitOn @V.PrimVector @Word8)

-- | The 'isPrefix' function returns 'True' if the first argument is a prefix of the second.
isPrefixOf :: Text -> Text -> Bool
{-# INLINE isPrefixOf #-}
isPrefixOf :: Text -> Text -> Bool
isPrefixOf = (PrimVector Word8 -> PrimVector Word8 -> Bool)
-> Text -> Text -> Bool
coerce ((Vec PrimVector Word8, Eq (PrimVector Word8)) =>
PrimVector Word8 -> PrimVector Word8 -> Bool
forall (v :: * -> *) a. (Vec v a, Eq (v a)) => v a -> v a -> Bool
V.isPrefixOf @V.PrimVector @Word8)

-- | /O(n)/ The 'isSuffixOf' function takes two text and returns 'True'
-- if the first is a suffix of the second.
isSuffixOf :: Text -> Text -> Bool
{-# INLINE isSuffixOf #-}
isSuffixOf :: Text -> Text -> Bool
isSuffixOf = (PrimVector Word8 -> PrimVector Word8 -> Bool)
-> Text -> Text -> Bool
coerce ((Vec PrimVector Word8, Eq (PrimVector Word8)) =>
PrimVector Word8 -> PrimVector Word8 -> Bool
forall (v :: * -> *) a. (Vec v a, Eq (v a)) => v a -> v a -> Bool
V.isSuffixOf @V.PrimVector @Word8)

-- | Check whether one text is a subtext of another.
--
-- @needle `isInfixOf` haystack === null haystack || indices needle haystake /= []@.
isInfixOf :: Text -> Text -> Bool
{-# INLINE isInfixOf #-}
isInfixOf :: Text -> Text -> Bool
isInfixOf = (PrimVector Word8 -> PrimVector Word8 -> Bool)
-> Text -> Text -> Bool
coerce ((Vec PrimVector Word8, Eq Word8) =>
PrimVector Word8 -> PrimVector Word8 -> Bool
forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> v a -> Bool
V.isInfixOf @V.PrimVector @Word8)

-- | /O(n)/ Find the longest non-empty common prefix of two strings
-- and return it, along with the suffixes of each string at which they
-- no longer match. e.g.
--
-- >>> commonPrefix "foobar" "fooquux"
-- ("foo","bar","quux")
--
-- >>> commonPrefix "veeble" "fetzer"
-- ("","veeble","fetzer")
commonPrefix :: Text -> Text -> (Text, Text, Text)
{-# INLINE commonPrefix #-}
commonPrefix :: Text -> Text -> (Text, Text, Text)
commonPrefix = (PrimVector Word8
 -> PrimVector Word8
 -> (PrimVector Word8, PrimVector Word8, PrimVector Word8))
-> Text -> Text -> (Text, Text, Text)
coerce ((Vec PrimVector Word8, Eq Word8) =>
PrimVector Word8
-> PrimVector Word8
-> (PrimVector Word8, PrimVector Word8, PrimVector Word8)
forall (v :: * -> *) a.
(Vec v a, Eq a) =>
v a -> v a -> (v a, v a, v a)
V.commonPrefix @V.PrimVector @Word8)

-- | /O(n)/ Breaks a 'Bytes' up into a list of words, delimited by unicode space.
words ::  Text -> [Text]
{-# INLINE words #-}
words :: Text -> [Text]
words (Text (V.PrimVector PrimArray Word8
arr Int
s Int
l)) = Int -> Int -> [Text]
go Int
s Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> Int -> [Text]
go !Int
s' !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end =
                    if Int
s' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end
                    then []
                    else let !v :: PrimVector Word8
v = PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s' (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s') in [PrimVector Word8 -> Text
Text PrimVector Word8
v]
              | Bool
otherwise =
                    let (# Char
c, Int
n #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
arr Int
i
                    in if Char -> Bool
isSpace Char
c
                        then if Int
s' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
                            then Int -> Int -> [Text]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)
                            else let !v :: PrimVector Word8
v = PrimArray Word8 -> Int -> Int -> PrimVector Word8
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s') in PrimVector Word8 -> Text
Text PrimVector Word8
v Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)
                        else Int -> Int -> [Text]
go Int
s' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)

-- | /O(n)/ Breaks a text up into a list of lines, delimited by ascii @\n@.
lines :: Text -> [Text]
{-# INLINE lines #-}
lines :: Text -> [Text]
lines = (PrimVector Word8 -> [PrimVector Word8]) -> Text -> [Text]
coerce PrimVector Word8 -> [PrimVector Word8]
V.lines

-- | /O(n)/ Joins words with ascii space.
unwords :: [Text] -> Text
{-# INLINE unwords #-}
unwords :: [Text] -> Text
unwords = ([PrimVector Word8] -> PrimVector Word8) -> [Text] -> Text
coerce [PrimVector Word8] -> PrimVector Word8
V.unwords

-- | /O(n)/ Joins lines with ascii @\n@.
--
-- NOTE: This functions is different from 'Prelude.unlines', it DOES NOT add a trailing @\n@.
unlines :: [Text] -> Text
{-# INLINE unlines #-}
unlines :: [Text] -> Text
unlines = ([PrimVector Word8] -> PrimVector Word8) -> [Text] -> Text
coerce [PrimVector Word8] -> PrimVector Word8
V.unlines

-- | Add padding to the left so that the whole text's length is at least n.
padLeft :: Int -> Char -> Text -> Text
{-# INLINE padLeft #-}
padLeft :: Int -> Char -> Text -> Text
padLeft Int
n Char
c t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
l))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
tsiz = Text
t
    | Bool
otherwise =
        let psiz :: Int
psiz = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
tsiz)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
csiz
            siz :: Int
siz = Int
psiz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
        in PrimVector Word8 -> Text
Text (Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s ())
-> PrimVector Word8
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create Int
siz (\ MArr (IArray PrimVector) s Word8
marr -> do
            Int
_ <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeChar MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
marr Int
0 Char
c
            MutablePrimArray s Word8 -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()
go MutablePrimArray s Word8
MArr (IArray PrimVector) s Word8
marr Int
csiz Int
psiz
            MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
marr (Int
sizInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l) PrimArray Word8
arr Int
s Int
l))
  where
    tsiz :: Int
tsiz = Text -> Int
length Text
t
    csiz :: Int
csiz = Char -> Int
encodeCharLength Char
c
    go :: forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()
    go :: MutablePrimArray s Word8 -> Int -> Int -> ST s ()
go MutablePrimArray s Word8
marr Int
s' Int
psiz
        | Int
s' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
psiz = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = Int
-> MutablePrimArray s Word8
-> Int
-> MutablePrimArray s Word8
-> Int
-> ST s ()
forall s.
Int
-> MutablePrimArray s Word8
-> Int
-> MutablePrimArray s Word8
-> Int
-> ST s ()
copyChar' Int
csiz MutablePrimArray s Word8
marr Int
s' MutablePrimArray s Word8
marr (Int
s'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
csiz) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutablePrimArray s Word8 -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()
go MutablePrimArray s Word8
marr (Int
s'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
csiz) Int
psiz

-- | Add padding to the right so that the whole text's length is at least n.
padRight :: Int -> Char -> Text -> Text
{-# INLINE padRight #-}
padRight :: Int -> Char -> Text -> Text
padRight Int
n Char
c t :: Text
t@(Text (V.PrimVector PrimArray Word8
arr Int
s Int
l))
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
tsiz = Text
t
    | Bool
otherwise =
        let psiz :: Int
psiz = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
tsiz)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
csiz
            siz :: Int
siz = Int
psiz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
        in PrimVector Word8 -> Text
Text (Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s ())
-> PrimVector Word8
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create Int
siz (\ MArr (IArray PrimVector) s Word8
marr -> do
            MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
marr Int
0 PrimArray Word8
arr Int
s Int
l
            Int
_ <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeChar MutablePrimArray (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
marr Int
l Char
c
            MutablePrimArray s Word8 -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()
go MutablePrimArray s Word8
MArr (IArray PrimVector) s Word8
marr (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
csiz) Int
siz))
  where
    tsiz :: Int
tsiz = Text -> Int
length Text
t
    csiz :: Int
csiz = Char -> Int
encodeCharLength Char
c
    go :: forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()
    go :: MutablePrimArray s Word8 -> Int -> Int -> ST s ()
go MutablePrimArray s Word8
marr Int
s' Int
siz
        | Int
s' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
siz = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = Int
-> MutablePrimArray s Word8
-> Int
-> MutablePrimArray s Word8
-> Int
-> ST s ()
forall s.
Int
-> MutablePrimArray s Word8
-> Int
-> MutablePrimArray s Word8
-> Int
-> ST s ()
copyChar' Int
csiz MutablePrimArray s Word8
marr Int
s' MutablePrimArray s Word8
marr (Int
s'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
csiz) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutablePrimArray s Word8 -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()
go MutablePrimArray s Word8
marr (Int
s'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
csiz) Int
siz


--------------------------------------------------------------------------------
-- Transform

-- | /O(n)/ The 'intersperse' function takes a character and places it
-- between the characters of a 'Text'. Performs replacement on invalid scalar values.
--
intersperse :: Char -> Text -> Text
{-# INLINE intersperse #-}
intersperse :: Char -> Text -> Text
intersperse Char
c = \ t :: Text
t@(Text (V.PrimVector PrimArray Word8
ba Int
s Int
l)) ->
    let tlen :: Int
tlen = Text -> Int
length Text
t
    in if Text -> Int
length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    then Text
t
    else ((forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST (do
            MutablePrimArray s Word8
mbaC <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
4 -- encoded char buf
            Int
clen <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeChar MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mbaC Int
0 Char
c
            MutablePrimArray (PrimState (ST s)) Word8 -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mbaC Int
clen
            PrimArray Word8
baC <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mbaC
            let e :: Int
e = PrimArray Word8 -> Int -> Int
decodeCharLenReverse PrimArray Word8
ba (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
            Text -> ST s Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text)
-> (PrimVector Word8 -> Text) -> PrimVector Word8 -> ST s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimVector Word8 -> Text
Text (PrimVector Word8 -> ST s Text) -> PrimVector Word8 -> ST s Text
forall a b. (a -> b) -> a -> b
$ Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s ())
-> PrimVector Word8
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
tlenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
clen) (PrimArray Word8
-> PrimArray Word8
-> Int
-> Int
-> Int
-> MutablePrimArray s Word8
-> ST s ()
forall s.
PrimArray Word8
-> PrimArray Word8
-> Int
-> Int
-> Int
-> MutablePrimArray s Word8
-> ST s ()
go PrimArray Word8
baC PrimArray Word8
ba Int
s Int
0 (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
e))
        ))
  where
    go :: PrimArray Word8  -- the encode char buf
       -> PrimArray Word8  -- the original text
       -> Int              -- decoding index of original text
       -> Int              -- writing index of new buf
       -> Int              -- the end of decoding index
       -> MutablePrimArray s Word8 -- the new buf
       -> ST s ()
    go :: PrimArray Word8
-> PrimArray Word8
-> Int
-> Int
-> Int
-> MutablePrimArray s Word8
-> ST s ()
go !PrimArray Word8
baC !PrimArray Word8
ba !Int
i !Int
j !Int
end !MutablePrimArray s Word8
mba
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = do
            let l :: Int
l = PrimArray Word8 -> Int -> Int
decodeCharLen PrimArray Word8
ba Int
i
            Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
forall s.
Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
copyChar Int
l MutablePrimArray s Word8
mba Int
j PrimArray Word8
ba Int
i
        | Bool
otherwise = do
            let l :: Int
l = PrimArray Word8 -> Int -> Int
decodeCharLen PrimArray Word8
ba Int
i
            Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
forall s.
Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
copyChar Int
l MutablePrimArray s Word8
mba Int
j PrimArray Word8
ba Int
i
            let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
                j' :: Int
j' = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
            let clen :: Int
clen = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
baC
            Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
forall s.
Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
copyChar Int
clen MutablePrimArray s Word8
mba Int
j' PrimArray Word8
baC Int
0
            PrimArray Word8
-> PrimArray Word8
-> Int
-> Int
-> Int
-> MutablePrimArray s Word8
-> ST s ()
forall s.
PrimArray Word8
-> PrimArray Word8
-> Int
-> Int
-> Int
-> MutablePrimArray s Word8
-> ST s ()
go PrimArray Word8
baC PrimArray Word8
ba Int
i' (Int
j'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
clen) Int
end MutablePrimArray s Word8
mba

-- | /O(n)/ Reverse the characters of a string.
reverse :: Text -> Text
{-# INLINE reverse #-}
reverse :: Text -> Text
reverse = \ (Text (V.PrimVector PrimArray Word8
ba Int
s Int
l)) -> PrimVector Word8 -> Text
Text (PrimVector Word8 -> Text) -> PrimVector Word8 -> Text
forall a b. (a -> b) -> a -> b
$ Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s ())
-> PrimVector Word8
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create Int
l (PrimArray Word8
-> Int -> Int -> Int -> MutablePrimArray s Word8 -> ST s ()
forall s.
PrimArray Word8
-> Int -> Int -> Int -> MutablePrimArray s Word8 -> ST s ()
go PrimArray Word8
ba Int
s Int
l (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l))
  where
    go :: PrimArray Word8 -> Int -> Int -> Int -> MutablePrimArray s Word8 -> ST s ()
    go :: PrimArray Word8
-> Int -> Int -> Int -> MutablePrimArray s Word8 -> ST s ()
go !PrimArray Word8
ba !Int
i !Int
j !Int
end !MutablePrimArray s Word8
mba
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            let l :: Int
l = PrimArray Word8 -> Int -> Int
decodeCharLen PrimArray Word8
ba Int
i
                j' :: Int
j' = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
            Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
forall s.
Int
-> MutablePrimArray s Word8
-> Int
-> PrimArray Word8
-> Int
-> ST s ()
copyChar Int
l MutablePrimArray s Word8
mba Int
j' PrimArray Word8
ba Int
i
            PrimArray Word8
-> Int -> Int -> Int -> MutablePrimArray s Word8 -> ST s ()
forall s.
PrimArray Word8
-> Int -> Int -> Int -> MutablePrimArray s Word8 -> ST s ()
go PrimArray Word8
ba (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) Int
j' Int
end MutablePrimArray s Word8
mba

-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
-- 'Text's and concatenates the list after interspersing the first
-- argument between each element of the list.
intercalate :: Text -> [Text] -> Text
{-# INLINE intercalate #-}
intercalate :: Text -> [Text] -> Text
intercalate Text
s = [Text] -> Text
concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse Text
s

intercalateElem :: Char -> [Text] -> Text
{-# INLINE intercalateElem #-}
intercalateElem :: Char -> [Text] -> Text
intercalateElem Char
c = [Text] -> Text
concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse (Char -> Text
singleton Char
c)

-- | The 'transpose' function transposes the rows and columns of its
-- text argument.
--
transpose :: [Text] -> [Text]
{-# INLINE transpose #-}
transpose :: [Text] -> [Text]
transpose [Text]
ts = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map String -> Text
pack ([String] -> [Text]) -> ([Text] -> [String]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [[a]] -> [[a]]
List.transpose ([String] -> [String])
-> ([Text] -> [String]) -> [Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> String
unpack ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
ts