{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, TypeFamilies #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PartialTypeSignatures #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

-- |
-- Module      : Data.Text
-- Copyright   : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
--               (c) 2009 Duncan Coutts,
--               (c) 2008, 2009 Tom Harper
--               (c) 2021 Andrew Lelechenko
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Portability : GHC
--
-- A time and space-efficient implementation of Unicode text.
-- Suitable for performance critical use, both in terms of large data
-- quantities and high speed.
--
-- /Note/: Read below the synopsis for important notes on the use of
-- this module.
--
-- This module is intended to be imported @qualified@, to avoid name
-- clashes with "Prelude" functions, e.g.
--
-- > import qualified Data.Text as T
--
-- To use an extended and very rich family of functions for working
-- with Unicode text (including normalization, regular expressions,
-- non-standard encodings, text breaking, and locales), see the
-- <http://hackage.haskell.org/package/text-icu text-icu package >.
--

module Data.Text
    (
    -- * Strict vs lazy types
    -- $strict

    -- * Acceptable data
    -- $replacement

    -- * Definition of character
    -- $character_definition

    -- * Fusion
    -- $fusion

    -- * Types
      Text

    -- * Creation and elimination
    , pack
    , unpack
    , singleton
    , empty

    -- * Basic interface
    , cons
    , snoc
    , append
    , uncons
    , unsnoc
    , head
    , last
    , tail
    , init
    , null
    , length
    , compareLength

    -- * Transformations
    , map
    , intercalate
    , intersperse
    , transpose
    , reverse
    , replace

    -- ** Case conversion
    -- $case
    , toCaseFold
    , toLower
    , toUpper
    , toTitle

    -- ** Justification
    , justifyLeft
    , justifyRight
    , center

    -- * Folds
    , foldl
    , foldl'
    , foldl1
    , foldl1'
    , foldr
    , foldr'
    , foldr1

    -- ** Special folds
    , concat
    , concatMap
    , any
    , all
    , maximum
    , minimum

    -- * Construction

    -- ** Scans
    , scanl
    , scanl1
    , scanr
    , scanr1

    -- ** Accumulating maps
    , mapAccumL
    , mapAccumR

    -- ** Generation and unfolding
    , replicate
    , unfoldr
    , unfoldrN

    -- * Substrings

    -- ** Breaking strings
    , take
    , takeEnd
    , drop
    , dropEnd
    , takeWhile
    , takeWhileEnd
    , dropWhile
    , dropWhileEnd
    , dropAround
    , strip
    , stripStart
    , stripEnd
    , splitAt
    , breakOn
    , breakOnEnd
    , break
    , span
    , spanM
    , spanEndM
    , group
    , groupBy
    , inits
    , tails

    -- ** Breaking into many substrings
    -- $split
    , splitOn
    , split
    , chunksOf

    -- ** Breaking into lines and words
    , lines
    --, lines'
    , words
    , unlines
    , unwords

    -- * Predicates
    , isPrefixOf
    , isSuffixOf
    , isInfixOf

    -- ** View patterns
    , stripPrefix
    , stripSuffix
    , commonPrefixes

    -- * Searching
    , filter
    , breakOnAll
    , find
    , elem
    , partition

    -- , findSubstring

    -- * Indexing
    -- $index
    , index
    , findIndex
    , count

    -- * Zipping
    , zip
    , zipWith

    -- -* Ordered text
    -- , sort

    -- * Low level operations
    , copy
    , unpackCString#
    , unpackCStringAscii#

    , measureOff
    ) where

import Prelude (Char, Bool(..), Int, Maybe(..), String,
                Eq, (==), (/=), Ord(..), Ordering(..), (++),
                Monad(..), pure, Read(..),
                (&&), (||), (+), (-), (.), ($), ($!), (>>),
                not, return, otherwise, quot, IO)
import Control.DeepSeq (NFData(rnf))
#if defined(ASSERTS)
import Control.Exception (assert)
#endif
import Data.Bits ((.&.), shiftR, shiftL)
import Data.Char (isSpace, isAscii, ord)
import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
                  Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
import Control.Monad (foldM)
import Control.Monad.ST (ST, runST)
import Control.Monad.ST.Unsafe (unsafeIOToST)
import qualified Data.Text.Array as A
import qualified Data.List as L hiding (head, tail)
import Data.Binary (Binary(get, put))
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Data.Text.Internal.Encoding.Utf8 (utf8Length, utf8LengthByLeader, chr2, chr3, chr4, ord2, ord3, ord4)
import qualified Data.Text.Internal.Fusion as S
import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
import qualified Data.Text.Internal.Fusion.Common as S
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
import Data.Text.Internal.Private (span_)
import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text, append, pack)
import Data.Text.Internal.Unsafe.Char (unsafeWrite, unsafeChr8)
import Data.Text.Show (singleton, unpack, unpackCString#, unpackCStringAscii#)
import qualified Prelude as P
import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord8, reverseIter,
                         reverseIter_, unsafeHead, unsafeTail, iterArray, reverseIterArray)
import Data.Text.Internal.Search (indices)
#if defined(__HADDOCK__)
import Data.ByteString (ByteString)
import qualified Data.Text.Lazy as L
#endif
import Data.Word (Word8)
import Foreign.C.Types
import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt, ByteArray#)
import qualified GHC.Exts as Exts
import GHC.Int (Int8, Int64(..))
import GHC.Stack (HasCallStack)
import qualified Language.Haskell.TH.Lib as TH
import qualified Language.Haskell.TH.Syntax as TH
import Text.Printf (PrintfArg, formatArg, formatString)
import System.Posix.Types (CSsize(..))

#if MIN_VERSION_template_haskell(2,16,0)
import Data.Text.Foreign (asForeignPtr)
import System.IO.Unsafe (unsafePerformIO)
#endif

-- $setup
-- >>> :set -package transformers
-- >>> import Control.Monad.Trans.State
-- >>> import Data.Text
-- >>> import qualified Data.Text as T
-- >>> :seti -XOverloadedStrings

-- $character_definition
--
-- This package uses the term /character/ to denote Unicode /code points/.
--
-- Note that this is not the same thing as a grapheme (e.g. a
-- composition of code points that form one visual symbol). For
-- instance, consider the grapheme \"&#x00e4;\". This symbol has two
-- Unicode representations: a single code-point representation
-- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point),
-- and a two code point representation @U+0061@ (the \"@A@\" code
-- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point).

-- $strict
--
-- This package provides both strict and lazy 'Text' types.  The
-- strict type is provided by the "Data.Text" module, while the lazy
-- type is provided by the "Data.Text.Lazy" module. Internally, the
-- lazy @Text@ type consists of a list of strict chunks.
--
-- The strict 'Text' type requires that an entire string fit into
-- memory at once.  The lazy 'Data.Text.Lazy.Text' type is capable of
-- streaming strings that are larger than memory using a small memory
-- footprint.  In many cases, the overhead of chunked streaming makes
-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
-- counterpart, but this is not always the case.  Sometimes, the time
-- complexity of a function in one module may be different from the
-- other, due to their differing internal structures.
--
-- Each module provides an almost identical API, with the main
-- difference being that the strict module uses 'Int' values for
-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
-- lengths.

-- $replacement
--
-- A 'Text' value is a sequence of Unicode scalar values, as defined
-- in
-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
-- As such, a 'Text' cannot contain values in the range U+D800 to
-- U+DFFF inclusive. Haskell implementations admit all Unicode code
-- points
-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
-- as 'Char' values, including code points from this invalid range.
-- This means that there are some 'Char' values
-- (corresponding to 'Data.Char.Surrogate' category) that are not valid
-- Unicode scalar values, and the functions in this module must handle
-- those cases.
--
-- Within this module, many functions construct a 'Text' from one or
-- more 'Char' values. Those functions will substitute 'Char' values
-- that are not valid Unicode scalar values with the replacement
-- character \"&#xfffd;\" (U+FFFD).  Functions that perform this
-- inspection and replacement are documented with the phrase
-- \"Performs replacement on invalid scalar values\". The functions replace
-- invalid scalar values, instead of dropping them, as a security
-- measure. For details, see
-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)

-- $fusion
--
-- Starting from @text-1.3@ fusion is no longer implicit,
-- and pipelines of transformations usually allocate intermediate 'Text' values.
-- Users, who observe significant changes to performances,
-- are encouraged to use fusion framework explicitly, employing
-- "Data.Text.Internal.Fusion" and "Data.Text.Internal.Fusion.Common".

instance Eq Text where
    Text Array
arrA Int
offA Int
lenA == :: Text -> Text -> Bool
== Text Array
arrB Int
offB Int
lenB
        | Int
lenA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenB = Array -> Int -> Array -> Int -> Int -> Bool
A.equal Array
arrA Int
offA Array
arrB Int
offB Int
lenA
        | Bool
otherwise    = Bool
False
    {-# INLINE (==) #-}

instance Ord Text where
    compare :: Text -> Text -> Ordering
compare = Text -> Text -> Ordering
compareText

instance Read Text where
    readsPrec :: Int -> ReadS Text
readsPrec Int
p String
str = [(String -> Text
pack String
x,String
y) | (String
x,String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str]

-- | @since 1.2.2.0
instance Semigroup Text where
    <> :: Text -> Text -> Text
(<>) = Text -> Text -> Text
append

instance Monoid Text where
    mempty :: Text
mempty  = Text
empty
    mappend :: Text -> Text -> Text
mappend = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Text] -> Text
mconcat = [Text] -> Text
concat

-- | Performs replacement on invalid scalar values:
--
-- >>> :set -XOverloadedStrings
-- >>> "\55555" :: Text
-- "\65533"
instance IsString Text where
    fromString :: String -> Text
fromString = String -> Text
pack

-- | Performs replacement on invalid scalar values:
--
-- >>> :set -XOverloadedLists
-- >>> ['\55555'] :: Text
-- "\65533"
--
-- @since 1.2.0.0
instance Exts.IsList Text where
    type Item Text = Char
    fromList :: [Item Text] -> Text
fromList       = String -> Text
[Item Text] -> Text
pack
    toList :: Text -> [Item Text]
toList         = Text -> String
Text -> [Item Text]
unpack

instance NFData Text where rnf :: Text -> ()
rnf !Text
_ = ()

-- | @since 1.2.1.0
instance Binary Text where
    put :: Text -> Put
put Text
t = ByteString -> Put
forall t. Binary t => t -> Put
put (Text -> ByteString
encodeUtf8 Text
t)
    get :: Get Text
get   = do
      ByteString
bs <- Get ByteString
forall t. Binary t => Get t
get
      case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
        P.Left UnicodeException
exn -> String -> Get Text
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (UnicodeException -> String
forall a. Show a => a -> String
P.show UnicodeException
exn)
        P.Right Text
a -> Text -> Get Text
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
P.return Text
a

-- | This instance preserves data abstraction at the cost of inefficiency.
-- We omit reflection services for the sake of data abstraction.
--
-- This instance was created by copying the updated behavior of
-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
-- feel a mistake has been made, please feel free to submit
-- improvements.
--
-- The original discussion is archived here:
-- <https://mail.haskell.org/pipermail/haskell-cafe/2010-January/072379.html could we get a Data instance for Data.Text.Text? >
--
-- The followup discussion that changed the behavior of 'Data.Set.Set'
-- and 'Data.Map.Map' is archived here:
-- <https://mail.haskell.org/pipermail/libraries/2012-August/018366.html Proposal: Allow gunfold for Data.Map, ... >

instance Data Text where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Text -> c Text
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Text
txt = (String -> Text) -> c (String -> Text)
forall g. g -> c g
z String -> Text
pack c (String -> Text) -> String -> c Text
forall d b. Data d => c (d -> b) -> d -> c b
`f` (Text -> String
unpack Text
txt)
  toConstr :: Text -> Constr
toConstr Text
_ = Constr
packConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Text
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c (String -> Text) -> c Text
forall b r. Data b => c (b -> r) -> c r
k ((String -> Text) -> c (String -> Text)
forall r. r -> c r
z String -> Text
pack)
    Int
_ -> String -> c Text
forall a. HasCallStack => String -> a
P.error String
"gunfold"
  dataTypeOf :: Text -> DataType
dataTypeOf Text
_ = DataType
textDataType

-- | @since 1.2.4.0
instance TH.Lift Text where
#if MIN_VERSION_template_haskell(2,16,0)
  lift :: forall (m :: * -> *). Quote m => Text -> m Exp
lift Text
txt = do
    let (ForeignPtr Word8
ptr, I8
len) = IO (ForeignPtr Word8, I8) -> (ForeignPtr Word8, I8)
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr Word8, I8) -> (ForeignPtr Word8, I8))
-> IO (ForeignPtr Word8, I8) -> (ForeignPtr Word8, I8)
forall a b. (a -> b) -> a -> b
$ Text -> IO (ForeignPtr Word8, I8)
asForeignPtr Text
txt
    let lenInt :: Word
lenInt = I8 -> Word
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral I8
len
    m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE 'unpackCStringLen#) (Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Lit -> m Exp) -> (Bytes -> Lit) -> Bytes -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Lit
TH.bytesPrimL (Bytes -> m Exp) -> Bytes -> m Exp
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Word -> Word -> Bytes
TH.mkBytes ForeignPtr Word8
ptr Word
0 Word
lenInt)) (Word -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word -> m Exp
TH.lift Word
lenInt)
#else
  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack
#endif
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => Text -> Code m Text
liftTyped = m Exp -> Code m Text
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce (m Exp -> Code m Text) -> (Text -> m Exp) -> Text -> Code m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif

#if MIN_VERSION_template_haskell(2,16,0)
unpackCStringLen# :: Exts.Addr# -> Int -> Text
unpackCStringLen# :: Addr# -> Int -> Text
unpackCStringLen# Addr#
addr# Int
l = Array -> Int -> Int -> Text
Text Array
ba Int
0 Int
l
  where
    ba :: Array
ba = (forall s. ST s Array) -> Array
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Array) -> Array)
-> (forall s. ST s Array) -> Array
forall a b. (a -> b) -> a -> b
$ do
      MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
l
      MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
marr Int
0 (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Exts.Ptr Addr#
addr#) Int
l
      MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
{-# NOINLINE unpackCStringLen# #-} -- set as NOINLINE to avoid generated code bloat
#endif

-- | @since 1.2.2.0
instance PrintfArg Text where
  formatArg :: Text -> FieldFormatter
formatArg Text
txt = String -> FieldFormatter
forall a. IsChar a => [a] -> FieldFormatter
formatString (String -> FieldFormatter) -> String -> FieldFormatter
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
txt

packConstr :: Constr
packConstr :: Constr
packConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
textDataType String
"pack" [] Fixity
Prefix

textDataType :: DataType
textDataType :: DataType
textDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Text.Text" [Constr
packConstr]

-- | /O(n)/ Compare two 'Text' values lexicographically.
compareText :: Text -> Text -> Ordering
compareText :: Text -> Text -> Ordering
compareText (Text Array
arrA Int
offA Int
lenA) (Text Array
arrB Int
offB Int
lenB) =
    Array -> Int -> Array -> Int -> Int -> Ordering
A.compare Array
arrA Int
offA Array
arrB Int
offB (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lenA Int
lenB) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lenA Int
lenB
-- This is not a mistake: on contrary to UTF-16 (https://github.com/haskell/text/pull/208),
-- lexicographic ordering of UTF-8 encoded strings matches lexicographic ordering
-- of underlying bytearrays, no decoding is needed.

-- -----------------------------------------------------------------------------
-- * Basic functions

-- | /O(n)/ Adds a character to the front of a 'Text'.  This function
-- is more costly than its 'List' counterpart because it requires
-- copying a new array.  Performs replacement on
-- invalid scalar values.
cons :: Char -> Text -> Text
cons :: Char -> Text -> Text
cons Char
c = Stream Char -> Text
unstream (Stream Char -> Text) -> (Text -> Stream Char) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Stream Char -> Stream Char
S.cons (Char -> Char
safe Char
c) (Stream Char -> Stream Char)
-> (Text -> Stream Char) -> Text -> Stream Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream
{-# INLINE [1] cons #-}

infixr 5 `cons`

-- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the
-- entire array in the process.
-- Performs replacement on invalid scalar values.
snoc :: Text -> Char -> Text
snoc :: Text -> Char -> Text
snoc Text
t Char
c = Stream Char -> Text
unstream (Stream Char -> Char -> Stream Char
S.snoc (Text -> Stream Char
stream Text
t) (Char -> Char
safe Char
c))
{-# INLINE snoc #-}

-- | /O(1)/ Returns the first character of a 'Text', which must be
-- non-empty. This is a partial function, consider using 'uncons' instead.
head :: HasCallStack => Text -> Char
head :: HasCallStack => Text -> Char
head Text
t = HasCallStack => Stream Char -> Char
Stream Char -> Char
S.head (Text -> Stream Char
stream Text
t)
{-# INLINE head #-}

-- | /O(1)/ Returns the first character and rest of a 'Text', or
-- 'Nothing' if empty.
uncons :: Text -> Maybe (Char, Text)
uncons :: Text -> Maybe (Char, Text)
uncons t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Maybe (Char, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just ((Char, Text) -> Maybe (Char, Text))
-> (Char, Text) -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ let !(Iter Char
c Int
d) = Text -> Int -> Iter
iter Text
t Int
0
                         in (Char
c, Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d))
{-# INLINE [1] uncons #-}

-- | /O(1)/ Returns the last character of a 'Text', which must be
-- non-empty. This is a partial function, consider using 'unsnoc' instead.
last :: HasCallStack => Text -> Char
last :: HasCallStack => Text -> Char
last t :: Text
t@(Text Array
_ Int
_ Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = String -> Char
forall a. HasCallStack => String -> a
emptyError String
"last"
    | Bool
otherwise = let Iter Char
c Int
_ = Text -> Int -> Iter
reverseIter Text
t (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in Char
c
{-# INLINE [1] last #-}

-- | /O(1)/ Returns all characters after the head of a 'Text', which
-- must be non-empty. This is a partial function, consider using 'uncons' instead.
tail :: HasCallStack => Text -> Text
tail :: HasCallStack => Text -> Text
tail t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = String -> Text
forall a. HasCallStack => String -> a
emptyError String
"tail"
    | Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d)
    where d :: Int
d = Text -> Int -> Int
iter_ Text
t Int
0
{-# INLINE [1] tail #-}

-- | /O(1)/ Returns all but the last character of a 'Text', which must
-- be non-empty. This is a partial function, consider using 'unsnoc' instead.
init :: HasCallStack => Text -> Text
init :: HasCallStack => Text -> Text
init t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = String -> Text
forall a. HasCallStack => String -> a
emptyError String
"init"
    | Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr Int
off (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int -> Int
reverseIter_ Text
t (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
{-# INLINE [1] init #-}

-- | /O(1)/ Returns all but the last character and the last character of a
-- 'Text', or 'Nothing' if empty.
--
-- @since 1.2.3.0
unsnoc :: Text -> Maybe (Text, Char)
unsnoc :: Text -> Maybe (Text, Char)
unsnoc t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Maybe (Text, Char)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Text, Char) -> Maybe (Text, Char)
forall a. a -> Maybe a
Just (Array -> Int -> Int -> Text
text Array
arr Int
off (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d), Char
c)
        where
            Iter Char
c Int
d = Text -> Int -> Iter
reverseIter Text
t (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE [1] unsnoc #-}

-- | /O(1)/ Tests whether a 'Text' is empty or not.
null :: Text -> Bool
null :: Text -> Bool
null (Text Array
_arr Int
_off Int
len) =
#if defined(ASSERTS)
    assert (len >= 0) $
#endif
    Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
{-# INLINE [1] null #-}

-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
isSingleton :: Text -> Bool
isSingleton :: Text -> Bool
isSingleton = Stream Char -> Bool
S.isSingleton (Stream Char -> Bool) -> (Text -> Stream Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream
{-# INLINE isSingleton #-}

-- | /O(n)/ Returns the number of characters in a 'Text'.
length ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  Text -> Int
length :: Text -> Int
length = Int -> Int
forall a. Num a => a -> a
P.negate (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Int
measureOff Int
forall a. Bounded a => a
P.maxBound
{-# INLINE [1] length #-}
-- length needs to be phased after the compareN/length rules otherwise
-- it may inline before the rules have an opportunity to fire.

{-# RULES
"TEXT length/filter -> S.length/S.filter" forall p t.
    length (filter p t) = S.length (S.filter p (stream t))
"TEXT length/unstream -> S.length" forall t.
    length (unstream t) = S.length t
"TEXT length/pack -> P.length" forall t.
    length (pack t) = P.length t
"TEXT length/map -> length" forall f t.
    length (map f t) = length t
"TEXT length/zipWith -> length" forall f t1 t2.
    length (zipWith f t1 t2) = min (length t1) (length t2)
"TEXT length/replicate -> n" forall n t.
    length (replicate n t) = mul (max 0 n) (length t)
"TEXT length/cons -> length+1" forall c t.
    length (cons c t) = 1 + length t
"TEXT length/intersperse -> 2*length-1" forall c t.
    length (intersperse c t) = max 0 (mul 2 (length t) - 1)
"TEXT length/intercalate -> n*length" forall s ts.
    length (intercalate s ts) = let lenS = length s in max 0 (P.sum (P.map (\t -> length t + lenS) ts) - lenS)
  #-}

-- | /O(min(n,c))/ Compare the count of characters in a 'Text' to a number.
--
-- @
-- 'compareLength' t c = 'P.compare' ('length' t) c
-- @
--
-- This function gives the same answer as comparing against the result
-- of 'length', but can short circuit if the count of characters is
-- greater than the number, and hence be more efficient.
compareLength :: Text -> Int -> Ordering
compareLength :: Text -> Int -> Ordering
compareLength Text
t Int
c = Stream Char -> Int -> Ordering
forall a. Integral a => Stream Char -> a -> Ordering
S.compareLengthI (Text -> Stream Char
stream Text
t) Int
c
{-# INLINE [1] compareLength #-}

{-# RULES
"TEXT compareN/length -> compareLength" [~1] forall t n.
    compare (length t) n = compareLength t n
  #-}

{-# RULES
"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
    eqInt (length t) n = compareLength t n == EQ
  #-}

{-# RULES
"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
    neInt (length t) n = compareLength t n /= EQ
  #-}

{-# RULES
"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
    ltInt (length t) n = compareLength t n == LT
  #-}

{-# RULES
"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
    leInt (length t) n = compareLength t n /= GT
  #-}

{-# RULES
"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
    gtInt (length t) n = compareLength t n == GT
  #-}

{-# RULES
"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
    geInt (length t) n = compareLength t n /= LT
  #-}

-- -----------------------------------------------------------------------------
-- * Transformations
-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
-- each element of @t@.
--
-- Example:
--
-- >>> let message = pack "I am not angry. Not at all."
-- >>> T.map (\c -> if c == '.' then '!' else c) message
-- "I am not angry! Not at all!"
--
-- Performs replacement on invalid scalar values.
map :: (Char -> Char) -> Text -> Text
map :: (Char -> Char) -> Text -> Text
map Char -> Char
f = Text -> Text
go
  where
    go :: Text -> Text
go (Text Array
src Int
o Int
l) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
      MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
      MArray s -> Int -> Int -> Int -> ST s Text
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
marr (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
o Int
0
      where
        outer :: forall s. A.MArray s -> Int -> Int -> Int -> ST s Text
        outer :: forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer !MArray s
dst !Int
dstLen = Int -> Int -> ST s Text
inner
          where
            inner :: Int -> Int -> ST s Text
inner !Int
srcOff !Int
dstOff
              | Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o = do
                MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
                Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
                Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
              | Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
                let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
                MArray s
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
                MArray s -> Int -> Int -> Int -> ST s Text
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
dst' Int
dstLen' Int
srcOff Int
dstOff
              | Bool
otherwise = do
                let !(Iter Char
c Int
d) = Array -> Int -> Iter
iterArray Array
src Int
srcOff
                Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff (Char -> Char
safe (Char -> Char
f Char
c))
                Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d')
{-# INLINE [1] map #-}

{-# RULES
"TEXT map/map -> map" forall f g t.
    map f (map g t) = map (f . safe . g) t
#-}

-- | /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.
--
-- Example:
--
-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]
-- "WeNI!seekNI!theNI!HolyNI!Grail"
intercalate :: Text -> [Text] -> Text
intercalate :: Text -> [Text] -> Text
intercalate Text
t = [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]
L.intersperse Text
t
{-# INLINE [1] intercalate #-}

-- | /O(n)/ The 'intersperse' function takes a character and places it
-- between the characters of a 'Text'.
--
-- Example:
--
-- >>> T.intersperse '.' "SHIELD"
-- "S.H.I.E.L.D"
--
-- Performs replacement on invalid scalar values.
intersperse :: Char -> Text -> Text
intersperse :: Char -> Text -> Text
intersperse Char
c t :: Text
t@(Text Array
src Int
o Int
l) = if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
forall a. Monoid a => a
mempty else (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
    let !cLen :: Int
cLen = Char -> Int
utf8Length Char
c
        dstLen :: Int
dstLen = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
cLen

    MArray s
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
dstLen

    let writeSep :: Int -> ST s ()
writeSep = case Int
cLen of
          Int
1 -> \Int
dstOff ->
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff (Char -> Word8
ord8 Char
c)
          Int
2 -> let (Word8
c0, Word8
c1) = Char -> (Word8, Word8)
ord2 Char
c in \Int
dstOff -> do
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
c0
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
c1
          Int
3 -> let (Word8
c0, Word8
c1, Word8
c2) = Char -> (Word8, Word8, Word8)
ord3 Char
c in \Int
dstOff -> do
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
c0
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
c1
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
c2
          Int
_ -> let (Word8
c0, Word8
c1, Word8
c2, Word8
c3) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c in \Int
dstOff -> do
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
c0
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
c1
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
c2
            MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
c3
    let go :: Int -> Int -> ST s ()
go !Int
srcOff !Int
dstOff = if Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return () else do
          let m0 :: Word8
m0 = Array -> Int -> Word8
A.unsafeIndex Array
src Int
srcOff
              m1 :: Word8
m1 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
              m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
              !d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
          case Int
d of
            Int
1 -> do
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
              Int -> ST s ()
writeSep (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Int -> Int -> ST s ()
go (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cLen)
            Int
2 -> do
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
              Int -> ST s ()
writeSep (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
              Int -> Int -> ST s ()
go (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cLen)
            Int
3 -> do
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
              Int -> ST s ()
writeSep (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
              Int -> Int -> ST s ()
go (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cLen)
            Int
_ -> do
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
              MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
              Int -> ST s ()
writeSep (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
              Int -> Int -> ST s ()
go (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cLen)

    Int -> Int -> ST s ()
go Int
o Int
0
    Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
    Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cLen))
{-# INLINE [1] intersperse #-}

-- | /O(n)/ Reverse the characters of a string.
--
-- Example:
--
-- >>> T.reverse "desrever"
-- "reversed"
reverse ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  Text -> Text
reverse :: Text -> Text
reverse (Text (A.ByteArray ByteArray#
ba) Int
off Int
len) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
    marr :: MArray s
marr@(A.MutableByteArray MutableByteArray# s
mba) <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
    IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
forall s.
MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
c_reverse MutableByteArray# s
mba ByteArray#
ba (Int -> CSize
intToCSize Int
off) (Int -> CSize
intToCSize Int
len)
    Array
brr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
    Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
brr Int
0 Int
len
{-# INLINE reverse #-}

-- | The input buffer (src :: ByteArray#, off :: CSize, len :: CSize)
-- must specify a valid UTF-8 sequence, this condition is not checked.
foreign import ccall unsafe "_hs_text_reverse" c_reverse
    :: Exts.MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()

-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
-- @haystack@ with @replacement@.
--
-- This function behaves as though it was defined as follows:
--
-- @
-- replace needle replacement haystack =
--   'intercalate' replacement ('splitOn' needle haystack)
-- @
--
-- As this suggests, each occurrence is replaced exactly once.  So if
-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
-- be replaced recursively:
--
-- >>> replace "oo" "foo" "oo"
-- "foo"
--
-- In cases where several instances of @needle@ overlap, only the
-- first one will be replaced:
--
-- >>> replace "ofo" "bar" "ofofo"
-- "barfo"
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
replace :: HasCallStack
        => Text
        -- ^ @needle@ to search for.  If this string is empty, an
        -- error will occur.
        -> Text
        -- ^ @replacement@ to replace @needle@ with.
        -> Text
        -- ^ @haystack@ in which to search.
        -> Text
replace :: HasCallStack => Text -> Text -> Text -> Text
replace needle :: Text
needle@(Text Array
_      Int
_      Int
neeLen)
               (Text Array
repArr Int
repOff Int
repLen)
      haystack :: Text
haystack@(Text Array
hayArr Int
hayOff Int
hayLen)
  | Int
neeLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> Text
forall a. HasCallStack => String -> a
emptyError String
"replace"
  | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Int]
ixs  = Text
haystack
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Array -> Int -> Int -> Text
Text ((forall s. ST s (MArray s)) -> Array
A.run ST s (MArray s)
forall s. ST s (MArray s)
x) Int
0 Int
len
  | Bool
otherwise   = Text
empty
  where
    ixs :: [Int]
ixs = Text -> Text -> [Int]
indices Text
needle Text
haystack
    len :: Int
len = Int
hayLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
neeLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
repLen) Int -> Int -> Int
`mul` [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Int]
ixs
    x :: ST s (A.MArray s)
    x :: forall s. ST s (MArray s)
x = do
      MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
      let loop :: [Int] -> Int -> Int -> ST s ()
loop (Int
i:[Int]
is) Int
o Int
d = do
            let d0 :: Int
d0 = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o
                d1 :: Int
d1 = Int
d0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
repLen
            Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o) MArray s
marr Int
d  Array
hayArr (Int
hayOffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o)
            Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
repLen  MArray s
marr Int
d0 Array
repArr Int
repOff
            [Int] -> Int -> Int -> ST s ()
loop [Int]
is (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
neeLen) Int
d1
          loop []     Int
o Int
d = Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d) MArray s
marr Int
d Array
hayArr (Int
hayOffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o)
      [Int] -> Int -> Int -> ST s ()
loop [Int]
ixs Int
0 Int
0
      MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr

-- ----------------------------------------------------------------------------
-- ** Case conversions (folds)

-- $case
--
-- When case converting 'Text' values, do not use combinators like
-- @map toUpper@ to case convert each character of a string
-- individually, as this gives incorrect results according to the
-- rules of some writing systems.  The whole-string case conversion
-- functions from this module, such as @toUpper@, obey the correct
-- case conversion rules.  As a result, these functions may map one
-- input character to two or three output characters. For examples,
-- see the documentation of each function.
--
-- /Note/: In some languages, case conversion is a locale- and
-- context-dependent operation. The case conversion functions in this
-- module are /not/ locale sensitive. Programs that require locale
-- sensitivity should use appropriate versions of the
-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.

caseConvert :: (Word8 -> Word8) -> (Exts.Char# -> _ {- unboxed Int64 -}) -> Text -> Text
caseConvert :: (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert Word8 -> Word8
ascii Char# -> Int64#
remap (Text Array
src Int
o Int
l) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
  -- Case conversion a single code point may produce up to 3 code-points,
  -- each up to 4 bytes, so 12 in total.
  MArray s
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
  MArray s -> Int -> Int -> Int -> ST s Text
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
dst Int
l Int
o Int
0
  where
    outer :: forall s. A.MArray s -> Int -> Int -> Int -> ST s Text
    outer :: forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer !MArray s
dst !Int
dstLen = Int -> Int -> ST s Text
inner
      where
        inner :: Int -> Int -> ST s Text
inner !Int
srcOff !Int
dstOff
          | Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l = do
            MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
            Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
            Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
          | Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
            -- Ensure to extend the buffer by at least 12 bytes.
            let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
12 (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff)
            MArray s
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
            MArray s -> Int -> Int -> Int -> ST s Text
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
dst' Int
dstLen' Int
srcOff Int
dstOff
          -- If a character is to remain unchanged, no need to decode Char back into UTF8,
          -- just copy bytes from input.
          | Bool
otherwise = do
            let m0 :: Word8
m0 = Array -> Int -> Word8
A.unsafeIndex Array
src Int
srcOff
                m1 :: Word8
m1 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                !d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
            case Int
d of
              Int
1 -> do
                MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff (Word8 -> Word8
ascii Word8
m0)
                Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Int
2 -> do
                let !(Exts.C# Char#
c) = Word8 -> Word8 -> Char
chr2 Word8
m0 Word8
m1
                Int
dstOff' <- case Int64# -> Int64
I64# (Char# -> Int64#
remap Char#
c) of
                  Int64
0 -> do
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
                    Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                  Int64
i -> Int64 -> Int -> ST s Int
writeMapping Int64
i Int
dstOff
                Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
dstOff'
              Int
3 -> do
                let !(Exts.C# Char#
c) = Word8 -> Word8 -> Word8 -> Char
chr3 Word8
m0 Word8
m1 Word8
m2
                Int
dstOff' <- case Int64# -> Int64
I64# (Char# -> Int64#
remap Char#
c) of
                  Int64
0 -> do
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
                    Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
                  Int64
i -> Int64 -> Int -> ST s Int
writeMapping Int64
i Int
dstOff
                Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
dstOff'
              Int
_ -> do
                let !(Exts.C# Char#
c) = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
m0 Word8
m1 Word8
m2 Word8
m3
                Int
dstOff' <- case Int64# -> Int64
I64# (Char# -> Int64#
remap Char#
c) of
                  Int64
0 -> do
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
                    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
                    Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
                  Int64
i -> Int64 -> Int -> ST s Int
writeMapping Int64
i Int
dstOff
                Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
dstOff'

        writeMapping :: Int64 -> Int -> ST s Int
        writeMapping :: Int64 -> Int -> ST s Int
writeMapping Int64
0 Int
dstOff = Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
dstOff
        writeMapping Int64
i Int
dstOff = do
          let (Char
ch, Int64
j) = Int64 -> (Char, Int64)
chopOffChar Int64
i
          Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff Char
ch
          Int64 -> Int -> ST s Int
writeMapping Int64
j (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d)

        chopOffChar :: Int64 -> (Char, Int64)
        chopOffChar :: Int64 -> (Char, Int64)
chopOffChar Int64
ab = (Int -> Char
chr Int
a, Int64
ab Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
21)
          where
            chr :: Int -> Char
chr (Exts.I# Int#
n) = Char# -> Char
Exts.C# (Int# -> Char#
Exts.chr# Int#
n)
            mask :: Int64
mask = (Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1
            a :: Int
a = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
ab Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
mask
{-# INLINE caseConvert #-}

-- | /O(n)/ Convert a string to folded case.
--
-- This function is mainly useful for performing caseless (also known
-- as case insensitive) string comparisons.
--
-- A string @x@ is a caseless match for a string @y@ if and only if:
--
-- @toCaseFold x == toCaseFold y@
--
-- The result string may be longer than the input string, and may
-- differ from applying 'toLower' to the input string.  For instance,
-- the Armenian small ligature \"&#xfb13;\" (men now, U+FB13) is case
-- folded to the sequence \"&#x574;\" (men, U+0574) followed by
-- \"&#x576;\" (now, U+0576), while the Greek \"&#xb5;\" (micro sign,
-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
-- instead of itself.
toCaseFold :: Text -> Text
toCaseFold :: Text -> Text
toCaseFold = (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) Char# -> Int64#
foldMapping
{-# INLINE toCaseFold #-}

-- | /O(n)/ Convert a string to lower case, using simple case
-- conversion.
--
-- The result string may be longer than the input string.  For
-- instance, \"&#x130;\" (Latin capital letter I with dot above,
-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
-- followed by \" &#x307;\" (combining dot above, U+0307).
toLower :: Text -> Text
toLower :: Text -> Text
toLower = (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) Char# -> Int64#
lowerMapping
{-# INLINE toLower #-}

-- | /O(n)/ Convert a string to upper case, using simple case
-- conversion.
--
-- The result string may be longer than the input string.  For
-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
-- two-letter sequence \"SS\".
toUpper :: Text -> Text
toUpper :: Text -> Text
toUpper = (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
97 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
32 else Word8
w) Char# -> Int64#
upperMapping
{-# INLINE toUpper #-}

-- | /O(n)/ Convert a string to title case, using simple case
-- conversion.
--
-- The first letter (as determined by 'Data.Char.isLetter')
-- of the input is converted to title case, as is
-- every subsequent letter that immediately follows a non-letter.
-- Every letter that immediately follows another letter is converted
-- to lower case.
--
-- This function is not idempotent.
-- Consider lower-case letter @ʼn@ (U+0149 LATIN SMALL LETTER N PRECEDED BY APOSTROPHE).
-- Then 'T.toTitle' @"ʼn"@ = @"ʼN"@: the first (and the only) letter of the input
-- is converted to title case, becoming two letters.
-- Now @ʼ@ (U+02BC MODIFIER LETTER APOSTROPHE) is a modifier letter
-- and as such is recognised as a letter by 'Data.Char.isLetter',
-- so 'T.toTitle' @"ʼN"@ = @"'n"@.
--
-- The result string may be longer than the input string. For example,
-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
-- sequence Latin capital letter F (U+0046) followed by Latin small
-- letter l (U+006C).
--
-- /Note/: this function does not take language or culture specific
-- rules into account. For instance, in English, different style
-- guides disagree on whether the book name \"The Hill of the Red
-- Fox\" is correctly title cased&#x2014;but this function will
-- capitalize /every/ word.
--
-- @since 1.0.0.0
toTitle :: Text -> Text
toTitle :: Text -> Text
toTitle Text
t = Stream Char -> Text
unstream (Stream Char -> Stream Char
S.toTitle (Text -> Stream Char
stream Text
t))
{-# INLINE toTitle #-}

-- | /O(n)/ Left-justify a string to the given length, using the
-- specified fill character on the right.
-- Performs replacement on invalid scalar values.
--
-- Examples:
--
-- >>> justifyLeft 7 'x' "foo"
-- "fooxxxx"
--
-- >>> justifyLeft 3 'x' "foobar"
-- "foobar"
justifyLeft :: Int -> Char -> Text -> Text
justifyLeft :: Int -> Char -> Text -> Text
justifyLeft Int
k Char
c Text
t
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k  = Text
t
    | Bool
otherwise = Text
t Text -> Text -> Text
`append` Int -> Char -> Text
replicateChar (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len) Char
c
  where len :: Int
len = Text -> Int
length Text
t
{-# INLINE [1] justifyLeft #-}

-- | /O(n)/ Right-justify a string to the given length, using the
-- specified fill character on the left.  Performs replacement on
-- invalid scalar values.
--
-- Examples:
--
-- >>> justifyRight 7 'x' "bar"
-- "xxxxbar"
--
-- >>> justifyRight 3 'x' "foobar"
-- "foobar"
justifyRight :: Int -> Char -> Text -> Text
justifyRight :: Int -> Char -> Text -> Text
justifyRight Int
k Char
c Text
t
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k  = Text
t
    | Bool
otherwise = Int -> Char -> Text
replicateChar (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len) Char
c Text -> Text -> Text
`append` Text
t
  where len :: Int
len = Text -> Int
length Text
t
{-# INLINE justifyRight #-}

-- | /O(n)/ Center a string to the given length, using the specified
-- fill character on either side.  Performs replacement on invalid
-- scalar values.
--
-- Examples:
--
-- >>> center 8 'x' "HS"
-- "xxxHSxxx"
center :: Int -> Char -> Text -> Text
center :: Int -> Char -> Text -> Text
center Int
k Char
c Text
t
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k  = Text
t
    | Bool
otherwise = Int -> Char -> Text
replicateChar Int
l Char
c Text -> Text -> Text
`append` Text
t Text -> Text -> Text
`append` Int -> Char -> Text
replicateChar Int
r Char
c
  where len :: Int
len = Text -> Int
length Text
t
        d :: Int
d   = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len
        r :: Int
r   = Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
        l :: Int
l   = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
{-# INLINE center #-}

-- | /O(n)/ The 'transpose' function transposes the rows and columns
-- of its 'Text' argument.  Note that this function uses 'pack',
-- 'unpack', and the list version of transpose, and is thus not very
-- efficient.
--
-- Examples:
--
-- >>> transpose ["green","orange"]
-- ["go","rr","ea","en","ng","e"]
--
-- >>> transpose ["blue","red"]
-- ["br","le","ud","e"]
transpose :: [Text] -> [Text]
transpose :: [Text] -> [Text]
transpose [Text]
ts = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
P.map String -> Text
pack ([String] -> [String]
forall a. [[a]] -> [[a]]
L.transpose ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
P.map Text -> String
unpack [Text]
ts))

-- -----------------------------------------------------------------------------
-- * Reducing 'Text's (folds)

-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
-- (typically the left-identity of the operator), and a 'Text',
-- reduces the 'Text' using the binary operator, from left to right.
foldl :: (a -> Char -> a) -> a -> Text -> a
foldl :: forall a. (a -> Char -> a) -> a -> Text -> a
foldl a -> Char -> a
f a
z Text
t = (a -> Char -> a) -> a -> Stream Char -> a
forall b. (b -> Char -> b) -> b -> Stream Char -> b
S.foldl a -> Char -> a
f a
z (Text -> Stream Char
stream Text
t)
{-# INLINE foldl #-}

-- | /O(n)/ A strict version of 'foldl'.
foldl' :: (a -> Char -> a) -> a -> Text -> a
foldl' :: forall a. (a -> Char -> a) -> a -> Text -> a
foldl' a -> Char -> a
f a
z Text
t = (a -> Char -> a) -> a -> Stream Char -> a
forall b. (b -> Char -> b) -> b -> Stream Char -> b
S.foldl' a -> Char -> a
f a
z (Text -> Stream Char
stream Text
t)
{-# INLINE foldl' #-}

-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
-- and thus must be applied to a non-empty 'Text'.
foldl1 :: HasCallStack => (Char -> Char -> Char) -> Text -> Char
foldl1 :: HasCallStack => (Char -> Char -> Char) -> Text -> Char
foldl1 Char -> Char -> Char
f Text
t = HasCallStack => (Char -> Char -> Char) -> Stream Char -> Char
(Char -> Char -> Char) -> Stream Char -> Char
S.foldl1 Char -> Char -> Char
f (Text -> Stream Char
stream Text
t)
{-# INLINE foldl1 #-}

-- | /O(n)/ A strict version of 'foldl1'.
foldl1' :: HasCallStack => (Char -> Char -> Char) -> Text -> Char
foldl1' :: HasCallStack => (Char -> Char -> Char) -> Text -> Char
foldl1' Char -> Char -> Char
f Text
t = HasCallStack => (Char -> Char -> Char) -> Stream Char -> Char
(Char -> Char -> Char) -> Stream Char -> Char
S.foldl1' Char -> Char -> Char
f (Text -> Stream Char
stream Text
t)
{-# INLINE foldl1' #-}

-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
-- (typically the right-identity of the operator), and a 'Text',
-- reduces the 'Text' using the binary operator, from right to left.
--
-- If the binary operator is strict in its second argument, use 'foldr''
-- instead.
--
-- 'foldr' is lazy like 'Data.List.foldr' for lists: evaluation actually
-- traverses the 'Text' from left to right, only as far as it needs to.
--
-- For example, 'head' can be defined with /O(1)/ complexity using 'foldr':
--
-- @
-- head :: Text -> Char
-- head = foldr const (error "head empty")
-- @
--
-- Searches from left to right with short-circuiting behavior can
-- also be defined using 'foldr' (/e.g./, 'any', 'all', 'find', 'elem').
foldr :: (Char -> a -> a) -> a -> Text -> a
foldr :: forall a. (Char -> a -> a) -> a -> Text -> a
foldr Char -> a -> a
f a
z Text
t = (Char -> a -> a) -> a -> Stream Char -> a
forall b. (Char -> b -> b) -> b -> Stream Char -> b
S.foldr Char -> a -> a
f a
z (Text -> Stream Char
stream Text
t)
{-# INLINE foldr #-}

-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
-- and thus must be applied to a non-empty 'Text'.
foldr1 :: HasCallStack => (Char -> Char -> Char) -> Text -> Char
foldr1 :: HasCallStack => (Char -> Char -> Char) -> Text -> Char
foldr1 Char -> Char -> Char
f Text
t = HasCallStack => (Char -> Char -> Char) -> Stream Char -> Char
(Char -> Char -> Char) -> Stream Char -> Char
S.foldr1 Char -> Char -> Char
f (Text -> Stream Char
stream Text
t)
{-# INLINE foldr1 #-}

-- | /O(n)/ A strict version of 'foldr'.
--
-- 'foldr'' evaluates as a right-to-left traversal using constant stack space.
--
-- @since 2.0.1
foldr' :: (Char -> a -> a) -> a -> Text -> a
foldr' :: forall a. (Char -> a -> a) -> a -> Text -> a
foldr' Char -> a -> a
f a
z Text
t = (a -> Char -> a) -> a -> Stream Char -> a
forall b. (b -> Char -> b) -> b -> Stream Char -> b
S.foldl' ((Char -> a -> a) -> a -> Char -> a
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip Char -> a -> a
f) a
z (Text -> Stream Char
reverseStream Text
t)
{-# INLINE foldr' #-}

-- -----------------------------------------------------------------------------
-- ** Special folds

-- | /O(n)/ Concatenate a list of 'Text's.
concat :: [Text] -> Text
concat :: [Text] -> Text
concat [Text]
ts = case [Text]
ts' of
              [] -> Text
empty
              [Text
t] -> Text
t
              [Text]
_ -> Array -> Int -> Int -> Text
Text ((forall s. ST s (MArray s)) -> Array
A.run ST s (MArray s)
forall s. ST s (MArray s)
go) Int
0 Int
len
  where
    ts' :: [Text]
ts' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null) [Text]
ts
    len :: Int
len = String -> [Int] -> Int
sumP String
"concat" ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
L.map Text -> Int
lengthWord8 [Text]
ts'
    go :: ST s (A.MArray s)
    go :: forall s. ST s (MArray s)
go = do
      MArray s
arr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
      let step :: Int -> Text -> ST s Int
step Int
i (Text Array
a Int
o Int
l) = Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
l MArray s
arr Int
i Array
a Int
o ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l)
      (Int -> Text -> ST s Int) -> Int -> [Text] -> ST s Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> Text -> ST s Int
step Int
0 [Text]
ts' ST s Int -> ST s (MArray s) -> ST s (MArray s)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
arr

-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
-- concatenate the results.
concatMap :: (Char -> Text) -> Text -> Text
concatMap :: (Char -> Text) -> Text -> Text
concatMap Char -> Text
f = [Text] -> Text
concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Text] -> [Text]) -> [Text] -> Text -> [Text]
forall a. (Char -> a -> a) -> a -> Text -> a
foldr ((:) (Text -> [Text] -> [Text])
-> (Char -> Text) -> Char -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
f) []
{-# INLINE concatMap #-}

-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
-- 'Text' @t@ satisfies the predicate @p@.
any :: (Char -> Bool) -> Text -> Bool
any :: (Char -> Bool) -> Text -> Bool
any Char -> Bool
p Text
t = (Char -> Bool) -> Stream Char -> Bool
S.any Char -> Bool
p (Text -> Stream Char
stream Text
t)
{-# INLINE any #-}

-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
-- 'Text' @t@ satisfy the predicate @p@.
all :: (Char -> Bool) -> Text -> Bool
all :: (Char -> Bool) -> Text -> Bool
all Char -> Bool
p Text
t = (Char -> Bool) -> Stream Char -> Bool
S.all Char -> Bool
p (Text -> Stream Char
stream Text
t)
{-# INLINE all #-}

-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
-- must be non-empty.
maximum :: HasCallStack => Text -> Char
maximum :: HasCallStack => Text -> Char
maximum Text
t = HasCallStack => Stream Char -> Char
Stream Char -> Char
S.maximum (Text -> Stream Char
stream Text
t)
{-# INLINE maximum #-}

-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
-- must be non-empty.
minimum :: HasCallStack => Text -> Char
minimum :: HasCallStack => Text -> Char
minimum Text
t = HasCallStack => Stream Char -> Char
Stream Char -> Char
S.minimum (Text -> Stream Char
stream Text
t)
{-# INLINE minimum #-}

-- -----------------------------------------------------------------------------
-- * Building 'Text's
-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
-- successive reduced values from the left.
-- Performs replacement on invalid scalar values.
--
-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
--
-- __Properties__
--
-- @'head' ('scanl' f z xs) = z@
--
-- @'last' ('scanl' f z xs) = 'foldl' f z xs@
scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
scanl Char -> Char -> Char
f Char
z Text
t = Stream Char -> Text
unstream ((Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
S.scanl Char -> Char -> Char
g Char
z (Text -> Stream Char
stream Text
t))
    where g :: Char -> Char -> Char
g Char
a Char
b = Char -> Char
safe (Char -> Char -> Char
f Char
a Char
b)
{-# INLINE scanl #-}

-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
-- value argument. Performs replacement on invalid scalar values.
--
-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
scanl1 :: (Char -> Char -> Char) -> Text -> Text
scanl1 :: (Char -> Char -> Char) -> Text -> Text
scanl1 Char -> Char -> Char
f Text
t | Text -> Bool
null Text
t    = Text
empty
           | Bool
otherwise = (Char -> Char -> Char) -> Char -> Text -> Text
scanl Char -> Char -> Char
f (Text -> Char
unsafeHead Text
t) (Text -> Text
unsafeTail Text
t)
{-# INLINE scanl1 #-}

-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.  Performs
-- replacement on invalid scalar values.
--
-- > scanr f v == reverse . scanl (flip f) v . reverse
scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
scanr Char -> Char -> Char
f Char
z = Stream Char -> Text
S.reverse (Stream Char -> Text) -> (Text -> Stream Char) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
S.reverseScanr Char -> Char -> Char
g Char
z (Stream Char -> Stream Char)
-> (Text -> Stream Char) -> Text -> Stream Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
reverseStream
    where g :: Char -> Char -> Char
g Char
a Char
b = Char -> Char
safe (Char -> Char -> Char
f Char
a Char
b)
{-# INLINE scanr #-}

-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
-- value argument. Performs replacement on invalid scalar values.
scanr1 :: (Char -> Char -> Char) -> Text -> Text
scanr1 :: (Char -> Char -> Char) -> Text -> Text
scanr1 Char -> Char -> Char
f Text
t | Text -> Bool
null Text
t    = Text
empty
           | Bool
otherwise = (Char -> Char -> Char) -> Char -> Text -> Text
scanr Char -> Char -> Char
f (HasCallStack => Text -> Char
Text -> Char
last Text
t) (HasCallStack => Text -> Text
Text -> Text
init Text
t)
{-# INLINE scanr1 #-}

-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
-- function to each element of a 'Text', passing an accumulating
-- parameter from left to right, and returns a final 'Text'.  Performs
-- replacement on invalid scalar values.
mapAccumL :: forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
mapAccumL :: forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
mapAccumL a -> Char -> (a, Char)
f a
z0 = Text -> (a, Text)
go
  where
    go :: Text -> (a, Text)
go (Text Array
src Int
o Int
l) = (forall s. ST s (a, Text)) -> (a, Text)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, Text)) -> (a, Text))
-> (forall s. ST s (a, Text)) -> (a, Text)
forall a b. (a -> b) -> a -> b
$ do
      MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
      MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
forall s. MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
marr (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
o Int
0 a
z0
      where
        outer :: forall s. A.MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
        outer :: forall s. MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
outer !MArray s
dst !Int
dstLen = Int -> Int -> a -> ST s (a, Text)
inner
          where
            inner :: Int -> Int -> a -> ST s (a, Text)
inner !Int
srcOff !Int
dstOff !a
z
              | Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o = do
                MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
                Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
                (a, Text) -> ST s (a, Text)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z, Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
              | Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
                let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
                MArray s
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
                MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
forall s. MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
dst' Int
dstLen' Int
srcOff Int
dstOff a
z
              | Bool
otherwise = do
                let !(Iter Char
c Int
d) = Array -> Int -> Iter
iterArray Array
src Int
srcOff
                    (a
z', Char
c') = a -> Char -> (a, Char)
f a
z Char
c
                Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff (Char -> Char
safe Char
c')
                Int -> Int -> a -> ST s (a, Text)
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d') a
z'
{-# INLINE mapAccumL #-}

-- | The 'mapAccumR' function behaves like a combination of 'map' and
-- a strict 'foldr'; it applies a function to each element of a
-- 'Text', passing an accumulating parameter from right to left, and
-- returning a final value of this accumulator together with the new
-- 'Text'.
-- Performs replacement on invalid scalar values.
mapAccumR :: forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
mapAccumR :: forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
mapAccumR a -> Char -> (a, Char)
f a
z0 = Text -> (a, Text)
go
  where
    go :: Text -> (a, Text)
go (Text Array
src Int
o Int
l) = (forall s. ST s (a, Text)) -> (a, Text)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, Text)) -> (a, Text))
-> (forall s. ST s (a, Text)) -> (a, Text)
forall a b. (a -> b) -> a -> b
$ do
      MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
      MArray s -> Int -> Int -> a -> ST s (a, Text)
forall s. MArray s -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
marr (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
z0
      where
        outer :: forall s. A.MArray s -> Int -> Int -> a -> ST s (a, Text)
        outer :: forall s. MArray s -> Int -> Int -> a -> ST s (a, Text)
outer !MArray s
dst = Int -> Int -> a -> ST s (a, Text)
inner
          where
            inner :: Int -> Int -> a -> ST s (a, Text)
inner !Int
srcOff !Int
dstOff !a
z
              | Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
o = do
                Int
dstLen <- MArray s -> ST s Int
forall s. MArray s -> ST s Int
A.getSizeofMArray MArray s
dst
                Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
                (a, Text) -> ST s (a, Text)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z, Array -> Int -> Int -> Text
Text Array
arr (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
              | Int
dstOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = do
                Int
dstLen <- MArray s -> ST s Int
forall s. MArray s -> ST s Int
A.getSizeofMArray MArray s
dst
                let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
                MArray s
dst' <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
dstLen'
                MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
A.copyM MArray s
dst' (Int
dstLen' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen) MArray s
dst Int
0 Int
dstLen
                MArray s -> Int -> Int -> a -> ST s (a, Text)
forall s. MArray s -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
dst' Int
srcOff (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen) a
z
              | Bool
otherwise = do
                let !(Iter Char
c Int
d) = Array -> Int -> Iter
reverseIterArray Array
src (Int
srcOff)
                    (a
z', Char
c') = a -> Char -> (a, Char)
f a
z Char
c
                    c'' :: Char
c'' = Char -> Char
safe Char
c'
                    !d' :: Int
d' = Char -> Int
utf8Length Char
c''
                    dstOff' :: Int
dstOff' = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d'
                Int
_ <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst (Int
dstOff' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
c''
                Int -> Int -> a -> ST s (a, Text)
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) Int
dstOff' a
z'
{-# INLINE mapAccumR #-}

-- -----------------------------------------------------------------------------
-- ** Generating and unfolding 'Text's

-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
-- @t@ repeated @n@ times.
replicate :: Int -> Text -> Text
replicate :: Int -> Text -> Text
replicate Int
n t :: Text
t@(Text Array
a Int
o Int
l)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0       = Text
empty
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                 = Text
t
    | Text -> Bool
isSingleton Text
t          = Int -> Char -> Text
replicateChar Int
n (Text -> Char
unsafeHead Text
t)
    | Bool
otherwise              = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
        let totalLen :: Int
totalLen = Int
n Int -> Int -> Int
`mul` Int
l
        MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
totalLen
        Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
l MArray s
marr Int
0 Array
a Int
o
        MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.tile MArray s
marr Int
l
        Array
arr  <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
        Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
totalLen
{-# INLINE [1] replicate #-}

{-# RULES
"TEXT replicate/singleton -> replicateChar" [~1] forall n c.
    replicate n (singleton c) = replicateChar n c
  #-}

-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
-- value of every element.
replicateChar :: Int -> Char -> Text
replicateChar :: Int -> Char -> Text
replicateChar !Int
len !Char
c'
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Text
empty
  | Char -> Bool
isAscii Char
c = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
    MArray s
marr <- Int -> Int -> ST s (MArray s)
forall s. Int -> Int -> ST s (MArray s)
A.newFilled Int
len (Char -> Int
ord Char
c)
    Array
arr  <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
    Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
len
  | Bool
otherwise = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
    let cLen :: Int
cLen = Char -> Int
utf8Length Char
c
        totalLen :: Int
totalLen = Int
cLen Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
len
    MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
totalLen
    Int
_ <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
    MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.tile MArray s
marr Int
cLen
    Array
arr  <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
    Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
totalLen
  where
    c :: Char
c = Char -> Char
safe Char
c'
{-# INLINE replicateChar #-}

-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
-- 'Text' from a seed value. The function takes the element and
-- returns 'Nothing' if it is done producing the 'Text', otherwise
-- 'Just' @(a,b)@.  In this case, @a@ is the next 'Char' in the
-- string, and @b@ is the seed value for further production.
-- Performs replacement on invalid scalar values.
unfoldr     :: (a -> Maybe (Char,a)) -> a -> Text
unfoldr :: forall a. (a -> Maybe (Char, a)) -> a -> Text
unfoldr a -> Maybe (Char, a)
f a
s = Stream Char -> Text
unstream ((a -> Maybe (Char, a)) -> a -> Stream Char
forall a. (a -> Maybe (Char, a)) -> a -> Stream Char
S.unfoldr ((Char -> Char) -> Maybe (Char, a) -> Maybe (Char, a)
forall a c b. (a -> c) -> Maybe (a, b) -> Maybe (c, b)
firstf Char -> Char
safe (Maybe (Char, a) -> Maybe (Char, a))
-> (a -> Maybe (Char, a)) -> a -> Maybe (Char, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Char, a)
f) a
s)
{-# INLINE unfoldr #-}

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
-- value. However, the length of the result should be limited by the
-- first argument to 'unfoldrN'. This function is more efficient than
-- 'unfoldr' when the maximum length of the result is known and
-- correct, otherwise its performance is similar to 'unfoldr'.
-- Performs replacement on invalid scalar values.
unfoldrN     :: Int -> (a -> Maybe (Char,a)) -> a -> Text
unfoldrN :: forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
unfoldrN Int
n a -> Maybe (Char, a)
f a
s = Stream Char -> Text
unstream (Int -> (a -> Maybe (Char, a)) -> a -> Stream Char
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Stream Char
S.unfoldrN Int
n ((Char -> Char) -> Maybe (Char, a) -> Maybe (Char, a)
forall a c b. (a -> c) -> Maybe (a, b) -> Maybe (c, b)
firstf Char -> Char
safe (Maybe (Char, a) -> Maybe (Char, a))
-> (a -> Maybe (Char, a)) -> a -> Maybe (Char, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Char, a)
f) a
s)
{-# INLINE unfoldrN #-}

-- -----------------------------------------------------------------------------
-- * Substrings

-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the
-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
-- the length of the Text.
take :: Int -> Text -> Text
take :: Int -> Text -> Text
take Int
n t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Text
empty
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Text
t
    | Bool
otherwise = let m :: Int
m = Int -> Text -> Int
measureOff Int
n Text
t in if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Array -> Int -> Int -> Text
text Array
arr Int
off Int
m else Text
t
{-# INLINE [1] take #-}

-- | /O(n)/ If @t@ is long enough to contain @n@ characters, 'measureOff' @n@ @t@
-- returns a non-negative number, measuring their size in 'Word8'. Otherwise,
-- if @t@ is shorter, return a non-positive number, which is a negated total count
-- of 'Char' available in @t@. If @t@ is empty or @n = 0@, return 0.
--
-- This function is used to implement 'take', 'drop', 'splitAt' and 'length'
-- and is useful on its own in streaming and parsing libraries.
--
-- @since 2.0
measureOff :: Int -> Text -> Int
measureOff :: Int -> Text -> Int
measureOff !Int
n (Text (A.ByteArray ByteArray#
arr) Int
off Int
len) = if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else
  CSsize -> Int
cSsizeToInt (CSsize -> Int) -> CSsize -> Int
forall a b. (a -> b) -> a -> b
$
    ByteArray# -> CSize -> CSize -> CSize -> CSsize
c_measure_off ByteArray#
arr (Int -> CSize
intToCSize Int
off) (Int -> CSize
intToCSize Int
len) (Int -> CSize
intToCSize Int
n)

-- | The input buffer (arr :: ByteArray#, off :: CSize, len :: CSize)
-- must specify a valid UTF-8 sequence, this condition is not checked.
foreign import ccall unsafe "_hs_text_measure_off" c_measure_off
    :: ByteArray# -> CSize -> CSize -> CSize -> CSsize

-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
-- taking @n@ characters from the end of @t@.
--
-- Examples:
--
-- >>> takeEnd 3 "foobar"
-- "bar"
--
-- @since 1.1.1.0
takeEnd :: Int -> Text -> Text
takeEnd :: Int -> Text -> Text
takeEnd Int
n t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Text
empty
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Text
t
    | Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
  where i :: Int
i = Int -> Text -> Int
iterNEnd Int
n Text
t

iterNEnd :: Int -> Text -> Int
iterNEnd :: Int -> Text -> Int
iterNEnd Int
n t :: Text
t@(Text Array
_arr Int
_off Int
len) = Int -> Int -> Int
loop (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
n
  where loop :: Int -> Int -> Int
loop Int
i !Int
m
          | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Int
0
          | Bool
otherwise = Int -> Int -> Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
          where d :: Int
d = Text -> Int -> Int
reverseIter_ Text
t Int
i

-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
-- is greater than the length of the 'Text'.
drop :: Int -> Text -> Text
drop :: Int -> Text -> Text
drop Int
n t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Text
t
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Text
empty
    | Bool
otherwise = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m) else Text
forall a. Monoid a => a
mempty
  where m :: Int
m = Int -> Text -> Int
measureOff Int
n Text
t
{-# INLINE [1] drop #-}

-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
-- dropping @n@ characters from the end of @t@.
--
-- Examples:
--
-- >>> dropEnd 3 "foobar"
-- "foo"
--
-- @since 1.1.1.0
dropEnd :: Int -> Text -> Text
dropEnd :: Int -> Text -> Text
dropEnd Int
n t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Text
t
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Text
empty
    | Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr Int
off (Int -> Text -> Int
iterNEnd Int
n Text
t)

-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
-- returns the longest prefix (possibly empty) of elements that
-- satisfy @p@.
takeWhile :: (Char -> Bool) -> Text -> Text
takeWhile :: (Char -> Bool) -> Text -> Text
takeWhile Char -> Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> Text
loop Int
0
  where loop :: Int -> Text
loop !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len    = Text
t
                | Char -> Bool
p Char
c         = Int -> Text
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
                | Bool
otherwise   = Array -> Int -> Int -> Text
text Array
arr Int
off Int
i
            where Iter Char
c Int
d    = Text -> Int -> Iter
iter Text
t Int
i
{-# INLINE [1] takeWhile #-}

-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
-- returns the longest suffix (possibly empty) of elements that
-- satisfy @p@.
-- Examples:
--
-- >>> takeWhileEnd (=='o') "foo"
-- "oo"
--
-- @since 1.2.2.0
takeWhileEnd :: (Char -> Bool) -> Text -> Text
takeWhileEnd :: (Char -> Bool) -> Text -> Text
takeWhileEnd Char -> Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> Int -> Text
loop (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
len
  where loop :: Int -> Int -> Text
loop !Int
i !Int
l | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Text
t
                   | Char -> Bool
p Char
c       = Int -> Int -> Text
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
                   | Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)
            where Iter Char
c Int
d     = Text -> Int -> Iter
reverseIter Text
t Int
i
{-# INLINE [1] takeWhileEnd #-}

-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
-- 'takeWhile' @p@ @t@.
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> Int -> Text
loop Int
0 Int
0
  where loop :: Int -> Int -> Text
loop !Int
i !Int
l | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Text
empty
                   | Char -> Bool
p Char
c       = Int -> Int -> Text
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
                   | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)
            where Iter Char
c Int
d     = Text -> Int -> Iter
iter Text
t Int
i
{-# INLINE [1] dropWhile #-}

-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
-- dropping characters that satisfy the predicate @p@ from the end of
-- @t@.
--
-- Examples:
--
-- >>> dropWhileEnd (=='.') "foo..."
-- "foo"
dropWhileEnd :: (Char -> Bool) -> Text -> Text
dropWhileEnd :: (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> Int -> Text
loop (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
len
  where loop :: Int -> Int -> Text
loop !Int
i !Int
l | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Text
empty
                   | Char -> Bool
p Char
c       = Int -> Int -> Text
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
                   | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off Int
l
            where Iter Char
c Int
d     = Text -> Int -> Iter
reverseIter Text
t Int
i
{-# INLINE [1] dropWhileEnd #-}

-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
-- dropping characters that satisfy the predicate @p@ from both the
-- beginning and end of @t@.
dropAround :: (Char -> Bool) -> Text -> Text
dropAround :: (Char -> Bool) -> Text -> Text
dropAround Char -> Bool
p = (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
p (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
p
{-# INLINE [1] dropAround #-}

-- | /O(n)/ Remove leading white space from a string.  Equivalent to:
--
-- > dropWhile isSpace
stripStart :: Text -> Text
stripStart :: Text -> Text
stripStart = (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
isSpace
{-# INLINE stripStart #-}

-- | /O(n)/ Remove trailing white space from a string.  Equivalent to:
--
-- > dropWhileEnd isSpace
stripEnd :: Text -> Text
stripEnd :: Text -> Text
stripEnd = (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
isSpace
{-# INLINE [1] stripEnd #-}

-- | /O(n)/ Remove leading and trailing white space from a string.
-- Equivalent to:
--
-- > dropAround isSpace
strip :: Text -> Text
strip :: Text -> Text
strip = (Char -> Bool) -> Text -> Text
dropAround Char -> Bool
isSpace
{-# INLINE [1] strip #-}

-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a
-- prefix of @t@ of length @n@, and whose second is the remainder of
-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
splitAt :: Int -> Text -> (Text, Text)
splitAt :: Int -> Text -> (Text, Text)
splitAt Int
n t :: Text
t@(Text Array
arr Int
off Int
len)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = (Text
empty, Text
t)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = (Text
t, Text
empty)
    | Bool
otherwise = let m :: Int
m = Int -> Text -> Int
measureOff Int
n Text
t in
    if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Array -> Int -> Int -> Text
text Array
arr Int
off Int
m, Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m)) else (Text
t, Text
forall a. Monoid a => a
mempty)

-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
-- a pair whose first element is the longest prefix (possibly empty)
-- of @t@ of elements that satisfy @p@, and whose second is the
-- remainder of the text.
--
-- >>> T.span (=='0') "000AB"
-- ("000","AB")
span :: (Char -> Bool) -> Text -> (Text, Text)
span :: (Char -> Bool) -> Text -> (Text, Text)
span Char -> Bool
p Text
t = case (Char -> Bool) -> Text -> (# Text, Text #)
span_ Char -> Bool
p Text
t of
             (# Text
hd,Text
tl #) -> (Text
hd,Text
tl)
{-# INLINE span #-}

-- | /O(n)/ 'break' is like 'span', but the prefix returned is
-- over elements that fail the predicate @p@.
--
-- >>> T.break (=='c') "180cm"
-- ("180","cm")
break :: (Char -> Bool) -> Text -> (Text, Text)
break :: (Char -> Bool) -> Text -> (Text, Text)
break Char -> Bool
p = (Char -> Bool) -> Text -> (Text, Text)
span (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p)
{-# INLINE break #-}

-- | /O(length of prefix)/ 'spanM', applied to a monadic predicate @p@,
-- a text @t@, returns a pair @(t1, t2)@ where @t1@ is the longest prefix of
-- @t@ whose elements satisfy @p@, and @t2@ is the remainder of the text.
--
-- >>> T.spanM (\c -> state $ \i -> (fromEnum c == i, i+1)) "abcefg" `runState` 97
-- (("abc","efg"),101)
--
-- 'span' is 'spanM' specialized to 'Data.Functor.Identity.Identity':
--
-- @
-- -- for all p :: Char -> Bool
-- 'span' p = 'Data.Functor.Identity.runIdentity' . 'spanM' ('pure' . p)
-- @
--
-- @since 2.0.1
spanM :: Monad m => (Char -> m Bool) -> Text -> m (Text, Text)
spanM :: forall (m :: * -> *).
Monad m =>
(Char -> m Bool) -> Text -> m (Text, Text)
spanM Char -> m Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> m (Text, Text)
go Int
0
  where
    go :: Int -> m (Text, Text)
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = case Array -> Int -> Iter
iterArray Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) of
        Iter Char
c Int
l -> do
            Bool
continue <- Char -> m Bool
p Char
c
            if Bool
continue then Int -> m (Text, Text)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)
            else (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array -> Int -> Int -> Text
text Array
arr Int
off Int
i, Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))
    go Int
_ = (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
t, Text
empty)
{-# INLINE spanM #-}

-- | /O(length of suffix)/ 'spanEndM', applied to a monadic predicate @p@,
-- a text @t@, returns a pair @(t1, t2)@ where @t2@ is the longest suffix of
-- @t@ whose elements satisfy @p@, and @t1@ is the remainder of the text.
--
-- >>> T.spanEndM (\c -> state $ \i -> (fromEnum c == i, i-1)) "tuvxyz" `runState` 122
-- (("tuv","xyz"),118)
--
-- @
-- 'spanEndM' p . 'reverse' = fmap ('Data.Bifunctor.bimap' 'reverse' 'reverse') . 'spanM' p
-- @
--
-- @since 2.0.1
spanEndM :: Monad m => (Char -> m Bool) -> Text -> m (Text, Text)
spanEndM :: forall (m :: * -> *).
Monad m =>
(Char -> m Bool) -> Text -> m (Text, Text)
spanEndM Char -> m Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> m (Text, Text)
go (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  where
    go :: Int -> m (Text, Text)
go !Int
i | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = case Array -> Int -> Iter
reverseIterArray Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) of
        Iter Char
c Int
l -> do
            Bool
continue <- Char -> m Bool
p Char
c
            if Bool
continue then Int -> m (Text, Text)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)
            else (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array -> Int -> Int -> Text
text Array
arr Int
off (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
    go Int
_ = (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
empty, Text
t)
{-# INLINE spanEndM #-}

-- | /O(n)/ Group characters in a string according to a predicate.
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
p = Text -> [Text]
loop
  where
    loop :: Text -> [Text]
loop t :: Text
t@(Text Array
arr Int
off Int
len)
        | Text -> Bool
null Text
t    = []
        | Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr Int
off Int
n Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
loop (Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
        where Iter Char
c Int
d = Text -> Int -> Iter
iter Text
t Int
0
              n :: Int
n     = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Bool) -> Text -> Int
findAIndexOrEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
p Char
c) (Array -> Int -> Int -> Text
Text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d))

-- | Returns the /array/ index (in units of 'Word8') at which a
-- character may be found.  This is /not/ the same as the logical
-- index returned by e.g. 'findIndex'.
findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
findAIndexOrEnd Char -> Bool
q t :: Text
t@(Text Array
_arr Int
_off Int
len) = Int -> Int
go Int
0
    where go :: Int -> Int
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len Bool -> Bool -> Bool
|| Char -> Bool
q Char
c       = Int
i
                | Bool
otherwise             = Int -> Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
                where Iter Char
c Int
d          = Text -> Int -> Iter
iter Text
t Int
i

-- | /O(n)/ Group characters in a string by equality.
group :: Text -> [Text]
group :: Text -> [Text]
group = (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | /O(n)/ Return all initial segments of the given 'Text', shortest
-- first.
inits :: Text -> [Text]
inits :: Text -> [Text]
inits t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> [Text]
loop Int
0
    where loop :: Int -> [Text]
loop Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = [Text
t]
                 | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off Int
i Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text]
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int -> Int
iter_ Text
t Int
i)

-- | /O(n)/ Return all final segments of the given 'Text', longest
-- first.
tails :: Text -> [Text]
tails :: Text -> [Text]
tails Text
t | Text -> Bool
null Text
t    = [Text
empty]
        | Bool
otherwise = Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
tails (Text -> Text
unsafeTail Text
t)

-- $split
--
-- Splitting functions in this library do not perform character-wise
-- copies to create substrings; they just construct new 'Text's that
-- are slices of the original.

-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
-- argument (which cannot be empty), consuming the delimiter. An empty
-- delimiter is invalid, and will cause an error to be raised.
--
-- 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)
--
-- (Note: the string @s@ to split on above cannot be empty.)
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
splitOn :: HasCallStack
        => Text
        -- ^ String to split on. If this string is empty, an error
        -- will occur.
        -> Text
        -- ^ Input text.
        -> [Text]
splitOn :: HasCallStack => Text -> Text -> [Text]
splitOn pat :: Text
pat@(Text Array
_ Int
_ Int
l) src :: Text
src@(Text Array
arr Int
off Int
len)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0          = String -> [Text]
forall a. HasCallStack => String -> a
emptyError String
"splitOn"
    | Text -> Bool
isSingleton Text
pat = (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Char
unsafeHead Text
pat) Text
src
    | Bool
otherwise       = Int -> [Int] -> [Text]
go Int
0 (Text -> Text -> [Int]
indices Text
pat Text
src)
  where
    go :: Int -> [Int] -> [Text]
go !Int
s (Int
x:[Int]
xs) =  Array -> Int -> Int -> Text
text Array
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Int] -> [Text]
go (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) [Int]
xs
    go  Int
s [Int]
_      = [Array -> Int -> Int -> Text
text Array
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)]
{-# INLINE [1] splitOn #-}

{-# RULES
"TEXT splitOn/singleton -> split/==" [~1] forall c t.
    splitOn (singleton c) t = split (==c) t
  #-}

-- | /O(n)/ Splits a 'Text' into components delimited by separators,
-- where the predicate returns True for a separator element.  The
-- resulting components do not contain the separators.  Two adjacent
-- separators result in an empty component in the output.  eg.
--
-- >>> split (=='a') "aabbaca"
-- ["","","bb","c",""]
--
-- >>> split (=='a') ""
-- [""]
split :: (Char -> Bool) -> Text -> [Text]
split :: (Char -> Bool) -> Text -> [Text]
split Char -> Bool
_ t :: Text
t@(Text Array
_off Int
_arr Int
0) = [Text
t]
split Char -> Bool
p Text
t = Text -> [Text]
loop Text
t
    where loop :: Text -> [Text]
loop Text
s | Text -> Bool
null Text
s'   = [Text
l]
                 | Bool
otherwise = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
loop (Text -> Text
unsafeTail Text
s')
              where (# Text
l, Text
s' #) = (Char -> Bool) -> Text -> (# Text, Text #)
span_ (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p) Text
s
{-# INLINE split #-}

-- | /O(n)/ Splits a 'Text' into components of length @k@.  The last
-- element may be shorter than the other chunks, depending on the
-- length of the input. Examples:
--
-- >>> chunksOf 3 "foobarbaz"
-- ["foo","bar","baz"]
--
-- >>> chunksOf 4 "haskell.org"
-- ["hask","ell.","org"]
chunksOf :: Int -> Text -> [Text]
chunksOf :: Int -> Text -> [Text]
chunksOf Int
k = Text -> [Text]
go
  where
    go :: Text -> [Text]
go Text
t = case Int -> Text -> (Text, Text)
splitAt Int
k Text
t of
             (Text
a,Text
b) | Text -> Bool
null Text
a    -> []
                   | Bool
otherwise -> Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
go Text
b
{-# INLINE chunksOf #-}

-- ----------------------------------------------------------------------------
-- * Searching

-------------------------------------------------------------------------------
-- ** Searching with a predicate

-- | /O(n)/ The 'elem' function takes a character and a 'Text', and
-- returns 'True' if the element is found in the given 'Text', or
-- 'False' otherwise.
elem :: Char -> Text -> Bool
elem :: Char -> Text -> Bool
elem Char
c Text
t = (Char -> Bool) -> Stream Char -> Bool
S.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) (Text -> Stream Char
stream Text
t)
{-# INLINE elem #-}

-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and
-- returns the first element matching the predicate, or 'Nothing' if
-- there is no such element.
find :: (Char -> Bool) -> Text -> Maybe Char
find :: (Char -> Bool) -> Text -> Maybe Char
find Char -> Bool
p Text
t = (Char -> Bool) -> Stream Char -> Maybe Char
S.findBy Char -> Bool
p (Text -> Stream Char
stream Text
t)
{-# INLINE find #-}

-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
-- and returns the pair of 'Text's with elements which do and do not
-- satisfy the predicate, respectively; i.e.
--
-- > partition p t == (filter p t, filter (not . p) t)
partition :: (Char -> Bool) -> Text -> (Text, Text)
partition :: (Char -> Bool) -> Text -> (Text, Text)
partition Char -> Bool
p Text
t = ((Char -> Bool) -> Text -> Text
filter Char -> Bool
p Text
t, (Char -> Bool) -> Text -> Text
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p) Text
t)
{-# INLINE partition #-}

-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
-- returns a 'Text' containing those characters that satisfy the
-- predicate.
filter :: (Char -> Bool) -> Text -> Text
filter :: (Char -> Bool) -> Text -> Text
filter Char -> Bool
p = Text -> Text
go
  where
    go :: Text -> Text
go (Text Array
src Int
o Int
l) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
      -- It's tempting to allocate l elements at once and avoid resizing.
      -- However, this can be unacceptable in scenarios where a huge array
      -- is filtered with a rare predicate, resulting in a much shorter buffer.
      let !dstLen :: Int
dstLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
64
      MArray s
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
dstLen
      MArray s -> Int -> Int -> Int -> ST s Text
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
dst Int
dstLen Int
o Int
0
      where
        outer :: forall s. A.MArray s -> Int -> Int -> Int -> ST s Text
        outer :: forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer !MArray s
dst !Int
dstLen = Int -> Int -> ST s Text
inner
          where
            inner :: Int -> Int -> ST s Text
inner !Int
srcOff !Int
dstOff
              | Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l = do
                MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
                Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
                Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
              | Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
                -- Double size of the buffer, unless it becomes longer than
                -- source string. Ensure to extend it by least 4 bytes.
                let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff) Int
dstLen)
                MArray s
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
                MArray s -> Int -> Int -> Int -> ST s Text
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
dst' Int
dstLen' Int
srcOff Int
dstOff
              -- In case of success, filter writes exactly the same character
              -- it just read (this is not a case for map, for example).
              -- We leverage this fact below: no need to decode Char back into UTF8,
              -- just copy bytes from input.
              | Bool
otherwise = do
                let m0 :: Word8
m0 = Array -> Int -> Word8
A.unsafeIndex Array
src Int
srcOff
                    m1 :: Word8
m1 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                    m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                    !d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
                case Int
d of
                  Int
1 -> do
                    let !c :: Char
c = Word8 -> Char
unsafeChr8 Word8
m0
                    if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
dstOff else do
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                      Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  Int
2 -> do
                    let !c :: Char
c = Word8 -> Word8 -> Char
chr2 Word8
m0 Word8
m1
                    if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
dstOff else do
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
                      Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                  Int
3 -> do
                    let !c :: Char
c = Word8 -> Word8 -> Word8 -> Char
chr3 Word8
m0 Word8
m1 Word8
m2
                    if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
dstOff else do
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
                      Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                  Int
_ -> do
                    let !c :: Char
c = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
m0 Word8
m1 Word8
m2 Word8
m3
                    if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
dstOff else do
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
                      MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
                      Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
{-# INLINE [1] filter #-}

{-# RULES
"TEXT filter/filter -> filter" forall p q t.
    filter p (filter q t) = filter (\c -> p c && q c) t
#-}

-- | /O(n+m)/ Find the first instance of @needle@ (which must be
-- non-'null') in @haystack@.  The first element of the returned tuple
-- is the prefix of @haystack@ before @needle@ is matched.  The second
-- is the remainder of @haystack@, starting with the match.
--
-- Examples:
--
-- >>> breakOn "::" "a::b::c"
-- ("a","::b::c")
--
-- >>> breakOn "/" "foobar"
-- ("foobar","")
--
-- Laws:
--
-- > append prefix match == haystack
-- >   where (prefix, match) = breakOn needle haystack
--
-- If you need to break a string by a substring repeatedly (e.g. you
-- want to break on every instance of a substring), use 'breakOnAll'
-- instead, as it has lower startup overhead.
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
breakOn :: HasCallStack => Text -> Text -> (Text, Text)
breakOn :: HasCallStack => Text -> Text -> (Text, Text)
breakOn Text
pat src :: Text
src@(Text Array
arr Int
off Int
len)
    | Text -> Bool
null Text
pat  = String -> (Text, Text)
forall a. HasCallStack => String -> a
emptyError String
"breakOn"
    | Bool
otherwise = case Text -> Text -> [Int]
indices Text
pat Text
src of
                    []    -> (Text
src, Text
empty)
                    (Int
x:[Int]
_) -> (Array -> Int -> Int -> Text
text Array
arr Int
off Int
x, Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
x) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x))
{-# INLINE breakOn #-}

-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
-- string.
--
-- The first element of the returned tuple is the prefix of @haystack@
-- up to and including the last match of @needle@.  The second is the
-- remainder of @haystack@, following the match.
--
-- >>> breakOnEnd "::" "a::b::c"
-- ("a::b::","c")
breakOnEnd :: HasCallStack => Text -> Text -> (Text, Text)
breakOnEnd :: HasCallStack => Text -> Text -> (Text, Text)
breakOnEnd Text
pat Text
src = (Text -> Text
reverse Text
b, Text -> Text
reverse Text
a)
    where (Text
a,Text
b) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
breakOn (Text -> Text
reverse Text
pat) (Text -> Text
reverse Text
src)
{-# INLINE breakOnEnd #-}

-- | /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 /k/th match (i.e. the prefix)
--
-- * The /k/th match, followed by the remainder of the string
--
-- Examples:
--
-- >>> breakOnAll "::" ""
-- []
--
-- >>> breakOnAll "/" "a/b/c/"
-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
--
-- The @needle@ parameter may not be empty.
breakOnAll :: HasCallStack
           => Text              -- ^ @needle@ to search for
           -> Text              -- ^ @haystack@ in which to search
           -> [(Text, Text)]
breakOnAll :: HasCallStack => Text -> Text -> [(Text, Text)]
breakOnAll Text
pat src :: Text
src@(Text Array
arr Int
off Int
slen)
    | Text -> Bool
null Text
pat  = String -> [(Text, Text)]
forall a. HasCallStack => String -> a
emptyError String
"breakOnAll"
    | Bool
otherwise = (Int -> (Text, Text)) -> [Int] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
L.map Int -> (Text, Text)
step (Text -> Text -> [Int]
indices Text
pat Text
src)
  where
    step :: Int -> (Text, Text)
step       Int
x = (Int -> Int -> Text
chunk Int
0 Int
x, Int -> Int -> Text
chunk Int
x (Int
slenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x))
    chunk :: Int -> Int -> Text
chunk !Int
n !Int
l  = Array -> Int -> Int -> Text
text Array
arr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) Int
l
{-# INLINE breakOnAll #-}

-------------------------------------------------------------------------------
-- ** Indexing 'Text's

-- $index
--
-- If you think of a 'Text' value as an array of 'Char' values (which
-- it is not), you run the risk of writing inefficient code.
--
-- An idiom that is common in some languages is to find the numeric
-- offset of a character or substring, then use that number to split
-- or trim the searched string.  With a 'Text' value, this approach
-- would require two /O(n)/ operations: one to perform the search, and
-- one to operate from wherever the search ended.
--
-- For example, suppose you have a string that you want to split on
-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of
-- searching for the index of @\"::\"@ and taking the substrings
-- before and after that index, you would instead use @breakOnAll \"::\"@.

-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
index :: HasCallStack => Text -> Int -> Char
index :: HasCallStack => Text -> Int -> Char
index Text
t Int
n = HasCallStack => Stream Char -> Int -> Char
Stream Char -> Int -> Char
S.index (Text -> Stream Char
stream Text
t) Int
n
{-# INLINE index #-}

-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
-- and returns the index of the first element in the 'Text' satisfying
-- the predicate.
findIndex :: (Char -> Bool) -> Text -> Maybe Int
findIndex :: (Char -> Bool) -> Text -> Maybe Int
findIndex Char -> Bool
p Text
t = (Char -> Bool) -> Stream Char -> Maybe Int
S.findIndex Char -> Bool
p (Text -> Stream Char
stream Text
t)
{-# INLINE findIndex #-}

-- | /O(n+m)/ The 'count' function returns the number of times the
-- query string appears in the given 'Text'. An empty query string is
-- invalid, and will cause an error to be raised.
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
count :: HasCallStack => Text -> Text -> Int
count :: HasCallStack => Text -> Text -> Int
count Text
pat
    | Text -> Bool
null Text
pat        = String -> Text -> Int
forall a. HasCallStack => String -> a
emptyError String
"count"
    | Text -> Bool
isSingleton Text
pat = Char -> Text -> Int
countChar (Text -> Char
unsafeHead Text
pat)
    | Bool
otherwise       = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([Int] -> Int) -> (Text -> [Int]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Int]
indices Text
pat
{-# INLINE [1] count #-}

{-# RULES
"TEXT count/singleton -> countChar" [~1] forall c t.
    count (singleton c) t = countChar c t
  #-}

-- | /O(n)/ The 'countChar' function returns the number of times the
-- query element appears in the given 'Text'.
countChar :: Char -> Text -> Int
countChar :: Char -> Text -> Int
countChar Char
c Text
t = Char -> Stream Char -> Int
S.countChar Char
c (Text -> Stream Char
stream Text
t)
{-# INLINE countChar #-}

-------------------------------------------------------------------------------
-- * Zipping

-- | /O(n)/ 'zip' takes two 'Text's and returns a list of
-- corresponding pairs of bytes. If one input 'Text' is short,
-- excess elements of the longer 'Text' are discarded. This is
-- equivalent to a pair of 'unpack' operations.
zip :: Text -> Text -> [(Char,Char)]
zip :: Text -> Text -> [(Char, Char)]
zip Text
a Text
b = Stream (Char, Char) -> [(Char, Char)]
forall a. Stream a -> [a]
S.unstreamList (Stream (Char, Char) -> [(Char, Char)])
-> Stream (Char, Char) -> [(Char, Char)]
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> (Char, Char))
-> Stream Char -> Stream Char -> Stream (Char, Char)
forall a b. (a -> a -> b) -> Stream a -> Stream a -> Stream b
S.zipWith (,) (Text -> Stream Char
stream Text
a) (Text -> Stream Char
stream Text
b)
{-# INLINE zip #-}

-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
-- given as the first argument, instead of a tupling function.
-- Performs replacement on invalid scalar values.
zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
zipWith Char -> Char -> Char
f Text
t1 Text
t2 = Stream Char -> Text
unstream ((Char -> Char -> Char) -> Stream Char -> Stream Char -> Stream Char
forall a b. (a -> a -> b) -> Stream a -> Stream a -> Stream b
S.zipWith Char -> Char -> Char
g (Text -> Stream Char
stream Text
t1) (Text -> Stream Char
stream Text
t2))
    where g :: Char -> Char -> Char
g Char
a Char
b = Char -> Char
safe (Char -> Char -> Char
f Char
a Char
b)
{-# INLINE [1] zipWith #-}

-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
-- representing white space.
words :: Text -> [Text]
words :: Text -> [Text]
words (Text Array
arr Int
off Int
len) = Int -> Int -> [Text]
loop Int
0 Int
0
  where
    loop :: Int -> Int -> [Text]
loop !Int
start !Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
                     then []
                     else [Array -> Int -> Int -> Text
Text Array
arr (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)]
        -- Spaces in UTF-8 take either 1 byte for 0x09..0x0D + 0x20
        | Word8 -> Bool
isAsciiSpace Word8
w0 =
            if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
            then Int -> Int -> [Text]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            else Array -> Int -> Int -> Text
Text Array
arr (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Word8
w0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80 = Int -> Int -> [Text]
loop Int
start (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        -- or 2 bytes for 0xA0
        | Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xC2, Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xA0 =
            if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
            then Int -> Int -> [Text]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
            else Array -> Int -> Int -> Text
Text Array
arr (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        | Word8
w0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xE0 = Int -> Int -> [Text]
loop Int
start (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        -- or 3 bytes for 0x1680 + 0x2000..0x200A + 0x2028..0x2029 + 0x202F + 0x205F + 0x3000
        |  Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE1 Bool -> Bool -> Bool
&& Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x9A Bool -> Bool -> Bool
&& Word8
w2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80
        Bool -> Bool -> Bool
|| Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE2 Bool -> Bool -> Bool
&& (Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80 Bool -> Bool -> Bool
&& Char -> Bool
isSpace (Word8 -> Word8 -> Word8 -> Char
chr3 Word8
w0 Word8
w1 Word8
w2) Bool -> Bool -> Bool
|| Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x81 Bool -> Bool -> Bool
&& Word8
w2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x9F)
        Bool -> Bool -> Bool
|| Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE3 Bool -> Bool -> Bool
&& Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80 Bool -> Bool -> Bool
&& Word8
w2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80 =
            if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
            then Int -> Int -> [Text]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
            else Array -> Int -> Int -> Text
Text Array
arr (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        | Bool
otherwise = Int -> Int -> [Text]
loop Int
start (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
utf8LengthByLeader Word8
w0)
        where
            w0 :: Word8
w0 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
            w1 :: Word8
w1 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            w2 :: Word8
w2 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
{-# INLINE words #-}

-- Adapted from Data.ByteString.Internal.isSpaceWord8
isAsciiSpace :: Word8 -> Bool
isAsciiSpace :: Word8 -> Bool
isAsciiSpace Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x50 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80 Bool -> Bool -> Bool
&& (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x09 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
5)
{-# INLINE isAsciiSpace #-}

-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at newline characters
-- @'\\n'@ (LF, line feed). The resulting strings do not contain newlines.
--
-- 'lines' __does not__ treat @'\\r'@ (CR, carriage return) as a newline character.
lines :: Text -> [Text]
lines :: Text -> [Text]
lines (Text arr :: Array
arr@(A.ByteArray ByteArray#
arr#) Int
off Int
len) = Int -> [Text]
go Int
off
  where
    go :: Int -> [Text]
go !Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off = []
      | Int
delta Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Array -> Int -> Int -> Text
Text Array
arr Int
n (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)]
      | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
n Int
delta Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        delta :: Int
delta = CSsize -> Int
cSsizeToInt (CSsize -> Int) -> CSsize -> Int
forall a b. (a -> b) -> a -> b
$
          ByteArray# -> CSize -> CSize -> Word8 -> CSsize
memchr ByteArray#
arr# (Int -> CSize
intToCSize Int
n) (Int -> CSize
intToCSize (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)) Word8
0x0A
{-# INLINE lines #-}

foreign import ccall unsafe "_hs_text_memchr" memchr
    :: ByteArray# -> CSize -> CSize -> Word8 -> CSsize

-- | /O(n)/ Joins lines, after appending a terminating newline to
-- each.
unlines :: [Text] -> Text
unlines :: [Text] -> Text
unlines = [Text] -> Text
concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> [Text]) -> [Text] -> [Text] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\Text
t [Text]
acc -> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Char -> Text
singleton Char
'\n' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) []
{-# INLINE unlines #-}

-- | /O(n)/ Joins words using single space characters.
unwords :: [Text] -> Text
unwords :: [Text] -> Text
unwords = Text -> [Text] -> Text
intercalate (Char -> Text
singleton Char
' ')
{-# INLINE unwords #-}

-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
-- 'True' if and only if the first is a prefix of the second.
isPrefixOf :: Text -> Text -> Bool
isPrefixOf :: Text -> Text -> Bool
isPrefixOf a :: Text
a@(Text Array
_ Int
_ Int
alen) b :: Text
b@(Text Array
_ Int
_ Int
blen) =
    Int
alen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
blen Bool -> Bool -> Bool
&& Stream Char -> Stream Char -> Bool
forall a. Eq a => Stream a -> Stream a -> Bool
S.isPrefixOf (Text -> Stream Char
stream Text
a) (Text -> Stream Char
stream Text
b)
{-# INLINE [1] isPrefixOf #-}

-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
-- 'True' if and only if the first is a suffix of the second.
isSuffixOf :: Text -> Text -> Bool
isSuffixOf :: Text -> Text -> Bool
isSuffixOf a :: Text
a@(Text Array
_aarr Int
_aoff Int
alen) b :: Text
b@(Text Array
barr Int
boff Int
blen) =
    Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b'
  where d :: Int
d              = Int
blen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alen
        b' :: Text
b' | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Text
b
           | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
barr (Int
boffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Int
alen
{-# INLINE isSuffixOf #-}

-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
-- 'True' if and only if the first is contained, wholly and intact, anywhere
-- within the second.
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
isInfixOf ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  Text -> Text -> Bool
isInfixOf :: Text -> Text -> Bool
isInfixOf Text
needle Text
haystack
    | Text -> Bool
null Text
needle        = Bool
True
    | Text -> Bool
isSingleton Text
needle = Char -> Stream Char -> Bool
S.elem (Text -> Char
unsafeHead Text
needle) (Stream Char -> Bool) -> (Text -> Stream Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
S.stream (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
haystack
    | Bool
otherwise          = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null ([Int] -> Bool) -> (Text -> [Int]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Int]
indices Text
needle (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
haystack
{-# INLINE [1] isInfixOf #-}

-------------------------------------------------------------------------------
-- * View patterns

-- | /O(n)/ Return the suffix of the second string if its prefix
-- matches the entire first string.
--
-- Examples:
--
-- >>> stripPrefix "foo" "foobar"
-- Just "bar"
--
-- >>> stripPrefix ""    "baz"
-- Just "baz"
--
-- >>> stripPrefix "foo" "quux"
-- Nothing
--
-- This is particularly useful with the @ViewPatterns@ extension to
-- GHC, as follows:
--
-- > {-# LANGUAGE ViewPatterns #-}
-- > import Data.Text as T
-- >
-- > fnordLength :: Text -> Int
-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
-- > fnordLength _                                 = -1
stripPrefix :: Text -> Text -> Maybe Text
stripPrefix :: Text -> Text -> Maybe Text
stripPrefix p :: Text
p@(Text Array
_arr Int
_off Int
plen) t :: Text
t@(Text Array
arr Int
off Int
len)
    | Text
p Text -> Text -> Bool
`isPrefixOf` Text
t = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
plen) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
plen)
    | Bool
otherwise        = Maybe Text
forall a. Maybe a
Nothing

-- | /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.
--
-- If the strings do not have a common prefix or either one is empty,
-- this function returns 'Nothing'.
--
-- Examples:
--
-- >>> commonPrefixes "foobar" "fooquux"
-- Just ("foo","bar","quux")
--
-- >>> commonPrefixes "veeble" "fetzer"
-- Nothing
--
-- >>> commonPrefixes "" "baz"
-- Nothing
commonPrefixes :: Text -> Text -> Maybe (Text, Text, Text)
commonPrefixes :: Text -> Text -> Maybe (Text, Text, Text)
commonPrefixes !t0 :: Text
t0@(Text Array
arr0 Int
off0 Int
len0) !t1 :: Text
t1@(Text Array
arr1 Int
off1 Int
len1)
  | Int
len0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (Text, Text, Text)
forall a. Maybe a
Nothing
  | Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (Text, Text, Text)
forall a. Maybe a
Nothing
  | Bool
otherwise = Int -> Int -> Maybe (Text, Text, Text)
go Int
0 Int
0
  where
    go :: Int -> Int -> Maybe (Text, Text, Text)
go !Int
i !Int
j
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len0 = (Text, Text, Text) -> Maybe (Text, Text, Text)
forall a. a -> Maybe a
Just (Text
t0, Text
empty, Array -> Int -> Int -> Text
text Array
arr1 (Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len1 = (Text, Text, Text) -> Maybe (Text, Text, Text)
forall a. a -> Maybe a
Just (Text
t1, Array -> Int -> Int -> Text
text Array
arr0 (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i), Text
empty)
      | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b = Int -> Int -> Maybe (Text, Text, Text)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
k
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Text, Text, Text) -> Maybe (Text, Text, Text)
forall a. a -> Maybe a
Just (Array -> Int -> Int -> Text
Text Array
arr0 Int
off0 Int
k,
                      Array -> Int -> Int -> Text
Text Array
arr0 (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) (Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k),
                      Array -> Int -> Int -> Text
Text Array
arr1 (Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k))
      | Bool
otherwise = Maybe (Text, Text, Text)
forall a. Maybe a
Nothing
      where
        a :: Word8
a = Array -> Int -> Word8
A.unsafeIndex Array
arr0 (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
        b :: Word8
b = Array -> Int -> Word8
A.unsafeIndex Array
arr1 (Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
        isLeader :: Bool
isLeader = Word8 -> Int8
word8ToInt8 Word8
a Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int8
64
        k :: Int
k = if Bool
isLeader then Int
i else Int
j
{-# INLINE commonPrefixes #-}

-- | /O(n)/ Return the prefix of the second string if its suffix
-- matches the entire first string.
--
-- Examples:
--
-- >>> stripSuffix "bar" "foobar"
-- Just "foo"
--
-- >>> stripSuffix ""    "baz"
-- Just "baz"
--
-- >>> stripSuffix "foo" "quux"
-- Nothing
--
-- This is particularly useful with the @ViewPatterns@ extension to
-- GHC, as follows:
--
-- > {-# LANGUAGE ViewPatterns #-}
-- > import Data.Text as T
-- >
-- > quuxLength :: Text -> Int
-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
-- > quuxLength _                                = -1
stripSuffix :: Text -> Text -> Maybe Text
stripSuffix :: Text -> Text -> Maybe Text
stripSuffix p :: Text
p@(Text Array
_arr Int
_off Int
plen) t :: Text
t@(Text Array
arr Int
off Int
len)
    | Text
p Text -> Text -> Bool
`isSuffixOf` Text
t = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Text
text Array
arr Int
off (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
plen)
    | Bool
otherwise        = Maybe Text
forall a. Maybe a
Nothing

-- | Add a list of non-negative numbers.  Errors out on overflow.
sumP :: String -> [Int] -> Int
sumP :: String -> [Int] -> Int
sumP String
fun = Int -> [Int] -> Int
go Int
0
  where go :: Int -> [Int] -> Int
go !Int
a (Int
x:[Int]
xs)
            | Int
ax Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0   = Int -> [Int] -> Int
go Int
ax [Int]
xs
            | Bool
otherwise = String -> Int
forall a. HasCallStack => String -> a
overflowError String
fun
          where ax :: Int
ax = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
        go Int
a  [Int]
_         = Int
a

emptyError :: HasCallStack => String -> a
emptyError :: forall a. HasCallStack => String -> a
emptyError String
fun = String -> a
forall a. HasCallStack => String -> a
P.error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.Text." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": empty input"

overflowError :: HasCallStack => String -> a
overflowError :: forall a. HasCallStack => String -> a
overflowError String
fun = String -> a
forall a. HasCallStack => String -> a
P.error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.Text." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": size overflow"

-- | /O(n)/ Make a distinct copy of the given string, sharing no
-- storage with the original string.
--
-- As an example, suppose you read a large string, of which you need
-- only a small portion.  If you do not use 'copy', the entire original
-- array will be kept alive in memory by the smaller string. Making a
-- copy \"breaks the link\" to the original array, allowing it to be
-- garbage collected if there are no other live references to it.
copy :: Text -> Text
copy :: Text -> Text
copy (Text Array
arr Int
off Int
len) = Array -> Int -> Int -> Text
Text ((forall s. ST s (MArray s)) -> Array
A.run ST s (MArray s)
forall s. ST s (MArray s)
go) Int
0 Int
len
  where
    go :: ST s (A.MArray s)
    go :: forall s. ST s (MArray s)
go = do
      MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
      Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
len MArray s
marr Int
0 Array
arr Int
off
      MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr

ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

cSsizeToInt :: CSsize -> Int
cSsizeToInt :: CSsize -> Int
cSsizeToInt = CSsize -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

word8ToInt8 :: Word8 -> Int8
word8ToInt8 :: Word8 -> Int8
word8ToInt8 = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

-------------------------------------------------
-- NOTE: the named chunk below used by doctest;
--       verify the doctests via `doctest -fobject-code Data/Text.hs`

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import qualified Data.Text as T