{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, 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
(
Text
, pack
, unpack
, singleton
, empty
, cons
, snoc
, append
, uncons
, unsnoc
, head
, last
, tail
, init
, null
, length
, compareLength
, map
, intercalate
, intersperse
, transpose
, reverse
, replace
, toCaseFold
, toLower
, toUpper
, toTitle
, justifyLeft
, justifyRight
, center
, foldl
, foldl'
, foldl1
, foldl1'
, foldr
, foldr'
, foldr1
, concat
, concatMap
, any
, all
, maximum
, minimum
, isAscii
, scanl
, scanl1
, scanr
, scanr1
, mapAccumL
, mapAccumR
, replicate
, unfoldr
, unfoldrN
, take
, takeEnd
, drop
, dropEnd
, takeWhile
, takeWhileEnd
, dropWhile
, dropWhileEnd
, dropAround
, strip
, stripStart
, stripEnd
, splitAt
, breakOn
, breakOnEnd
, break
, span
, spanM
, spanEndM
, group
, groupBy
, inits
, tails
, splitOn
, split
, chunksOf
, lines
, words
, unlines
, unwords
, isPrefixOf
, isSuffixOf
, isInfixOf
, stripPrefix
, stripSuffix
, commonPrefixes
, filter
, breakOnAll
, find
, elem
, partition
, index
, findIndex
, count
, zip
, zipWith
, 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 qualified Data.Char as Char
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
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]
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
instance IsString Text where
fromString :: String -> Text
fromString = String -> Text
pack
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
_ = ()
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
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
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# #-}
#endif
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]
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
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`
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
{-# 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)
#-}
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
#-}
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
#-}
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 #-}
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 #-}
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 #-}
foreign import ccall unsafe "_hs_text_reverse" c_reverse
:: Exts.MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
replace :: HasCallStack
=> Text
-> Text
-> Text
-> 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
caseConvert :: (Word8 -> Word8) -> (Exts.Char# -> _ ) -> 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
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
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
| 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 #-}
toCaseFold :: Text -> Text
toCaseFold :: Text -> Text
toCaseFold = \Text
xs -> (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 Text
xs
{-# INLINE toCaseFold #-}
toLower :: Text -> Text
toLower :: Text -> Text
toLower = \Text
xs -> (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 Text
xs
{-# INLINE toLower #-}
toUpper :: Text -> Text
toUpper :: Text -> Text
toUpper = \Text
xs -> (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 Text
xs
{-# INLINE toUpper #-}
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 #-}
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 #-}
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 #-}
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 #-}
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))
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 #-}
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' #-}
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 #-}
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' #-}
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 #-}
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 #-}
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' #-}
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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
isAscii :: Text -> Bool
isAscii :: Text -> Bool
isAscii (Text (A.ByteArray ByteArray#
arr) Int
off Int
len) =
CSize -> Int
cSizeToInt (ByteArray# -> CSize -> CSize -> CSize
c_is_ascii_offset ByteArray#
arr (Int -> CSize
intToCSize Int
off) (Int -> CSize
intToCSize Int
len)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
{-# INLINE isAscii #-}
cSizeToInt :: CSize -> Int
cSizeToInt :: CSize -> Int
cSizeToInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
{-# INLINE cSizeToInt #-}
foreign import ccall unsafe "_hs_text_is_ascii_offset" c_is_ascii_offset
:: ByteArray# -> CSize -> CSize -> CSize
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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
#-}
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
Char.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
Char.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 #-}
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 #-}
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 #-}
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 #-}
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)
foreign import ccall unsafe "_hs_text_measure_off" c_measure_off
:: ByteArray# -> CSize -> CSize -> CSize -> CSsize
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
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 #-}
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)
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
stripStart :: Text -> Text
stripStart :: Text -> Text
stripStart = (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
Char.isSpace
{-# INLINE stripStart #-}
stripEnd :: Text -> Text
stripEnd :: Text -> Text
stripEnd = (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
Char.isSpace
{-# INLINE [1] stripEnd #-}
strip :: Text -> Text
strip :: Text -> Text
strip = (Char -> Bool) -> Text -> Text
dropAround Char -> Bool
Char.isSpace
{-# INLINE [1] strip #-}
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)
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 #-}
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 #-}
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 #-}
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 #-}
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))
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
group :: Text -> [Text]
group :: Text -> [Text]
group = (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)
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)
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)
splitOn :: HasCallStack
=> Text
-> 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
#-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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
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
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
| 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
#-}
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 #-}
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 #-}
breakOnAll :: HasCallStack
=> Text
-> Text
-> [(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 #-}
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 #-}
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 #-}
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
#-}
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 #-}
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 #-}
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 #-}
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)]
| 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)
| 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)
| 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
Char.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 #-}
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 #-}
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
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 #-}
unwords :: [Text] -> Text
unwords :: [Text] -> Text
unwords = Text -> [Text] -> Text
intercalate (Char -> Text
singleton Char
' ')
{-# INLINE unwords #-}
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 #-}
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 #-}
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 #-}
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
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 #-}
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
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"
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
Char.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