{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE TypeFamilies #-}
#endif
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
, foldr1
, concat
, concatMap
, any
, all
, maximum
, minimum
, 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
, group
, groupBy
, inits
, tails
, splitOn
, split
, chunksOf
, lines
, words
, unlines
, unwords
, isPrefixOf
, isSuffixOf
, isInfixOf
, stripPrefix
, stripSuffix
, commonPrefixes
, filter
, breakOnAll
, find
, partition
, index
, findIndex
, count
, zip
, zipWith
, copy
, unpackCString#
) where
import Prelude (Char, Bool(..), Int, Maybe(..), String,
Eq(..), Ord(..), Ordering(..), (++),
Read(..),
(&&), (||), (+), (-), (.), ($), ($!), (>>),
not, return, otherwise, quot)
import Control.DeepSeq (NFData(rnf))
#if defined(ASSERTS)
import Control.Exception (assert)
#endif
import Data.Char (isSpace)
import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
import Control.Monad (foldM)
import Control.Monad.ST (ST)
import qualified Data.Text.Array as A
import qualified Data.List as L
import Data.Binary (Binary(get, put))
import Data.Monoid (Monoid(..))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.String (IsString(..))
import qualified Data.Text.Internal.Fusion as S
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)
import Data.Text.Show (singleton, unpack, unpackCString#)
import qualified Prelude as P
import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
reverseIter_, unsafeHead, unsafeTail)
import Data.Text.Internal.Unsafe.Char (unsafeChr)
import qualified Data.Text.Internal.Functions as F
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import Data.Text.Internal.Search (indices)
#if defined(__HADDOCK__)
import Data.ByteString (ByteString)
import qualified Data.Text.Lazy as L
import Data.Int (Int64)
#endif
import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as Exts
#endif
#if MIN_VERSION_base(4,7,0)
import Text.Printf (PrintfArg, formatArg, formatString)
#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]
#if MIN_VERSION_base(4,9,0)
instance Semigroup Text where
<> :: Text -> Text -> Text
(<>) = Text -> Text -> Text
append
#endif
instance Monoid Text where
mempty :: Text
mempty = Text
empty
#if MIN_VERSION_base(4,9,0)
mappend :: Text -> Text -> Text
mappend = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
#else
mappend = append
#endif
mconcat :: [Text] -> Text
mconcat = [Text] -> Text
concat
instance IsString Text where
fromString :: String -> Text
fromString = String -> Text
pack
#if __GLASGOW_HASKELL__ >= 708
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
#endif
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 (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 (m :: * -> *) a. Monad m => a -> m a
P.return Text
a
instance Data Text where
gfoldl :: (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 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
#if MIN_VERSION_base(4,7,0)
instance PrintfArg Text where
formatArg :: Text -> FieldFormatter
formatArg Text
txt = String -> FieldFormatter
forall a. IsChar a => [a] -> FieldFormatter
formatString (String -> FieldFormatter) -> String -> FieldFormatter
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
txt
#endif
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 ta :: Text
ta@(Text Array
_arrA Int
_offA Int
lenA) tb :: Text
tb@(Text Array
_arrB Int
_offB Int
lenB)
| Int
lenA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
lenB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Ordering
EQ
| Bool
otherwise = Int -> Int -> Ordering
go Int
0 Int
0
where
go :: Int -> Int -> Ordering
go !Int
i !Int
j
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lenA Bool -> Bool -> Bool
|| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lenB = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lenA Int
lenB
| Char
a Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
b = Ordering
LT
| Char
a Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
b = Ordering
GT
| Bool
otherwise = Int -> Int -> Ordering
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
di) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dj)
where Iter Char
a Int
di = Text -> Int -> Iter
iter Text
ta Int
i
Iter Char
b Int
dj = Text -> Int -> Iter
iter Text
tb Int
j
pack :: String -> Text
pack :: String -> Text
pack = Stream Char -> Text
unstream (Stream Char -> Text) -> (String -> Stream Char) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Stream Char -> Stream Char
S.map Char -> Char
safe (Stream Char -> Stream Char)
-> (String -> Stream Char) -> String -> Stream Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Stream Char
forall a. [a] -> Stream a
S.streamList
{-# INLINE [1] pack #-}
cons :: Char -> Text -> Text
cons :: Char -> Text -> Text
cons Char
c Text
t = Stream Char -> Text
unstream (Char -> Stream Char -> Stream Char
S.cons (Char -> Char
safe Char
c) (Text -> Stream Char
stream Text
t))
{-# INLINE 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 #-}
append :: Text -> Text -> Text
append :: Text -> Text -> Text
append a :: Text
a@(Text Array
arr1 Int
off1 Int
len1) b :: Text
b@(Text Array
arr2 Int
off2 Int
len2)
| Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
b
| Int
len2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
a
| 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 forall s. ST s (MArray s)
x) Int
0 Int
len
| Bool
otherwise = String -> Text
forall a. String -> a
overflowError String
"append"
where
len :: Int
len = Int
len1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len2
x :: ST s (A.MArray s)
x :: ST s (MArray s)
x = do
MArray s
arr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
arr Int
0 Array
arr1 Int
off1 Int
len1
MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
arr Int
len1 Array
arr2 Int
off2 Int
len
MArray s -> ST s (MArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
arr
{-# NOINLINE append #-}
{-# RULES
"TEXT append -> fused" [~1] forall t1 t2.
append t1 t2 = unstream (S.append (stream t1) (stream t2))
"TEXT append -> unfused" [1] forall t1 t2.
unstream (S.append (stream t1) (stream t2)) = append t1 t2
#-}
head :: Text -> Char
head :: Text -> Char
head Text
t = 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 #-}
second :: (b -> c) -> (a,b) -> (a,c)
second :: (b -> c) -> (a, b) -> (a, c)
second b -> c
f (a
a, b
b) = (a
a, b -> c
f b
b)
last :: Text -> Char
last :: Text -> Char
last (Text Array
arr Int
off Int
len)
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Char
forall a. String -> a
emptyError String
"last"
| Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
0xDC00 Bool -> Bool -> Bool
|| Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0xDFFF = Word16 -> Char
unsafeChr Word16
n
| Bool
otherwise = Word16 -> Word16 -> Char
U16.chr2 Word16
n0 Word16
n
where n :: Word16
n = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
n0 :: Word16
n0 = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
{-# INLINE [1] last #-}
{-# RULES
"TEXT last -> fused" [~1] forall t.
last t = S.last (stream t)
"TEXT last -> unfused" [1] forall t.
S.last (stream t) = last t
#-}
tail :: Text -> Text
tail :: 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. 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 #-}
{-# RULES
"TEXT tail -> fused" [~1] forall t.
tail t = unstream (S.tail (stream t))
"TEXT tail -> unfused" [1] forall t.
unstream (S.tail (stream t)) = tail t
#-}
init :: Text -> Text
init :: Text -> Text
init (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. String -> a
emptyError String
"init"
| Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0xDC00 Bool -> Bool -> Bool
&& Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDFFF = Array -> Int -> Int -> Text
text Array
arr Int
off (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
| Bool
otherwise = Array -> Int -> Int -> Text
text Array
arr Int
off (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
where
n :: Word16
n = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE [1] init #-}
{-# RULES
"TEXT init -> fused" [~1] forall t.
init t = unstream (S.init (stream t))
"TEXT init -> unfused" [1] forall t.
unstream (S.init (stream t)) = init t
#-}
unsnoc :: Text -> Maybe (Text, Char)
unsnoc :: Text -> Maybe (Text, Char)
unsnoc (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
| Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
0xDC00 Bool -> Bool -> Bool
|| Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0xDFFF = (Text, Char) -> Maybe (Text, Char)
forall a. a -> Maybe a
Just (Array -> Int -> Int -> Text
text Array
arr Int
off (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Word16 -> Char
unsafeChr Word16
n)
| Bool
otherwise = (Text, Char) -> Maybe (Text, Char)
forall a. a -> Maybe a
Just (Array -> Int -> Int -> Text
text Array
arr Int
off (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2), Word16 -> Word16 -> Char
U16.chr2 Word16
n0 Word16
n)
where n :: Word16
n = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
n0 :: Word16
n0 = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
{-# 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 #-}
{-# RULES
"TEXT null -> fused" [~1] forall t.
null t = S.null (stream t)
"TEXT null -> unfused" [1] forall t.
S.null (stream t) = null t
#-}
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 :: Text -> Int
length :: Text -> Int
length Text
t = Stream Char -> Int
S.length (Text -> Stream Char
stream Text
t)
{-# INLINE [0] length #-}
compareLength :: Text -> Int -> Ordering
compareLength :: Text -> Int -> Ordering
compareLength Text
t Int
n = Stream Char -> Int -> Ordering
forall a. Integral a => Stream Char -> a -> Ordering
S.compareLengthI (Text -> Stream Char
stream Text
t) Int
n
{-# 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
t = Stream Char -> Text
unstream ((Char -> Char) -> Stream Char -> Stream Char
S.map (Char -> Char
safe (Char -> Char) -> (Char -> Char) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f) (Text -> Stream Char
stream Text
t))
{-# INLINE [1] map #-}
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]
F.intersperse Text
t)
{-# INLINE intercalate #-}
intersperse :: Char -> Text -> Text
intersperse :: Char -> Text -> Text
intersperse Char
c Text
t = Stream Char -> Text
unstream (Char -> Stream Char -> Stream Char
S.intersperse (Char -> Char
safe Char
c) (Text -> Stream Char
stream Text
t))
{-# INLINE intersperse #-}
reverse :: Text -> Text
reverse :: Text -> Text
reverse Text
t = Stream Char -> Text
S.reverse (Text -> Stream Char
stream Text
t)
{-# INLINE reverse #-}
replace :: Text
-> Text
-> Text
-> Text
replace :: 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. String -> a
emptyError String
"replace"
| [Int] -> 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 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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [Int]
ixs
x :: ST s (A.MArray s)
x :: 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
MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
d Array
hayArr (Int
hayOffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o) Int
d0
MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
d0 Array
repArr Int
repOff Int
d1
[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 = MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
d Array
hayArr (Int
hayOffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o) Int
len
[Int] -> Int -> Int -> ST s ()
loop [Int]
ixs Int
0 Int
0
MArray s -> ST s (MArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr
toCaseFold :: Text -> Text
toCaseFold :: Text -> Text
toCaseFold Text
t = Stream Char -> Text
unstream (Stream Char -> Stream Char
S.toCaseFold (Text -> Stream Char
stream Text
t))
{-# INLINE toCaseFold #-}
toLower :: Text -> Text
toLower :: Text -> Text
toLower Text
t = Stream Char -> Text
unstream (Stream Char -> Stream Char
S.toLower (Text -> Stream Char
stream Text
t))
{-# INLINE toLower #-}
toUpper :: Text -> Text
toUpper :: Text -> Text
toUpper Text
t = Stream Char -> Text
unstream (Stream Char -> Stream Char
S.toUpper (Text -> Stream Char
stream Text
t))
{-# 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 #-}
{-# RULES
"TEXT justifyLeft -> fused" [~1] forall k c t.
justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))
"TEXT justifyLeft -> unfused" [1] forall k c t.
unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t
#-}
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 :: (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' :: (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 :: (Char -> Char -> Char) -> Text -> Char
foldl1 :: (Char -> Char -> Char) -> Text -> Char
foldl1 Char -> Char -> Char
f Text
t = (Char -> Char -> Char) -> Stream Char -> Char
S.foldl1 Char -> Char -> Char
f (Text -> Stream Char
stream Text
t)
{-# INLINE foldl1 #-}
foldl1' :: (Char -> Char -> Char) -> Text -> Char
foldl1' :: (Char -> Char -> Char) -> Text -> Char
foldl1' Char -> Char -> Char
f Text
t = (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 :: (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 :: (Char -> Char -> Char) -> Text -> Char
foldr1 :: (Char -> Char -> Char) -> Text -> Char
foldr1 Char -> Char -> Char
f Text
t = (Char -> Char -> Char) -> Stream Char -> Char
S.foldr1 Char -> Char -> Char
f (Text -> Stream Char
stream Text
t)
{-# INLINE foldr1 #-}
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' = (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
lengthWord16 [Text]
ts'
go :: ST s (A.MArray s)
go :: 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) =
let !j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l in MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
arr Int
i Array
a Int
o Int
j ST s () -> ST s Int -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
j
(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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MArray s -> ST s (MArray s)
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 :: Text -> Char
maximum :: Text -> Char
maximum Text
t = Stream Char -> Char
S.maximum (Text -> Stream Char
stream Text
t)
{-# INLINE maximum #-}
minimum :: Text -> Char
minimum :: Text -> Char
minimum Text
t = Stream Char -> Char
S.minimum (Text -> Stream Char
stream Text
t)
{-# INLINE minimum #-}
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 (Text -> Char
last Text
t) (Text -> Text
init Text
t)
{-# INLINE scanr1 #-}
mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
mapAccumL :: (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
mapAccumL a -> Char -> (a, Char)
f a
z0 = (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
S.mapAccumL a -> Char -> (a, Char)
g a
z0 (Stream Char -> (a, Text))
-> (Text -> Stream Char) -> Text -> (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream
where g :: a -> Char -> (a, Char)
g a
a Char
b = (Char -> Char) -> (a, Char) -> (a, Char)
forall b c a. (b -> c) -> (a, b) -> (a, c)
second Char -> Char
safe (a -> Char -> (a, Char)
f a
a Char
b)
{-# INLINE mapAccumL #-}
mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
mapAccumR :: (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
mapAccumR a -> Char -> (a, Char)
f a
z0 = (Text -> Text) -> (a, Text) -> (a, Text)
forall b c a. (b -> c) -> (a, b) -> (a, c)
second Text -> Text
reverse ((a, Text) -> (a, Text))
-> (Text -> (a, Text)) -> Text -> (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
S.mapAccumL a -> Char -> (a, Char)
g a
z0 (Stream Char -> (a, Text))
-> (Text -> Stream Char) -> Text -> (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
reverseStream
where g :: a -> Char -> (a, Char)
g a
a Char
b = (Char -> Char) -> (a, Char) -> (a, Char)
forall b c a. (b -> c) -> (a, b) -> (a, c)
second Char -> Char
safe (a -> Char -> (a, Char)
f a
a Char
b)
{-# 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 = 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
where
len :: Int
len = Int
l Int -> Int -> Int
`mul` Int
n
x :: ST s (A.MArray s)
x :: ST s (MArray s)
x = do
MArray s
arr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
let loop :: Int -> Int -> ST s (MArray s)
loop !Int
d !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = MArray s -> ST s (MArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
arr
| Bool
otherwise = let m :: Int
m = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
in MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
arr Int
d Array
a Int
o Int
m ST s () -> ST s (MArray s) -> ST s (MArray s)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> ST s (MArray s)
loop Int
m (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Int -> Int -> ST s (MArray s)
loop Int
0 Int
0
{-# 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
n Char
c = Stream Char -> Text
unstream (Int -> Char -> Stream Char
forall a. Integral a => a -> Char -> Stream Char
S.replicateCharI Int
n (Char -> Char
safe Char
c))
{-# INLINE replicateChar #-}
unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
unfoldr :: (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 :: 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 = Array -> Int -> Int -> Text
text Array
arr Int
off (Int -> Text -> Int
iterN Int
n Text
t)
{-# INLINE [1] take #-}
iterN :: Int -> Text -> Int
iterN :: Int -> Text -> Int
iterN Int
n t :: Text
t@(Text Array
_arr Int
_off Int
len) = Int -> Int -> Int
loop Int
0 Int
0
where loop :: Int -> Int -> Int
loop !Int
i !Int
cnt
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len Bool -> Bool -> Bool
|| Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Int
i
| Bool
otherwise = Int -> Int -> Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
where d :: Int
d = Text -> Int -> Int
iter_ Text
t Int
i
{-# RULES
"TEXT take -> fused" [~1] forall n t.
take n t = unstream (S.take n (stream t))
"TEXT take -> unfused" [1] forall n t.
unstream (S.take n (stream t)) = take n t
#-}
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 = 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
iterN Int
n Text
t
{-# INLINE [1] drop #-}
{-# RULES
"TEXT drop -> fused" [~1] forall n t.
drop n t = unstream (S.drop n (stream t))
"TEXT drop -> unfused" [1] forall n t.
unstream (S.drop n (stream t)) = drop n t
#-}
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 #-}
{-# RULES
"TEXT takeWhile -> fused" [~1] forall p t.
takeWhile p t = unstream (S.takeWhile p (stream t))
"TEXT takeWhile -> unfused" [1] forall p t.
unstream (S.takeWhile p (stream t)) = takeWhile p t
#-}
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 (Char
c,Int
d) = Text -> Int -> (Char, Int)
reverseIter Text
t Int
i
{-# INLINE [1] takeWhileEnd #-}
{-# RULES
"TEXT takeWhileEnd -> fused" [~1] forall p t.
takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
"TEXT takeWhileEnd -> unfused" [1] forall p t.
S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
#-}
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
p t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> Int -> Text
loop Int
0 Int
0
where loop :: Int -> Int -> Text
loop !Int
i !Int
l | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Text
empty
| Char -> Bool
p Char
c = Int -> Int -> Text
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)
where Iter Char
c Int
d = Text -> Int -> Iter
iter Text
t Int
i
{-# INLINE [1] dropWhile #-}
{-# RULES
"TEXT dropWhile -> fused" [~1] forall p t.
dropWhile p t = unstream (S.dropWhile p (stream t))
"TEXT dropWhile -> unfused" [1] forall p t.
unstream (S.dropWhile p (stream t)) = dropWhile p t
#-}
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 (Char
c,Int
d) = Text -> Int -> (Char, Int)
reverseIter Text
t Int
i
{-# INLINE [1] dropWhileEnd #-}
{-# RULES
"TEXT dropWhileEnd -> fused" [~1] forall p t.
dropWhileEnd p t = S.reverse (S.dropWhile p (S.reverseStream t))
"TEXT dropWhileEnd -> unfused" [1] forall p t.
S.reverse (S.dropWhile p (S.reverseStream t)) = dropWhileEnd p t
#-}
dropAround :: (Char -> Bool) -> Text -> Text
dropAround :: (Char -> Bool) -> Text -> Text
dropAround Char -> Bool
p = (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
p (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
p
{-# INLINE [1] dropAround #-}
stripStart :: Text -> Text
stripStart :: Text -> Text
stripStart = (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
isSpace
{-# INLINE [1] stripStart #-}
stripEnd :: Text -> Text
stripEnd :: Text -> Text
stripEnd = (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
isSpace
{-# INLINE [1] stripEnd #-}
strip :: Text -> Text
strip :: Text -> Text
strip = (Char -> Bool) -> Text -> Text
dropAround Char -> Bool
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 k :: Int
k = Int -> Text -> Int
iterN Int
n Text
t
in (Array -> Int -> Int -> Text
text Array
arr Int
off Int
k, Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k))
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 #-}
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 :: Text
-> Text
-> [Text]
splitOn :: 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. 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 #-}
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
t = Stream Char -> Text
unstream ((Char -> Bool) -> Stream Char -> Stream Char
S.filter Char -> Bool
p (Text -> Stream Char
stream Text
t))
{-# INLINE filter #-}
breakOn :: Text -> Text -> (Text, Text)
breakOn :: 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. 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 :: Text -> Text -> (Text, Text)
breakOnEnd :: Text -> Text -> (Text, Text)
breakOnEnd Text
pat Text
src = (Text -> Text
reverse Text
b, Text -> Text
reverse Text
a)
where (Text
a,Text
b) = Text -> Text -> (Text, Text)
breakOn (Text -> Text
reverse Text
pat) (Text -> Text
reverse Text
src)
{-# INLINE breakOnEnd #-}
breakOnAll :: Text
-> Text
-> [(Text, Text)]
breakOnAll :: 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. 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 :: Text -> Int -> Char
index :: Text -> Int -> Char
index Text
t Int
n = 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 :: Text -> Text -> Int
count :: Text -> Text -> Int
count Text
pat Text
src
| Text -> Bool
null Text
pat = String -> Int
forall a. String -> a
emptyError String
"count"
| Text -> Bool
isSingleton Text
pat = Char -> Text -> Int
countChar (Text -> Char
unsafeHead Text
pat) Text
src
| Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (Text -> Text -> [Int]
indices Text
pat Text
src)
{-# 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 zipWith #-}
words :: Text -> [Text]
words :: Text -> [Text]
words 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
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
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start)]
| Char -> Bool
isSpace Char
c =
if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
then Int -> Int -> [Text]
loop (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else Array -> Int -> Int -> Text
Text Array
arr (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> [Text]
loop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
| Bool
otherwise = Int -> Int -> [Text]
loop Int
start (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
where Iter Char
c Int
d = Text -> Int -> Iter
iter Text
t Int
n
{-# INLINE words #-}
lines :: Text -> [Text]
lines :: Text -> [Text]
lines Text
ps | Text -> Bool
null Text
ps = []
| Bool
otherwise = Text
h Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: if Text -> Bool
null Text
t
then []
else Text -> [Text]
lines (Text -> Text
unsafeTail Text
t)
where (# Text
h,Text
t #) = (Char -> Bool) -> Text -> (# Text, Text #)
span_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
ps
{-# INLINE lines #-}
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]
forall a b. (a -> b) -> [a] -> [b]
L.map (Text -> Char -> Text
`snoc` Char
'\n')
{-# 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 #-}
{-# RULES
"TEXT isPrefixOf -> fused" [~1] forall s t.
isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
#-}
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 :: 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 (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 #-}
{-# RULES
"TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.
isInfixOf (singleton n) h = S.elem n (S.stream h)
#-}
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 -> 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. Ord a => a -> a -> Bool
< Int
len0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len1 Bool -> Bool -> Bool
&& Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b = Int -> Int -> Maybe (Text, Text, Text)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d0) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d1)
| Int
i 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
i,
Array -> Int -> Int -> Text
text Array
arr0 (Int
off0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
len0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i),
Array -> Int -> Int -> Text
text Array
arr1 (Int
off1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) (Int
len1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j))
| Bool
otherwise = Maybe (Text, Text, Text)
forall a. Maybe a
Nothing
where Iter Char
a Int
d0 = Text -> Int -> Iter
iter Text
t0 Int
i
Iter Char
b Int
d1 = Text -> Int -> Iter
iter Text
t1 Int
j
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. 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 :: String -> a
emptyError :: 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 :: String -> a
overflowError :: 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 forall s. ST s (MArray s)
go) Int
0 Int
len
where
go :: ST s (A.MArray s)
go :: 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
MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
0 Array
arr Int
off Int
len
MArray s -> ST s (MArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr