{-# 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 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) <- 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 = 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
pack
toList :: Text -> [Item Text]
toList = Text -> String
unpack
instance NFData Text where rnf :: Text -> ()
rnf !Text
_ = ()
instance Binary Text where
put :: Text -> Put
put Text
t = forall t. Binary t => t -> Put
put (Text -> ByteString
encodeUtf8 Text
t)
get :: Get Text
get = do
ByteString
bs <- forall t. Binary t => Get t
get
case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
P.Left UnicodeException
exn -> forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (forall a. Show a => a -> String
P.show UnicodeException
exn)
P.Right Text
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 = forall g. g -> c g
z String -> Text
pack 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 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z String -> Text
pack)
Int
_ -> 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) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ Text -> IO (ForeignPtr Word8, I8)
asForeignPtr Text
txt
let lenInt :: Word
lenInt = forall a b. (Integral a, Num b) => a -> b
P.fromIntegral I8
len
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE 'unpackCStringLen#) (forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Lit
TH.bytesPrimL forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Word -> Word -> Bytes
TH.mkBytes ForeignPtr Word8
ptr Word
0 Word
lenInt)) (forall t (m :: * -> *). (Lift t, Quote m) => t -> 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 = forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new Int
l
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
marr Int
0 (forall a. Addr# -> Ptr a
Exts.Ptr Addr#
addr#) Int
l
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 = forall a. IsChar a => [a] -> FieldFormatter
formatString 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 (forall a. Ord a => a -> a -> a
min Int
lenA Int
lenB) forall a. Semigroup a => a -> a -> a
<> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Stream Char -> Stream Char
S.cons (Char -> Char
safe Char
c) 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
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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just 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
offforall a. Num a => a -> a -> a
+Int
d) (Int
lenforall 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => String -> a
emptyError String
"last"
| Bool
otherwise = let Iter Char
c Int
_ = Text -> Int -> Iter
reverseIter Text
t (Int
len 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => String -> a
emptyError String
"tail"
| Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
d) (Int
lenforall 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => String -> a
emptyError String
"init"
| Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr Int
off (Int
len forall a. Num a => a -> a -> a
+ Text -> Int -> Int
reverseIter_ Text
t (Int
len 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Array -> Int -> Int -> Text
text Array
arr Int
off (Int
len 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 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 forall a. Ord a => a -> a -> Bool
<= Int
0
{-# INLINE [1] null #-}
isSingleton :: Text -> Bool
isSingleton :: Text -> Bool
isSingleton = Stream Char -> Bool
S.isSingleton 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 = forall a. Num a => a -> a
P.negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Int
measureOff 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 = 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new (Int
l forall a. Num a => a -> a -> a
+ Int
4)
forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer MArray s
marr (Int
l 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 forall a. Ord a => a -> a -> Bool
>= Int
l forall a. Num a => a -> a -> a
+ Int
o = do
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
| Int
dstOff forall a. Num a => a -> a -> a
+ Int
4 forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen forall a. Num a => a -> a -> a
+ (Int
l forall a. Num a => a -> a -> a
+ Int
o) forall a. Num a => a -> a -> a
- Int
srcOff forall a. Num a => a -> a -> a
+ Int
4
MArray s
dst' <- forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
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' <- 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 forall a. Num a => a -> a -> a
+ Int
d) (Int
dstOff 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== Int
0 then forall a. Monoid a => a
mempty else forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let !cLen :: Int
cLen = Char -> Int
utf8Length Char
c
dstLen :: Int
dstLen = Int
l forall a. Num a => a -> a -> a
+ Text -> Int
length Text
t forall a. Num a => a -> a -> a
P.* Int
cLen
MArray s
dst <- 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 ->
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
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
c0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff 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
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
c0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
c1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff 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
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
c0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
c1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
c2
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff 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 forall a. Ord a => a -> a -> Bool
>= Int
o forall a. Num a => a -> a -> a
+ Int
l then 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 forall a. Num a => a -> a -> a
+ Int
1)
m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff forall a. Num a => a -> a -> a
+ Int
2)
m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff forall a. Num a => a -> a -> a
+ Int
3)
!d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
case Int
d of
Int
1 -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
Int -> ST s ()
writeSep (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1)
Int -> Int -> ST s ()
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
cLen)
Int
2 -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
Int -> ST s ()
writeSep (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2)
Int -> Int -> ST s ()
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
2) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
cLen)
Int
3 -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
Int -> ST s ()
writeSep (Int
dstOff forall a. Num a => a -> a -> a
+ Int
3)
Int -> Int -> ST s ()
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
3) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
3 forall a. Num a => a -> a -> a
+ Int
cLen)
Int
_ -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
Int -> ST s ()
writeSep (Int
dstOff forall a. Num a => a -> a -> a
+ Int
4)
Int -> Int -> ST s ()
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
4) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
cLen)
Int -> Int -> ST s ()
go Int
o Int
0
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 (Int
dstLen 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
marr :: MArray s
marr@(A.MutableByteArray MutableByteArray# s
mba) <- forall s. Int -> ST s (MArray s)
A.new Int
len
forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ 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 <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. HasCallStack => String -> a
emptyError String
"replace"
| forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Int]
ixs = Text
haystack
| Int
len forall a. Ord a => a -> a -> Bool
> Int
0 = Array -> Int -> Int -> Text
Text ((forall s. ST s (MArray s)) -> Array
A.run 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 forall a. Num a => a -> a -> a
- (Int
neeLen forall a. Num a => a -> a -> a
- Int
repLen) Int -> Int -> Int
`mul` 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 <- 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 forall a. Num a => a -> a -> a
+ Int
i forall a. Num a => a -> a -> a
- Int
o
d1 :: Int
d1 = Int
d0 forall a. Num a => a -> a -> a
+ Int
repLen
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI (Int
i forall a. Num a => a -> a -> a
- Int
o) MArray s
marr Int
d Array
hayArr (Int
hayOffforall a. Num a => a -> a -> a
+Int
o)
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 forall a. Num a => a -> a -> a
+ Int
neeLen) Int
d1
loop [] Int
o Int
d = forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI (Int
len forall a. Num a => a -> a -> a
- Int
d) MArray s
marr Int
d Array
hayArr (Int
hayOffforall a. Num a => a -> a -> a
+Int
o)
[Int] -> Int -> Int -> ST s ()
loop [Int]
ixs Int
0 Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr
caseConvert :: (Word8 -> Word8) -> (Exts.Char# -> _ ) -> Text -> Text
caseConvert :: (Word8 -> Word8) -> (Char# -> Int#) -> Text -> Text
caseConvert Word8 -> Word8
ascii Char# -> Int#
remap (Text Array
src Int
o Int
l) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
dst <- forall s. Int -> ST s (MArray s)
A.new (Int
l forall a. Num a => a -> a -> a
+ Int
12)
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 forall a. Ord a => a -> a -> Bool
>= Int
o forall a. Num a => a -> a -> a
+ Int
l = do
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
| Int
dstOff forall a. Num a => a -> a -> a
+ Int
12 forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
max Int
12 (Int
l forall a. Num a => a -> a -> a
+ Int
o forall a. Num a => a -> a -> a
- Int
srcOff)
MArray s
dst' <- forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
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 forall a. Num a => a -> a -> a
+ Int
1)
m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff forall a. Num a => a -> a -> a
+ Int
2)
m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff forall a. Num a => a -> a -> a
+ Int
3)
!d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
case Int
d of
Int
1 -> do
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 forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff 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 Int# -> Int64
I64# (Char# -> Int#
remap Char#
c) of
Int64
0 -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
dstOff 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 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 Int# -> Int64
I64# (Char# -> Int#
remap Char#
c) of
Int64
0 -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
dstOff 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 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 Int# -> Int64
I64# (Char# -> Int#
remap Char#
c) of
Int64
0 -> do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
dstOff 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 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 = 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 <- 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 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 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 forall a. Bits a => a -> Int -> a
`shiftL` Int
21) forall a. Num a => a -> a -> a
- Int64
1
a :: Int
a = forall a b. (Integral a, Num b) => a -> b
P.fromIntegral forall a b. (a -> b) -> a -> b
$ Int64
ab forall a. Bits a => a -> a -> a
.&. Int64
mask
{-# INLINE caseConvert #-}
toCaseFold :: Text -> Text
toCaseFold :: Text -> Text
toCaseFold = \Text
xs -> (Word8 -> Word8) -> (Char# -> Int#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w forall a. Num a => a -> a -> a
- Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) Char# -> Int#
foldMapping Text
xs
{-# INLINE toCaseFold #-}
toLower :: Text -> Text
toLower :: Text -> Text
toLower = \Text
xs -> (Word8 -> Word8) -> (Char# -> Int#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w forall a. Num a => a -> a -> a
- Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) Char# -> Int#
lowerMapping Text
xs
{-# INLINE toLower #-}
toUpper :: Text -> Text
toUpper :: Text -> Text
toUpper = \Text
xs -> (Word8 -> Word8) -> (Char# -> Int#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w forall a. Num a => a -> a -> a
- Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w forall a. Num a => a -> a -> a
- Word8
32 else Word8
w) Char# -> Int#
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 forall a. Ord a => a -> a -> Bool
>= Int
k = Text
t
| Bool
otherwise = Text
t Text -> Text -> Text
`append` Int -> Char -> Text
replicateChar (Int
kforall 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 forall a. Ord a => a -> a -> Bool
>= Int
k = Text
t
| Bool
otherwise = Int -> Char -> Text
replicateChar (Int
kforall 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 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 forall a. Num a => a -> a -> a
- Int
len
r :: Int
r = Int
d forall a. Integral a => a -> a -> a
`quot` Int
2
l :: Int
l = Int
d forall a. Num a => a -> a -> a
- Int
r
{-# INLINE center #-}
transpose :: [Text] -> [Text]
transpose :: [Text] -> [Text]
transpose [Text]
ts = forall a b. (a -> b) -> [a] -> [b]
P.map String -> Text
pack (forall a. [[a]] -> [[a]]
L.transpose (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 = 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 = 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
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
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 = 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
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 = forall b. (b -> Char -> b) -> b -> Stream Char -> b
S.foldl' (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 forall s. ST s (MArray s)
go) Int
0 Int
len
where
ts' :: [Text]
ts' = forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null) [Text]
ts
len :: Int
len = String -> [Int] -> Int
sumP String
"concat" forall a b. (a -> b) -> a -> b
$ 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 <- 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) = forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
l MArray s
arr Int
i Array
a Int
o forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i forall a. Num a => a -> a -> a
+ Int
l)
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' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Char -> a -> a) -> a -> Text -> a
foldr ((:) 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
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
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)) forall a. Eq a => a -> a -> Bool
== Int
len
{-# INLINE isAscii #-}
cSizeToInt :: CSize -> Int
cSizeToInt :: CSize -> Int
cSizeToInt = 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 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 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
last Text
t) (HasCallStack => 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new (Int
l forall a. Num a => a -> a -> a
+ Int
4)
forall s. MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
marr (Int
l 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 forall a. Ord a => a -> a -> Bool
>= Int
l forall a. Num a => a -> a -> a
+ Int
o = do
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z, Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
| Int
dstOff forall a. Num a => a -> a -> a
+ Int
4 forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen forall a. Num a => a -> a -> a
+ (Int
l forall a. Num a => a -> a -> a
+ Int
o) forall a. Num a => a -> a -> a
- Int
srcOff forall a. Num a => a -> a -> a
+ Int
4
MArray s
dst' <- forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
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' <- 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 forall a. Num a => a -> a -> a
+ Int
d) (Int
dstOff 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new (Int
l forall a. Num a => a -> a -> a
+ Int
4)
forall s. MArray s -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
marr (Int
l forall a. Num a => a -> a -> a
+ Int
o forall a. Num a => a -> a -> a
- Int
1) (Int
l forall a. Num a => a -> a -> a
+ Int
4 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 forall a. Ord a => a -> a -> Bool
< Int
o = do
Int
dstLen <- forall s. MArray s -> ST s Int
A.getSizeofMArray MArray s
dst
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z, Array -> Int -> Int -> Text
Text Array
arr (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) (Int
dstLen forall a. Num a => a -> a -> a
- Int
dstOff forall a. Num a => a -> a -> a
- Int
1))
| Int
dstOff forall a. Ord a => a -> a -> Bool
< Int
3 = do
Int
dstLen <- forall s. MArray s -> ST s Int
A.getSizeofMArray MArray s
dst
let !dstLen' :: Int
dstLen' = Int
dstLen forall a. Num a => a -> a -> a
+ (Int
srcOff forall a. Num a => a -> a -> a
- Int
o) forall a. Num a => a -> a -> a
+ Int
4
MArray s
dst' <- forall s. Int -> ST s (MArray s)
A.new Int
dstLen'
forall s. MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
A.copyM MArray s
dst' (Int
dstLen' forall a. Num a => a -> a -> a
- Int
dstLen) MArray s
dst Int
0 Int
dstLen
forall s. MArray s -> Int -> Int -> a -> ST s (a, Text)
outer MArray s
dst' Int
srcOff (Int
dstOff forall a. Num a => a -> a -> a
+ Int
dstLen' 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 forall a. Num a => a -> a -> a
- Int
d'
Int
_ <- forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst (Int
dstOff' forall a. Num a => a -> a -> a
+ Int
1) Char
c''
Int -> Int -> a -> ST s (a, Text)
inner (Int
srcOff 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 forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
| Int
n 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let totalLen :: Int
totalLen = Int
n Int -> Int -> Int
`mul` Int
l
MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new Int
totalLen
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
l MArray s
marr Int
0 Array
a Int
o
forall s. MArray s -> Int -> ST s ()
A.tile MArray s
marr Int
l
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
| Char -> Bool
Char.isAscii Char
c = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
marr <- forall s. Int -> Int -> ST s (MArray s)
A.newFilled Int
len (Char -> Int
Char.ord Char
c)
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
len
| Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let cLen :: Int
cLen = Char -> Int
utf8Length Char
c
totalLen :: Int
totalLen = Int
cLen forall a. Num a => a -> a -> a
P.* Int
len
MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new Int
totalLen
Int
_ <- forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
forall s. MArray s -> Int -> ST s ()
A.tile MArray s
marr Int
cLen
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. (a -> Maybe (Char, a)) -> a -> Stream Char
S.unfoldr (forall a c b. (a -> c) -> Maybe (a, b) -> Maybe (c, b)
firstf Char -> Char
safe 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 (forall a. Int -> (a -> Maybe (Char, a)) -> a -> Stream Char
S.unfoldrN Int
n (forall a c b. (a -> c) -> Maybe (a, b) -> Maybe (c, b)
firstf Char -> Char
safe 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
| Int
n 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 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 forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else
CSsize -> Int
cSsizeToInt 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = Text
t
| Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
i) (Int
lenforall 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
lenforall a. Num a => a -> a -> a
-Int
1) Int
n
where loop :: Int -> Int -> Int
loop Int
i !Int
m
| Int
m forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
iforall a. Num a => a -> a -> a
+Int
1
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
0
| Bool
otherwise = Int -> Int -> Int
loop (Int
iforall a. Num a => a -> a -> a
+Int
d) (Int
mforall 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
t
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = Text
empty
| Bool
otherwise = if Int
m forall a. Ord a => a -> a -> Bool
>= Int
0 then Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
m) (Int
lenforall a. Num a => a -> a -> a
-Int
m) else 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
t
| Int
n 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 forall a. Ord a => a -> a -> Bool
>= Int
len = Text
t
| Char -> Bool
p Char
c = Int -> Text
loop (Int
iforall 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
lenforall a. Num a => a -> a -> a
-Int
1) Int
len
where loop :: Int -> Int -> Text
loop !Int
i !Int
l | Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
t
| Char -> Bool
p Char
c = Int -> Int -> Text
loop (Int
iforall a. Num a => a -> a -> a
+Int
d) (Int
lforall a. Num a => a -> a -> a
+Int
d)
| Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
l) (Int
lenforall 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 forall a. Ord a => a -> a -> Bool
>= Int
len = Text
empty
| Char -> Bool
p Char
c = Int -> Int -> Text
loop (Int
iforall a. Num a => a -> a -> a
+Int
d) (Int
lforall a. Num a => a -> a -> a
+Int
d)
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
i) (Int
lenforall 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
lenforall a. Num a => a -> a -> a
-Int
1) Int
len
where loop :: Int -> Int -> Text
loop !Int
i !Int
l | Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
empty
| Char -> Bool
p Char
c = Int -> Int -> Text
loop (Int
iforall a. Num a => a -> a -> a
+Int
d) (Int
lforall 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 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text
empty, Text
t)
| Int
n 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 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
offforall a. Num a => a -> a -> a
+Int
m) (Int
lenforall a. Num a => a -> a -> a
-Int
m)) else (Text
t, 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 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 forall a. Ord a => a -> a -> Bool
< Int
len = case Array -> Int -> Iter
iterArray Array
arr (Int
offforall 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
iforall a. Num a => a -> a -> a
+Int
l)
else 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
offforall a. Num a => a -> a -> a
+Int
i) (Int
lenforall a. Num a => a -> a -> a
-Int
i))
go Int
_ = 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
lenforall a. Num a => a -> a -> a
-Int
1)
where
go :: Int -> m (Text, Text)
go !Int
i | Int
0 forall a. Ord a => a -> a -> Bool
<= Int
i = case Array -> Int -> Iter
reverseIterArray Array
arr (Int
offforall 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
iforall a. Num a => a -> a -> a
+Int
l)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array -> Int -> Int -> Text
text Array
arr Int
off (Int
iforall a. Num a => a -> a -> a
+Int
1), Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
lenforall a. Num a => a -> a -> a
-Int
iforall a. Num a => a -> a -> a
-Int
1))
go Int
_ = 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 forall a. a -> [a] -> [a]
: Text -> [Text]
loop (Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
n) (Int
lenforall 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 forall a. Num a => a -> a -> a
+ (Char -> Bool) -> Text -> Int
findAIndexOrEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
p Char
c) (Array -> Int -> Int -> Text
Text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
d) (Int
lenforall 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 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
iforall 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 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 forall a. Ord a => a -> a -> Bool
>= Int
len = [Text
t]
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off Int
i forall a. a -> [a] -> [a]
: Int -> [Text]
loop (Int
i 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 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => String -> a
emptyError String
"splitOn"
| Text -> Bool
isSingleton Text
pat = (Char -> Bool) -> Text -> [Text]
split (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
sforall a. Num a => a -> a -> a
+Int
off) (Int
xforall a. Num a => a -> a -> a
-Int
s) forall a. a -> [a] -> [a]
: Int -> [Int] -> [Text]
go (Int
xforall a. Num a => a -> a -> a
+Int
l) [Int]
xs
go Int
s [Int]
_ = [Array -> Int -> Int -> Text
text Array
arr (Int
sforall a. Num a => a -> a -> a
+Int
off) (Int
lenforall 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 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 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 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 (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 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let !dstLen :: Int
dstLen = forall a. Ord a => a -> a -> a
min Int
l Int
64
MArray s
dst <- forall s. Int -> ST s (MArray s)
A.new Int
dstLen
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 forall a. Ord a => a -> a -> Bool
>= Int
o forall a. Num a => a -> a -> a
+ Int
l = do
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
dstOff)
| Int
dstOff forall a. Num a => a -> a -> a
+ Int
4 forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
max Int
4 (forall a. Ord a => a -> a -> a
min (Int
l forall a. Num a => a -> a -> a
+ Int
o forall a. Num a => a -> a -> a
- Int
srcOff) Int
dstLen)
MArray s
dst' <- forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
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 forall a. Num a => a -> a -> a
+ Int
1)
m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff forall a. Num a => a -> a -> a
+ Int
2)
m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff 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 forall a. Num a => a -> a -> a
+ Int
1) Int
dstOff else do
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 forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff 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 forall a. Num a => a -> a -> a
+ Int
2) Int
dstOff else do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
Int -> Int -> ST s Text
inner (Int
srcOff forall a. Num a => a -> a -> a
+ Int
2) (Int
dstOff 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 forall a. Num a => a -> a -> a
+ Int
3) Int
dstOff else do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
Int -> Int -> ST s Text
inner (Int
srcOff forall a. Num a => a -> a -> a
+ Int
3) (Int
dstOff 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 forall a. Num a => a -> a -> a
+ Int
4) Int
dstOff else do
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
Int -> Int -> ST s Text
inner (Int
srcOff forall a. Num a => a -> a -> a
+ Int
4) (Int
dstOff 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 = 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
offforall a. Num a => a -> a -> a
+Int
x) (Int
lenforall 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)
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 = forall a. HasCallStack => String -> a
emptyError String
"breakOnAll"
| Bool
otherwise = 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
slenforall 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
nforall 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
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 = forall a. HasCallStack => String -> a
emptyError String
"count"
| Text -> Bool
isSingleton Text
pat = Char -> Text -> Int
countChar (Text -> Char
unsafeHead Text
pat)
| Bool
otherwise = forall (t :: * -> *) a. Foldable t => t a -> Int
L.length 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 = forall a. Stream a -> [a]
S.unstreamList forall a b. (a -> b) -> a -> b
$ 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 (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 forall a. Ord a => a -> a -> Bool
>= Int
len = if Int
start forall a. Eq a => a -> a -> Bool
== Int
n
then []
else [Array -> Int -> Int -> Text
Text Array
arr (Int
start forall a. Num a => a -> a -> a
+ Int
off) (Int
n forall a. Num a => a -> a -> a
- Int
start)]
| Word8 -> Bool
isAsciiSpace Word8
w0 =
if Int
start forall a. Eq a => a -> a -> Bool
== Int
n
then Int -> Int -> [Text]
loop (Int
n forall a. Num a => a -> a -> a
+ Int
1) (Int
n forall a. Num a => a -> a -> a
+ Int
1)
else Array -> Int -> Int -> Text
Text Array
arr (Int
start forall a. Num a => a -> a -> a
+ Int
off) (Int
n forall a. Num a => a -> a -> a
- Int
start) forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
n forall a. Num a => a -> a -> a
+ Int
1) (Int
n forall a. Num a => a -> a -> a
+ Int
1)
| Word8
w0 forall a. Ord a => a -> a -> Bool
< Word8
0x80 = Int -> Int -> [Text]
loop Int
start (Int
n forall a. Num a => a -> a -> a
+ Int
1)
| Word8
w0 forall a. Eq a => a -> a -> Bool
== Word8
0xC2, Word8
w1 forall a. Eq a => a -> a -> Bool
== Word8
0xA0 =
if Int
start forall a. Eq a => a -> a -> Bool
== Int
n
then Int -> Int -> [Text]
loop (Int
n forall a. Num a => a -> a -> a
+ Int
2) (Int
n forall a. Num a => a -> a -> a
+ Int
2)
else Array -> Int -> Int -> Text
Text Array
arr (Int
start forall a. Num a => a -> a -> a
+ Int
off) (Int
n forall a. Num a => a -> a -> a
- Int
start) forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
n forall a. Num a => a -> a -> a
+ Int
2) (Int
n forall a. Num a => a -> a -> a
+ Int
2)
| Word8
w0 forall a. Ord a => a -> a -> Bool
< Word8
0xE0 = Int -> Int -> [Text]
loop Int
start (Int
n forall a. Num a => a -> a -> a
+ Int
2)
| Word8
w0 forall a. Eq a => a -> a -> Bool
== Word8
0xE1 Bool -> Bool -> Bool
&& Word8
w1 forall a. Eq a => a -> a -> Bool
== Word8
0x9A Bool -> Bool -> Bool
&& Word8
w2 forall a. Eq a => a -> a -> Bool
== Word8
0x80
Bool -> Bool -> Bool
|| Word8
w0 forall a. Eq a => a -> a -> Bool
== Word8
0xE2 Bool -> Bool -> Bool
&& (Word8
w1 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 forall a. Eq a => a -> a -> Bool
== Word8
0x81 Bool -> Bool -> Bool
&& Word8
w2 forall a. Eq a => a -> a -> Bool
== Word8
0x9F)
Bool -> Bool -> Bool
|| Word8
w0 forall a. Eq a => a -> a -> Bool
== Word8
0xE3 Bool -> Bool -> Bool
&& Word8
w1 forall a. Eq a => a -> a -> Bool
== Word8
0x80 Bool -> Bool -> Bool
&& Word8
w2 forall a. Eq a => a -> a -> Bool
== Word8
0x80 =
if Int
start forall a. Eq a => a -> a -> Bool
== Int
n
then Int -> Int -> [Text]
loop (Int
n forall a. Num a => a -> a -> a
+ Int
3) (Int
n forall a. Num a => a -> a -> a
+ Int
3)
else Array -> Int -> Int -> Text
Text Array
arr (Int
start forall a. Num a => a -> a -> a
+ Int
off) (Int
n forall a. Num a => a -> a -> a
- Int
start) forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
n forall a. Num a => a -> a -> a
+ Int
3) (Int
n forall a. Num a => a -> a -> a
+ Int
3)
| Bool
otherwise = Int -> Int -> [Text]
loop Int
start (Int
n 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 forall a. Num a => a -> a -> a
+ Int
n)
w1 :: Word8
w1 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
off forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
+ Int
1)
w2 :: Word8
w2 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
off forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
+ Int
2)
{-# INLINE words #-}
isAsciiSpace :: Word8 -> Bool
isAsciiSpace :: Word8 -> Bool
isAsciiSpace Word8
w = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0x50 forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
< Word8
0x80 Bool -> Bool -> Bool
&& (Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w forall a. Num a => a -> a -> a
- Word8
0x09 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 forall a. Ord a => a -> a -> Bool
>= Int
len forall a. Num a => a -> a -> a
+ Int
off = []
| Int
delta forall a. Ord a => a -> a -> Bool
< Int
0 = [Array -> Int -> Int -> Text
Text Array
arr Int
n (Int
len forall a. Num a => a -> a -> a
+ Int
off forall a. Num a => a -> a -> a
- Int
n)]
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
n Int
delta forall a. a -> [a] -> [a]
: Int -> [Text]
go (Int
n forall a. Num a => a -> a -> a
+ Int
delta forall a. Num a => a -> a -> a
+ Int
1)
where
delta :: Int
delta = CSsize -> Int
cSsizeToInt 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 forall a. Num a => a -> a -> a
+ Int
off 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\Text
t [Text]
acc -> Text
t forall a. a -> [a] -> [a]
: Char -> Text
singleton Char
'\n' 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 forall a. Ord a => a -> a -> Bool
<= Int
blen Bool -> Bool -> 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 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Text
a forall a. Eq a => a -> a -> Bool
== Text
b'
where d :: Int
d = Int
blen forall a. Num a => a -> a -> a
- Int
alen
b' :: Text
b' | Int
d forall a. Eq a => a -> a -> Bool
== Int
0 = Text
b
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
barr (Int
boffforall 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
S.stream forall a b. (a -> b) -> a -> b
$ Text
haystack
| Bool
otherwise = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Int]
indices Text
needle 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
plen) (Int
lenforall a. Num a => a -> a -> a
-Int
plen)
| Bool
otherwise = 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 forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Maybe a
Nothing
| Int
len1 forall a. Eq a => a -> a -> Bool
== Int
0 = 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 forall a. Eq a => a -> a -> Bool
== Int
len0 = forall a. a -> Maybe a
Just (Text
t0, Text
empty, Array -> Int -> Int -> Text
text Array
arr1 (Int
off1 forall a. Num a => a -> a -> a
+ Int
i) (Int
len1 forall a. Num a => a -> a -> a
- Int
i))
| Int
i forall a. Eq a => a -> a -> Bool
== Int
len1 = forall a. a -> Maybe a
Just (Text
t1, Array -> Int -> Int -> Text
text Array
arr0 (Int
off0 forall a. Num a => a -> a -> a
+ Int
i) (Int
len0 forall a. Num a => a -> a -> a
- Int
i), Text
empty)
| Word8
a forall a. Eq a => a -> a -> Bool
== Word8
b = Int -> Int -> Maybe (Text, Text, Text)
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) Int
k
| Int
k forall a. Ord a => a -> a -> Bool
> Int
0 = 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 forall a. Num a => a -> a -> a
+ Int
k) (Int
len0 forall a. Num a => a -> a -> a
- Int
k),
Array -> Int -> Int -> Text
Text Array
arr1 (Int
off1 forall a. Num a => a -> a -> a
+ Int
k) (Int
len1 forall a. Num a => a -> a -> a
- Int
k))
| Bool
otherwise = forall a. Maybe a
Nothing
where
a :: Word8
a = Array -> Int -> Word8
A.unsafeIndex Array
arr0 (Int
off0 forall a. Num a => a -> a -> a
+ Int
i)
b :: Word8
b = Array -> Int -> Word8
A.unsafeIndex Array
arr1 (Int
off1 forall a. Num a => a -> a -> a
+ Int
i)
isLeader :: Bool
isLeader = Word8 -> Int8
word8ToInt8 Word8
a 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Text
text Array
arr Int
off (Int
lenforall a. Num a => a -> a -> a
-Int
plen)
| Bool
otherwise = 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 forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> [Int] -> Int
go Int
ax [Int]
xs
| Bool
otherwise = forall a. HasCallStack => String -> a
overflowError String
fun
where ax :: Int
ax = Int
a 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 = forall a. HasCallStack => String -> a
P.error forall a b. (a -> b) -> a -> b
$ String
"Data.Text." forall a. [a] -> [a] -> [a]
++ String
fun forall a. [a] -> [a] -> [a]
++ String
": empty input"
overflowError :: HasCallStack => String -> a
overflowError :: forall a. HasCallStack => String -> a
overflowError String
fun = forall a. HasCallStack => String -> a
P.error forall a b. (a -> b) -> a -> b
$ String
"Data.Text." forall a. [a] -> [a] -> [a]
++ String
fun 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 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 <- forall s. Int -> ST s (MArray s)
A.new Int
len
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
len MArray s
marr Int
0 Array
arr Int
off
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr
ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = forall a b. (Integral a, Num b) => a -> b
P.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord
intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
cSsizeToInt :: CSsize -> Int
cSsizeToInt :: CSsize -> Int
cSsizeToInt = forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
word8ToInt8 :: Word8 -> Int8
word8ToInt8 :: Word8 -> Int8
word8ToInt8 = forall a b. (Integral a, Num b) => a -> b
P.fromIntegral