{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns, MagicHash, CPP, TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE LambdaCase #-}
module Data.Text.Lazy
(
Text
, pack
, unpack
, singleton
, empty
, fromChunks
, toChunks
, toStrict
, fromStrict
, foldrChunks
, foldlChunks
, 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
, isAscii
, scanl
, scanl1
, scanr
, scanr1
, mapAccumL
, mapAccumR
, repeat
, replicate
, cycle
, iterate
, unfoldr
, unfoldrN
, take
, takeEnd
, drop
, dropEnd
, takeWhile
, takeWhileEnd
, dropWhile
, dropWhileEnd
, dropAround
, strip
, stripStart
, stripEnd
, splitAt
, span
, spanM
, spanEndM
, breakOn
, breakOnEnd
, break
, group
, groupBy
, inits
, tails
, splitOn
, split
, chunksOf
, lines
, words
, unlines
, unwords
, isPrefixOf
, isSuffixOf
, isInfixOf
, stripPrefix
, stripSuffix
, commonPrefixes
, filter
, find
, elem
, breakOnAll
, partition
, index
, count
, zip
, zipWith
) where
import Prelude (Char, Bool(..), Maybe(..), String,
Eq, (==), Ord(..), Ordering(..), Read(..), Show(..),
Monad(..), pure, (<$>),
(&&), (+), (-), (.), ($), (++),
error, flip, fmap, fromIntegral, not, otherwise, quot)
import qualified Prelude as P
import Control.Arrow (first)
import Control.DeepSeq (NFData(..))
import Data.Bits (finiteBitSize)
import Data.Int (Int64)
import qualified Data.List as L hiding (head, tail)
import Data.Char (isSpace)
import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
import Data.Binary (Binary(get, put))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import qualified Data.Text as T
import qualified Data.Text.Array as A
import qualified Data.Text.Internal as T
import qualified Data.Text.Internal.Fusion.Common as S
import qualified Data.Text.Unsafe as T
import qualified Data.Text.Internal.Lazy.Fusion as S
import Data.Text.Internal.Fusion.Types (PairS(..))
import Data.Text.Internal.Lazy.Fusion (stream, unstream)
import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
foldrChunks, smallChunkSize, defaultChunkSize, equal)
import Data.Text.Internal (firstf, safe, text)
import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
import Data.Text.Internal.Lazy.Search (indices)
import qualified GHC.CString as GHC
import qualified GHC.Exts as Exts
import GHC.Prim (Addr#)
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)
instance Eq Text where
== :: Text -> Text -> Bool
(==) = Text -> Text -> Bool
equal
{-# INLINE (==) #-}
instance Ord Text where
compare :: Text -> Text -> Ordering
compare = Text -> Text -> Ordering
compareText
compareText :: Text -> Text -> Ordering
compareText :: Text -> Text -> Ordering
compareText Text
Empty Text
Empty = Ordering
EQ
compareText Text
Empty Text
_ = Ordering
LT
compareText Text
_ Text
Empty = Ordering
GT
compareText (Chunk (T.Text Array
arrA Int
offA Int
lenA) Text
as) (Chunk (T.Text Array
arrB Int
offB Int
lenB) Text
bs) =
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
<> case Int
lenA forall a. Ord a => a -> a -> Ordering
`compare` Int
lenB of
Ordering
LT -> Text -> Text -> Ordering
compareText Text
as (Text -> Text -> Text
Chunk (Array -> Int -> Int -> Text
T.Text Array
arrB (Int
offB forall a. Num a => a -> a -> a
+ Int
lenA) (Int
lenB forall a. Num a => a -> a -> a
- Int
lenA)) Text
bs)
Ordering
EQ -> Text -> Text -> Ordering
compareText Text
as Text
bs
Ordering
GT -> Text -> Text -> Ordering
compareText (Text -> Text -> Text
Chunk (Array -> Int -> Int -> Text
T.Text Array
arrA (Int
offA forall a. Num a => a -> a -> a
+ Int
lenB) (Int
lenA forall a. Num a => a -> a -> a
- Int
lenB)) Text
as) Text
bs
instance Show Text where
showsPrec :: Int -> Text -> ShowS
showsPrec Int
p Text
ps String
r = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Text -> String
unpack Text
ps) String
r
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
Empty = ()
rnf (Chunk Text
_ Text
ts) = forall a. NFData a => a -> ()
rnf Text
ts
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
error String
"Data.Text.Lazy.Text.gunfold"
dataTypeOf :: Text -> DataType
dataTypeOf Text
_ = DataType
textDataType
instance TH.Lift Text where
lift :: forall (m :: * -> *). Quote m => Text -> m Exp
lift = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE 'fromStrict) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
#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
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.Lazy.Text" [Constr
packConstr]
pack ::
#if defined(ASSERTS)
HasCallStack =>
#endif
String -> Text
pack :: String -> Text
pack = Stream Char -> Text
unstream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Stream a
S.streamList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
L.map Char -> Char
safe
{-# INLINE [1] pack #-}
unpack ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Text -> String
unpack :: Text -> String
unpack Text
t = forall a. Stream a -> [a]
S.unstreamList (Text -> Stream Char
stream Text
t)
{-# INLINE [1] unpack #-}
unpackCString# :: Addr# -> Text
unpackCString# :: Addr# -> Text
unpackCString# Addr#
addr# = Stream Char -> Text
unstream (Addr# -> Stream Char
S.streamCString# Addr#
addr#)
{-# NOINLINE unpackCString# #-}
{-# RULES "TEXT literal" forall a.
unstream (S.streamList (L.map safe (GHC.unpackCString# a)))
= unpackCString# a #-}
{-# RULES "TEXT literal UTF8" forall a.
unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
= unpackCString# a #-}
{-# RULES "LAZY TEXT empty literal"
unstream (S.streamList (L.map safe []))
= Empty #-}
{-# RULES "LAZY TEXT empty literal" forall a.
unstream (S.streamList (L.map safe [a]))
= Chunk (T.singleton a) Empty #-}
singleton :: Char -> Text
singleton :: Char -> Text
singleton Char
c = Text -> Text -> Text
Chunk (Char -> Text
T.singleton Char
c) Text
Empty
{-# INLINE [1] singleton #-}
fromChunks :: [T.Text] -> Text
fromChunks :: [Text] -> Text
fromChunks [Text]
cs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr Text -> Text -> Text
chunk Text
Empty [Text]
cs
toChunks :: Text -> [T.Text]
toChunks :: Text -> [Text]
toChunks Text
cs = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (:) [] Text
cs
toStrict :: Text -> T.Text
toStrict :: Text -> Text
toStrict Text
t = [Text] -> Text
T.concat (Text -> [Text]
toChunks Text
t)
{-# INLINE [1] toStrict #-}
fromStrict :: T.Text -> Text
fromStrict :: Text -> Text
fromStrict Text
t = Text -> Text -> Text
chunk Text
t Text
Empty
{-# INLINE [1] fromStrict #-}
cons :: Char -> Text -> Text
cons :: Char -> Text -> Text
cons Char
c Text
t = Text -> Text -> Text
Chunk (Char -> Text
T.singleton Char
c) Text
t
{-# INLINE [1] cons #-}
infixr 5 `cons`
snoc :: Text -> Char -> Text
snoc :: Text -> Char -> Text
snoc Text
t Char
c = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks Text -> Text -> Text
Chunk (Char -> Text
singleton Char
c) Text
t
{-# INLINE [1] snoc #-}
append :: Text -> Text -> Text
append :: Text -> Text -> Text
append Text
xs Text
ys = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks Text -> Text -> Text
Chunk Text
ys Text
xs
{-# INLINE [1] append #-}
uncons :: Text -> Maybe (Char, Text)
uncons :: Text -> Maybe (Char, Text)
uncons Text
Empty = forall a. Maybe a
Nothing
uncons (Chunk Text
t Text
ts) = forall a. a -> Maybe a
Just (Text -> Char
T.unsafeHead Text
t, Text
ts')
where ts' :: Text
ts' | Text -> Int -> Ordering
T.compareLength Text
t Int
1 forall a. Eq a => a -> a -> Bool
== Ordering
EQ = Text
ts
| Bool
otherwise = Text -> Text -> Text
Chunk (Text -> Text
T.unsafeTail Text
t) Text
ts
{-# INLINE uncons #-}
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 #-}
tail :: HasCallStack => Text -> Text
tail :: HasCallStack => Text -> Text
tail (Chunk Text
t Text
ts) = Text -> Text -> Text
chunk (HasCallStack => Text -> Text
T.tail Text
t) Text
ts
tail Text
Empty = forall a. HasCallStack => String -> a
emptyError String
"tail"
{-# INLINE [1] tail #-}
init :: HasCallStack => Text -> Text
init :: HasCallStack => Text -> Text
init (Chunk Text
t0 Text
ts0) = Text -> Text -> Text
go Text
t0 Text
ts0
where go :: Text -> Text -> Text
go Text
t (Chunk Text
t' Text
ts) = Text -> Text -> Text
Chunk Text
t (Text -> Text -> Text
go Text
t' Text
ts)
go Text
t Text
Empty = Text -> Text -> Text
chunk (HasCallStack => Text -> Text
T.init Text
t) Text
Empty
init Text
Empty = forall a. HasCallStack => String -> a
emptyError String
"init"
{-# INLINE [1] init #-}
unsnoc :: Text -> Maybe (Text, Char)
unsnoc :: Text -> Maybe (Text, Char)
unsnoc Text
Empty = forall a. Maybe a
Nothing
unsnoc ts :: Text
ts@(Chunk Text
_ Text
_) = forall a. a -> Maybe a
Just (HasCallStack => Text -> Text
init Text
ts, HasCallStack => Text -> Char
last Text
ts)
{-# INLINE unsnoc #-}
null :: Text -> Bool
null :: Text -> Bool
null Text
Empty = Bool
True
null Text
_ = Bool
False
{-# 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 #-}
last :: HasCallStack => Text -> Char
last :: HasCallStack => Text -> Char
last Text
Empty = forall a. HasCallStack => String -> a
emptyError String
"last"
last (Chunk Text
t Text
ts) = Text -> Text -> Char
go Text
t Text
ts
where go :: Text -> Text -> Char
go Text
_ (Chunk Text
t' Text
ts') = Text -> Text -> Char
go Text
t' Text
ts'
go Text
t' Text
Empty = HasCallStack => Text -> Char
T.last Text
t'
{-# INLINE [1] last #-}
length :: Text -> Int64
length :: Text -> Int64
length = forall a. (a -> Text -> a) -> a -> Text -> a
foldlChunks Int64 -> Text -> Int64
go Int64
0
where
go :: Int64 -> T.Text -> Int64
go :: Int64 -> Text -> Int64
go Int64
l Text
t = Int64
l forall a. Num a => a -> a -> a
+ Int -> Int64
intToInt64 (Text -> Int
T.length Text
t)
{-# INLINE [1] length #-}
{-# RULES
"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) = max 0 n P.* 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 (2 P.* 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 -> Int64 -> Ordering
compareLength :: Text -> Int64 -> Ordering
compareLength Text
t Int64
c = forall a. Integral a => Stream Char -> a -> Ordering
S.compareLengthI (Text -> Stream Char
stream Text
t) Int64
c
{-# INLINE [1] compareLength #-}
map :: (Char -> Char) -> Text -> Text
map :: (Char -> Char) -> Text -> Text
map Char -> Char
f = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (Text -> Text -> Text
Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
f) Text
Empty
{-# 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 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 [1] intersperse #-}
justifyLeft :: Int64 -> Char -> Text -> Text
justifyLeft :: Int64 -> Char -> Text -> Text
justifyLeft Int64
k Char
c Text
t
| Int64
len forall a. Ord a => a -> a -> Bool
>= Int64
k = Text
t
| Bool
otherwise = Text
t Text -> Text -> Text
`append` Int64 -> Text -> Text
replicateChunk (Int64
kforall a. Num a => a -> a -> a
-Int64
len) (Char -> Text
T.singleton Char
c)
where len :: Int64
len = Text -> Int64
length Text
t
{-# INLINE [1] justifyLeft #-}
justifyRight :: Int64 -> Char -> Text -> Text
justifyRight :: Int64 -> Char -> Text -> Text
justifyRight Int64
k Char
c Text
t
| Int64
len forall a. Ord a => a -> a -> Bool
>= Int64
k = Text
t
| Bool
otherwise = Int64 -> Text -> Text
replicateChunk (Int64
kforall a. Num a => a -> a -> a
-Int64
len) (Char -> Text
T.singleton Char
c) Text -> Text -> Text
`append` Text
t
where len :: Int64
len = Text -> Int64
length Text
t
{-# INLINE justifyRight #-}
center :: Int64 -> Char -> Text -> Text
center :: Int64 -> Char -> Text -> Text
center Int64
k Char
c Text
t
| Int64
len forall a. Ord a => a -> a -> Bool
>= Int64
k = Text
t
| Bool
otherwise = Int64 -> Text -> Text
replicateChunk Int64
l (Char -> Text
T.singleton Char
c) Text -> Text -> Text
`append` Text
t Text -> Text -> Text
`append` Int64 -> Text -> Text
replicateChunk Int64
r (Char -> Text
T.singleton Char
c)
where len :: Int64
len = Text -> Int64
length Text
t
d :: Int64
d = Int64
k forall a. Num a => a -> a -> a
- Int64
len
r :: Int64
r = Int64
d forall a. Integral a => a -> a -> a
`quot` Int64
2
l :: Int64
l = Int64
d forall a. Num a => a -> a -> a
- Int64
r
{-# INLINE center #-}
transpose :: [Text] -> [Text]
transpose :: [Text] -> [Text]
transpose [Text]
ts = forall a b. (a -> b) -> [a] -> [b]
L.map (\String
ss -> Text -> Text -> Text
Chunk (String -> Text
T.pack String
ss) Text
Empty)
(forall a. [[a]] -> [[a]]
L.transpose (forall a b. (a -> b) -> [a] -> [b]
L.map Text -> String
unpack [Text]
ts))
reverse ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Text -> Text
reverse :: Text -> Text
reverse = Text -> Text -> Text
rev Text
Empty
where rev :: Text -> Text -> Text
rev Text
a Text
Empty = Text
a
rev Text
a (Chunk Text
t Text
ts) = Text -> Text -> Text
rev (Text -> Text -> Text
Chunk (Text -> Text
T.reverse Text
t) Text
a) Text
ts
replace :: HasCallStack
=> Text
-> Text
-> Text
-> Text
replace :: HasCallStack => Text -> Text -> Text -> Text
replace Text
s Text
d = Text -> [Text] -> Text
intercalate Text
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
splitOn Text
s
{-# INLINE replace #-}
toCaseFold :: Text -> Text
toCaseFold :: Text -> Text
toCaseFold = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (\Text
chnk Text
acc -> Text -> Text -> Text
Chunk (Text -> Text
T.toCaseFold Text
chnk) Text
acc) Text
Empty
{-# INLINE toCaseFold #-}
toLower :: Text -> Text
toLower :: Text -> Text
toLower = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (\Text
chnk Text
acc -> Text -> Text -> Text
Chunk (Text -> Text
T.toLower Text
chnk) Text
acc) Text
Empty
{-# INLINE toLower #-}
toUpper :: Text -> Text
toUpper :: Text -> Text
toUpper = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (\Text
chnk Text
acc -> Text -> Text -> Text
Chunk (Text -> Text
T.toUpper Text
chnk) Text
acc) Text
Empty
{-# INLINE toUpper #-}
toTitle :: Text -> Text
toTitle :: Text -> Text
toTitle = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (\Text
chnk Text
acc -> Text -> Text -> Text
Chunk (Text -> Text
T.toTitle Text
chnk) Text
acc) Text
Empty
{-# INLINE toTitle #-}
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 #-}
concat :: [Text] -> Text
concat :: [Text] -> Text
concat [] = Text
Empty
concat (Text
Empty : [Text]
css) = [Text] -> Text
concat [Text]
css
concat (Chunk Text
c Text
Empty : [Text]
css) = Text -> Text -> Text
Chunk Text
c ([Text] -> Text
concat [Text]
css)
concat (Chunk Text
c Text
cs : [Text]
css) = Text -> Text -> Text
Chunk Text
c ([Text] -> Text
concat (Text
cs forall a. a -> [a] -> [a]
: [Text]
css))
{-# INLINE concat #-}
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 = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (\Text
chnk Bool
acc -> Text -> Bool
T.isAscii Text
chnk Bool -> Bool -> Bool
&& Bool
acc) Bool
True
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
t0 = case Text -> Maybe (Char, Text)
uncons Text
t0 of
Maybe (Char, Text)
Nothing -> Text
empty
Just (Char
t,Text
ts) -> (Char -> Char -> Char) -> Char -> Text -> Text
scanl Char -> Char -> Char
f Char
t Text
ts
{-# INLINE scanl1 #-}
scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
scanr Char -> Char -> Char
f Char
v = Text -> Text
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Char) -> Char -> Text -> Text
scanl Char -> Char -> Char
g Char
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
reverse
where g :: Char -> Char -> Char
g Char
a Char
b = Char -> Char
safe (Char -> Char -> Char
f Char
b Char
a)
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)
mapAccumL :: (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 -> Text -> (a, Text)
go
where
go :: a -> Text -> (a, Text)
go a
z (Chunk Text
c Text
cs) = (a
z'', Text -> Text -> Text
Chunk Text
c' Text
cs')
where (a
z', Text
c') = forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
T.mapAccumL a -> Char -> (a, Char)
f a
z Text
c
(a
z'', Text
cs') = a -> Text -> (a, Text)
go a
z' Text
cs
go a
z Text
Empty = (a
z, Text
Empty)
{-# INLINE mapAccumL #-}
mapAccumR :: (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 -> Text -> (a, Text)
go
where
go :: a -> Text -> (a, Text)
go a
z (Chunk Text
c Text
cs) = (a
z'', Text -> Text -> Text
Chunk Text
c' Text
cs')
where (a
z'', Text
c') = forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
T.mapAccumR a -> Char -> (a, Char)
f a
z' Text
c
(a
z', Text
cs') = a -> Text -> (a, Text)
go a
z Text
cs
go a
z Text
Empty = (a
z, Text
Empty)
{-# INLINE mapAccumR #-}
repeat :: Char -> Text
repeat :: Char -> Text
repeat Char
c = let t :: Text
t = Text -> Text -> Text
Chunk (Int -> Text -> Text
T.replicate Int
smallChunkSize (Char -> Text
T.singleton Char
c)) Text
t
in Text
t
replicate :: Int64 -> Text -> Text
replicate :: Int64 -> Text -> Text
replicate Int64
n
| Int64
n forall a. Ord a => a -> a -> Bool
<= Int64
0 = forall a b. a -> b -> a
P.const Text
Empty
| Bool
otherwise = \case
Text
Empty -> Text
Empty
Chunk Text
t Text
Empty -> Int64 -> Text -> Text
replicateChunk Int64
n Text
t
Text
t -> [Text] -> Text
concat (Int64 -> [Text]
rep Int64
n)
where
rep :: Int64 -> [Text]
rep Int64
0 = []
rep Int64
i = Text
t forall a. a -> [a] -> [a]
: Int64 -> [Text]
rep (Int64
i forall a. Num a => a -> a -> a
- Int64
1)
{-# INLINE [1] replicate #-}
replicateChunk :: Int64 -> T.Text -> Text
replicateChunk :: Int64 -> Text -> Text
replicateChunk !Int64
n !t :: Text
t@(T.Text Array
_ Int
_ Int
len)
| Int64
n forall a. Ord a => a -> a -> Bool
<= Int64
0 = Text
Empty
| Bool
otherwise = Text -> Text -> Text
Chunk Text
headChunk forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
P.foldr Text -> Text -> Text
Chunk Text
Empty (forall i a. Integral i => i -> a -> [a]
L.genericReplicate Int64
q Text
normalChunk)
where
perChunk :: Int
perChunk = Int
defaultChunkSize forall a. Integral a => a -> a -> a
`quot` Int
len
normalChunk :: Text
normalChunk = Int -> Text -> Text
T.replicate Int
perChunk Text
t
(Int64
q, Int64
r) = Int64
n forall a. Integral a => a -> a -> (a, a)
`P.quotRem` Int -> Int64
intToInt64 Int
perChunk
headChunk :: Text
headChunk = Int -> Text -> Text
T.replicate (Int64 -> Int
int64ToInt Int64
r) Text
t
{-# INLINE replicateChunk #-}
cycle :: HasCallStack => Text -> Text
cycle :: HasCallStack => Text -> Text
cycle Text
Empty = forall a. HasCallStack => String -> a
emptyError String
"cycle"
cycle Text
t = let t' :: Text
t' = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks Text -> Text -> Text
Chunk Text
t' Text
t
in Text
t'
iterate :: (Char -> Char) -> Char -> Text
iterate :: (Char -> Char) -> Char -> Text
iterate Char -> Char
f Char
c = let t :: Char -> Text
t Char
c' = Text -> Text -> Text
Chunk (Char -> Text
T.singleton Char
c') (Char -> Text
t (Char -> Char
f Char
c'))
in Char -> Text
t Char
c
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 :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text
unfoldrN :: forall a. Int64 -> (a -> Maybe (Char, a)) -> a -> Text
unfoldrN Int64
n a -> Maybe (Char, a)
f a
s = Stream Char -> Text
unstream (forall a. Int64 -> (a -> Maybe (Char, a)) -> a -> Stream Char
S.unfoldrN Int64
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 :: Int64 -> Text -> Text
take :: Int64 -> Text -> Text
take Int64
i Text
_ | Int64
i forall a. Ord a => a -> a -> Bool
<= Int64
0 = Text
Empty
take Int64
i Text
t0 = Int64 -> Text -> Text
take' Int64
i Text
t0
where
take' :: Int64 -> Text -> Text
take' :: Int64 -> Text -> Text
take' Int64
0 Text
_ = Text
Empty
take' Int64
_ Text
Empty = Text
Empty
take' Int64
n (Chunk t :: Text
t@(T.Text Array
arr Int
off Int
_) Text
ts)
| forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: P.Int) forall a. Eq a => a -> a -> Bool
== Int
64, Int
m <- Int -> Text -> Int
T.measureOff (Int64 -> Int
int64ToInt Int64
n) Text
t =
if Int
m forall a. Ord a => a -> a -> Bool
>= Int
0
then Text -> Text
fromStrict (Array -> Int -> Int -> Text
T.Text Array
arr Int
off Int
m)
else Text -> Text -> Text
Chunk Text
t (Int64 -> Text -> Text
take' (Int64
n forall a. Num a => a -> a -> a
+ Int -> Int64
intToInt64 Int
m) Text
ts)
| Int64
n forall a. Ord a => a -> a -> Bool
< Int64
l = Text -> Text -> Text
Chunk (Int -> Text -> Text
T.take (Int64 -> Int
int64ToInt Int64
n) Text
t) Text
Empty
| Bool
otherwise = Text -> Text -> Text
Chunk Text
t (Int64 -> Text -> Text
take' (Int64
n forall a. Num a => a -> a -> a
- Int64
l) Text
ts)
where l :: Int64
l = Int -> Int64
intToInt64 (Text -> Int
T.length Text
t)
{-# INLINE [1] take #-}
takeEnd :: Int64 -> Text -> Text
takeEnd :: Int64 -> Text -> Text
takeEnd Int64
n Text
t0
| Int64
n forall a. Ord a => a -> a -> Bool
<= Int64
0 = Text
empty
| Bool
otherwise = Int64 -> Text -> [Text] -> Text
takeChunk Int64
n Text
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
toChunks forall a b. (a -> b) -> a -> b
$ Text
t0
where
takeChunk :: Int64 -> Text -> [T.Text] -> Text
takeChunk :: Int64 -> Text -> [Text] -> Text
takeChunk Int64
_ Text
acc [] = Text
acc
takeChunk Int64
i Text
acc (Text
t:[Text]
ts)
| Int64
i forall a. Ord a => a -> a -> Bool
<= Int64
l = Text -> Text -> Text
chunk (Int -> Text -> Text
T.takeEnd (Int64 -> Int
int64ToInt Int64
i) Text
t) Text
acc
| Bool
otherwise = Int64 -> Text -> [Text] -> Text
takeChunk (Int64
iforall a. Num a => a -> a -> a
-Int64
l) (Text -> Text -> Text
Chunk Text
t Text
acc) [Text]
ts
where l :: Int64
l = Int -> Int64
intToInt64 (Text -> Int
T.length Text
t)
drop :: Int64 -> Text -> Text
drop :: Int64 -> Text -> Text
drop Int64
i Text
t0
| Int64
i forall a. Ord a => a -> a -> Bool
<= Int64
0 = Text
t0
| Bool
otherwise = Int64 -> Text -> Text
drop' Int64
i Text
t0
where
drop' :: Int64 -> Text -> Text
drop' :: Int64 -> Text -> Text
drop' Int64
0 Text
ts = Text
ts
drop' Int64
_ Text
Empty = Text
Empty
drop' Int64
n (Chunk t :: Text
t@(T.Text Array
arr Int
off Int
len) Text
ts)
| forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: P.Int) forall a. Eq a => a -> a -> Bool
== Int
64, Int
m <- Int -> Text -> Int
T.measureOff (Int64 -> Int
int64ToInt Int64
n) Text
t =
if Int
m forall a. Ord a => a -> a -> Bool
>= Int
0
then Text -> Text -> Text
chunk (Array -> Int -> Int -> Text
T.Text Array
arr (Int
off forall a. Num a => a -> a -> a
+ Int
m) (Int
len forall a. Num a => a -> a -> a
- Int
m)) Text
ts
else Int64 -> Text -> Text
drop' (Int64
n forall a. Num a => a -> a -> a
+ Int -> Int64
intToInt64 Int
m) Text
ts
| Int64
n forall a. Ord a => a -> a -> Bool
< Int64
l = Text -> Text -> Text
Chunk (Int -> Text -> Text
T.drop (Int64 -> Int
int64ToInt Int64
n) Text
t) Text
ts
| Bool
otherwise = Int64 -> Text -> Text
drop' (Int64
n forall a. Num a => a -> a -> a
- Int64
l) Text
ts
where l :: Int64
l = Int -> Int64
intToInt64 (Text -> Int
T.length Text
t)
{-# INLINE [1] drop #-}
dropEnd :: Int64 -> Text -> Text
dropEnd :: Int64 -> Text -> Text
dropEnd Int64
n Text
t0
| Int64
n forall a. Ord a => a -> a -> Bool
<= Int64
0 = Text
t0
| Bool
otherwise = Int64 -> [Text] -> Text
dropChunk Int64
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
toChunks forall a b. (a -> b) -> a -> b
$ Text
t0
where
dropChunk :: Int64 -> [T.Text] -> Text
dropChunk :: Int64 -> [Text] -> Text
dropChunk Int64
_ [] = Text
empty
dropChunk Int64
m (Text
t:[Text]
ts)
| Int64
m forall a. Ord a => a -> a -> Bool
>= Int64
l = Int64 -> [Text] -> Text
dropChunk (Int64
mforall a. Num a => a -> a -> a
-Int64
l) [Text]
ts
| Bool
otherwise = [Text] -> Text
fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse forall a b. (a -> b) -> a -> b
$
Int -> Text -> Text
T.dropEnd (Int64 -> Int
int64ToInt Int64
m) Text
t forall a. a -> [a] -> [a]
: [Text]
ts
where l :: Int64
l = Int -> Int64
intToInt64 (Text -> Int
T.length Text
t)
dropWords :: Int64 -> Text -> Text
dropWords :: Int64 -> Text -> Text
dropWords Int64
i Text
t0
| Int64
i forall a. Ord a => a -> a -> Bool
<= Int64
0 = Text
t0
| Bool
otherwise = Int64 -> Text -> Text
drop' Int64
i Text
t0
where
drop' :: Int64 -> Text -> Text
drop' :: Int64 -> Text -> Text
drop' Int64
0 Text
ts = Text
ts
drop' Int64
_ Text
Empty = Text
Empty
drop' Int64
n (Chunk (T.Text Array
arr Int
off Int
len) Text
ts)
| Int64
n forall a. Ord a => a -> a -> Bool
< Int64
len' = Text -> Text -> Text
chunk (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')) Text
ts
| Bool
otherwise = Int64 -> Text -> Text
drop' (Int64
n forall a. Num a => a -> a -> a
- Int64
len') Text
ts
where len' :: Int64
len' = Int -> Int64
intToInt64 Int
len
n' :: Int
n' = Int64 -> Int
int64ToInt Int64
n
takeWhile :: (Char -> Bool) -> Text -> Text
takeWhile :: (Char -> Bool) -> Text -> Text
takeWhile Char -> Bool
p Text
t0 = Text -> Text
takeWhile' Text
t0
where takeWhile' :: Text -> Text
takeWhile' Text
Empty = Text
Empty
takeWhile' (Chunk Text
t Text
ts) =
case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p) Text
t of
Just Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> Text -> Text -> Text
Chunk (Int -> Text -> Text
T.take Int
n Text
t) Text
Empty
| Bool
otherwise -> Text
Empty
Maybe Int
Nothing -> Text -> Text -> Text
Chunk Text
t (Text -> Text
takeWhile' Text
ts)
{-# INLINE [1] takeWhile #-}
takeWhileEnd :: (Char -> Bool) -> Text -> Text
takeWhileEnd :: (Char -> Bool) -> Text -> Text
takeWhileEnd Char -> Bool
p = Text -> [Text] -> Text
takeChunk Text
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
toChunks
where takeChunk :: Text -> [Text] -> Text
takeChunk Text
acc [] = Text
acc
takeChunk Text
acc (Text
t:[Text]
ts)
| Text -> Int
T.lengthWord8 Text
t' forall a. Ord a => a -> a -> Bool
< Text -> Int
T.lengthWord8 Text
t
= Text -> Text -> Text
chunk Text
t' Text
acc
| Bool
otherwise = Text -> [Text] -> Text
takeChunk (Text -> Text -> Text
Chunk Text
t' Text
acc) [Text]
ts
where t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
p Text
t
{-# INLINE takeWhileEnd #-}
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile Char -> Bool
p Text
t0 = Text -> Text
dropWhile' Text
t0
where dropWhile' :: Text -> Text
dropWhile' Text
Empty = Text
Empty
dropWhile' (Chunk Text
t Text
ts) =
case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p) Text
t of
Just Int
n -> Text -> Text -> Text
Chunk (Int -> Text -> Text
T.drop Int
n Text
t) Text
ts
Maybe Int
Nothing -> Text -> Text
dropWhile' Text
ts
{-# INLINE [1] dropWhile #-}
dropWhileEnd :: (Char -> Bool) -> Text -> Text
dropWhileEnd :: (Char -> Bool) -> Text -> Text
dropWhileEnd Char -> Bool
p = Text -> Text
go
where go :: Text -> Text
go Text
Empty = Text
Empty
go (Chunk Text
t Text
Empty) = if Text -> Bool
T.null Text
t'
then Text
Empty
else Text -> Text -> Text
Chunk Text
t' Text
Empty
where t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
p Text
t
go (Chunk Text
t Text
ts) = case Text -> Text
go Text
ts of
Text
Empty -> Text -> Text
go (Text -> Text -> Text
Chunk Text
t Text
Empty)
Text
ts' -> Text -> Text -> Text
Chunk Text
t Text
ts'
{-# INLINE 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
isSpace
{-# INLINE 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 :: Int64 -> Text -> (Text, Text)
splitAt :: Int64 -> Text -> (Text, Text)
splitAt = Int64 -> Text -> (Text, Text)
loop
where
loop :: Int64 -> Text -> (Text, Text)
loop :: Int64 -> Text -> (Text, Text)
loop Int64
_ Text
Empty = (Text
empty, Text
empty)
loop Int64
n Text
t | Int64
n forall a. Ord a => a -> a -> Bool
<= Int64
0 = (Text
empty, Text
t)
loop Int64
n (Chunk Text
t Text
ts)
| Int64
n forall a. Ord a => a -> a -> Bool
< Int64
len = let (Text
t',Text
t'') = Int -> Text -> (Text, Text)
T.splitAt (Int64 -> Int
int64ToInt Int64
n) Text
t
in (Text -> Text -> Text
Chunk Text
t' Text
Empty, Text -> Text -> Text
Chunk Text
t'' Text
ts)
| Bool
otherwise = let (Text
ts',Text
ts'') = Int64 -> Text -> (Text, Text)
loop (Int64
n forall a. Num a => a -> a -> a
- Int64
len) Text
ts
in (Text -> Text -> Text
Chunk Text
t Text
ts', Text
ts'')
where len :: Int64
len = Int -> Int64
intToInt64 (Text -> Int
T.length Text
t)
splitAtWord :: Int64 -> Text -> PairS Text Text
splitAtWord :: Int64 -> Text -> PairS Text Text
splitAtWord Int64
_ Text
Empty = Text
empty forall a b. a -> b -> PairS a b
:*: Text
empty
splitAtWord Int64
x (Chunk c :: Text
c@(T.Text Array
arr Int
off Int
len) Text
cs)
| Int
y forall a. Ord a => a -> a -> Bool
>= Int
len = let Text
h :*: Text
t = Int64 -> Text -> PairS Text Text
splitAtWord (Int64
xforall a. Num a => a -> a -> a
-Int -> Int64
intToInt64 Int
len) Text
cs
in Text -> Text -> Text
Chunk Text
c Text
h forall a b. a -> b -> PairS a b
:*: Text
t
| Bool
otherwise = Text -> Text -> Text
chunk (Array -> Int -> Int -> Text
text Array
arr Int
off Int
y) Text
empty forall a b. a -> b -> PairS a b
:*:
Text -> Text -> Text
chunk (Array -> Int -> Int -> Text
text Array
arr (Int
offforall a. Num a => a -> a -> a
+Int
y) (Int
lenforall a. Num a => a -> a -> a
-Int
y)) Text
cs
where y :: Int
y = Int64 -> Int
int64ToInt Int64
x
breakOn :: HasCallStack => Text -> Text -> (Text, Text)
breakOn :: HasCallStack => Text -> Text -> (Text, Text)
breakOn Text
pat Text
src
| Text -> Bool
null Text
pat = forall a. HasCallStack => String -> a
emptyError String
"breakOn"
| Bool
otherwise = case Text -> Text -> [Int64]
indices Text
pat Text
src of
[] -> (Text
src, Text
empty)
(Int64
x:[Int64]
_) -> let Text
h :*: Text
t = Int64 -> Text -> PairS Text Text
splitAtWord Int64
x Text
src
in (Text
h, Text
t)
breakOnEnd :: HasCallStack => Text -> Text -> (Text, Text)
breakOnEnd :: HasCallStack => Text -> Text -> (Text, Text)
breakOnEnd Text
pat Text
src = let (Text
a,Text
b) = HasCallStack => Text -> Text -> (Text, Text)
breakOn (Text -> Text
reverse Text
pat) (Text -> Text
reverse Text
src)
in (Text -> Text
reverse Text
b, Text -> Text
reverse Text
a)
{-# INLINE breakOnEnd #-}
breakOnAll :: HasCallStack
=> Text
-> Text
-> [(Text, Text)]
breakOnAll :: HasCallStack => Text -> Text -> [(Text, Text)]
breakOnAll Text
pat Text
src
| Text -> Bool
null Text
pat = forall a. HasCallStack => String -> a
emptyError String
"breakOnAll"
| Bool
otherwise = Int64 -> Text -> Text -> [Int64] -> [(Text, Text)]
go Int64
0 Text
empty Text
src (Text -> Text -> [Int64]
indices Text
pat Text
src)
where
go :: Int64 -> Text -> Text -> [Int64] -> [(Text, Text)]
go !Int64
n Text
p Text
s (Int64
x:[Int64]
xs) = let Text
h :*: Text
t = Int64 -> Text -> PairS Text Text
splitAtWord (Int64
xforall a. Num a => a -> a -> a
-Int64
n) Text
s
h' :: Text
h' = Text -> Text -> Text
append Text
p Text
h
in (Text
h',Text
t) forall a. a -> [a] -> [a]
: Int64 -> Text -> Text -> [Int64] -> [(Text, Text)]
go Int64
x Text
h' Text
t [Int64]
xs
go Int64
_ Text
_ Text
_ [Int64]
_ = []
break :: (Char -> Bool) -> Text -> (Text, Text)
break :: (Char -> Bool) -> Text -> (Text, Text)
break Char -> Bool
p Text
t0 = Text -> (Text, Text)
break' Text
t0
where break' :: Text -> (Text, Text)
break' Text
Empty = (Text
empty, Text
empty)
break' c :: Text
c@(Chunk Text
t Text
ts) =
case (Char -> Bool) -> Text -> Maybe Int
T.findIndex Char -> Bool
p Text
t of
Maybe Int
Nothing -> let (Text
ts', Text
ts'') = Text -> (Text, Text)
break' Text
ts
in (Text -> Text -> Text
Chunk Text
t Text
ts', Text
ts'')
Just Int
n | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 -> (Text
Empty, Text
c)
| Bool
otherwise -> let (Text
a,Text
b) = Int -> Text -> (Text, Text)
T.splitAt Int
n Text
t
in (Text -> Text -> Text
Chunk Text
a Text
Empty, Text -> Text -> Text
Chunk Text
b Text
ts)
span :: (Char -> Bool) -> Text -> (Text, Text)
span :: (Char -> Bool) -> Text -> (Text, Text)
span Char -> Bool
p = (Char -> Bool) -> Text -> (Text, Text)
break (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p)
{-# INLINE span #-}
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 Text
t0 = Text -> m (Text, Text)
go Text
t0
where
go :: Text -> m (Text, Text)
go Text
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
empty, Text
empty)
go (Chunk Text
t Text
ts) = do
(Text
t1, Text
t2) <- forall (m :: * -> *).
Monad m =>
(Char -> m Bool) -> Text -> m (Text, Text)
T.spanM Char -> m Bool
p Text
t
if Text -> Bool
T.null Text
t2 then forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Text -> Text -> Text
chunk Text
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Text, Text)
go Text
ts
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text -> Text
chunk Text
t1 Text
empty, Text -> Text -> Text
Chunk Text
t2 Text
ts)
{-# 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 Text
t0 = Text -> m (Text, Text)
go Text
t0
where
go :: Text -> m (Text, Text)
go Text
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
empty, Text
empty)
go (Chunk Text
t Text
ts) = do
(Text
t3, Text
t4) <- Text -> m (Text, Text)
go Text
ts
if Text -> Bool
null Text
t3 then (\(Text
t1, Text
t2) -> (Text -> Text -> Text
chunk Text
t1 Text
empty, Text -> Text -> Text
chunk Text
t2 Text
ts)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
(Char -> m Bool) -> Text -> m (Text, Text)
T.spanEndM Char -> m Bool
p Text
t
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text -> Text
Chunk Text
t Text
t3, Text
t4)
{-# INLINE spanEndM #-}
group :: Text -> [Text]
group :: Text -> [Text]
group = (Char -> Char -> Bool) -> Text -> [Text]
groupBy forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE group #-}
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
_ Text
Empty = []
groupBy Char -> Char -> Bool
eq (Chunk Text
t Text
ts) = Char -> Text -> Text
cons Char
x Text
ys forall a. a -> [a] -> [a]
: (Char -> Char -> Bool) -> Text -> [Text]
groupBy Char -> Char -> Bool
eq Text
zs
where (Text
ys,Text
zs) = (Char -> Bool) -> Text -> (Text, Text)
span (Char -> Char -> Bool
eq Char
x) Text
xs
x :: Char
x = Text -> Char
T.unsafeHead Text
t
xs :: Text
xs = Text -> Text -> Text
chunk (Text -> Text
T.unsafeTail Text
t) Text
ts
inits :: Text -> [Text]
inits :: Text -> [Text]
inits = (Text
Empty forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
inits'
where inits' :: Text -> [Text]
inits' Text
Empty = []
inits' (Chunk Text
t Text
ts) = forall a b. (a -> b) -> [a] -> [b]
L.map (\Text
t' -> Text -> Text -> Text
Chunk Text
t' Text
Empty) (forall a. Int -> [a] -> [a]
L.drop Int
1 (Text -> [Text]
T.inits Text
t))
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
L.map (Text -> Text -> Text
Chunk Text
t) (Text -> [Text]
inits' Text
ts)
tails :: Text -> [Text]
tails :: Text -> [Text]
tails Text
Empty = Text
Empty forall a. a -> [a] -> [a]
: []
tails ts :: Text
ts@(Chunk Text
t Text
ts')
| Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1 = Text
ts forall a. a -> [a] -> [a]
: Text -> [Text]
tails Text
ts'
| Bool
otherwise = Text
ts forall a. a -> [a] -> [a]
: Text -> [Text]
tails (Text -> Text -> Text
Chunk (Text -> Text
T.unsafeTail Text
t) Text
ts')
splitOn :: HasCallStack
=> Text
-> Text
-> [Text]
splitOn :: HasCallStack => Text -> Text -> [Text]
splitOn Text
pat Text
src
| Text -> Bool
null Text
pat = 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
== HasCallStack => Text -> Char
head Text
pat) Text
src
| Bool
otherwise = Int64 -> [Int64] -> Text -> [Text]
go Int64
0 (Text -> Text -> [Int64]
indices Text
pat Text
src) Text
src
where
go :: Int64 -> [Int64] -> Text -> [Text]
go Int64
_ [] Text
cs = [Text
cs]
go !Int64
i (Int64
x:[Int64]
xs) Text
cs = let Text
h :*: Text
t = Int64 -> Text -> PairS Text Text
splitAtWord (Int64
xforall a. Num a => a -> a -> a
-Int64
i) Text
cs
in Text
h forall a. a -> [a] -> [a]
: Int64 -> [Int64] -> Text -> [Text]
go (Int64
xforall a. Num a => a -> a -> a
+Int64
l) [Int64]
xs (Int64 -> Text -> Text
dropWords Int64
l Text
t)
l :: Int64
l = forall a. (a -> Text -> a) -> a -> Text -> a
foldlChunks (\Int64
a (T.Text Array
_ Int
_ Int
b) -> Int64
a forall a. Num a => a -> a -> a
+ Int -> Int64
intToInt64 Int
b) Int64
0 Text
pat
{-# INLINE [1] splitOn #-}
{-# RULES
"LAZY 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
_ Text
Empty = [Text
Empty]
split Char -> Bool
p (Chunk Text
t0 Text
ts0) = [Text] -> [Text] -> Text -> [Text]
comb [] ((Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
p Text
t0) Text
ts0
where comb :: [Text] -> [Text] -> Text -> [Text]
comb [Text]
acc (Text
s:[]) Text
Empty = [Text] -> Text
revChunks (Text
sforall a. a -> [a] -> [a]
:[Text]
acc) forall a. a -> [a] -> [a]
: []
comb [Text]
acc (Text
s:[]) (Chunk Text
t Text
ts) = [Text] -> [Text] -> Text -> [Text]
comb (Text
sforall a. a -> [a] -> [a]
:[Text]
acc) ((Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
p Text
t) Text
ts
comb [Text]
acc (Text
s:[Text]
ss) Text
ts = [Text] -> Text
revChunks (Text
sforall a. a -> [a] -> [a]
:[Text]
acc) forall a. a -> [a] -> [a]
: [Text] -> [Text] -> Text -> [Text]
comb [] [Text]
ss Text
ts
comb [Text]
_ [] Text
_ = forall a. HasCallStack => String -> a
impossibleError String
"split"
{-# INLINE split #-}
chunksOf :: Int64 -> Text -> [Text]
chunksOf :: Int64 -> Text -> [Text]
chunksOf Int64
k = Text -> [Text]
go
where
go :: Text -> [Text]
go Text
t = case Int64 -> Text -> (Text, Text)
splitAt Int64
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 #-}
lines :: Text -> [Text]
lines :: Text -> [Text]
lines Text
Empty = []
lines Text
t = forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ Text -> NonEmpty Text
go Text
t
where
go :: Text -> NonEmpty Text
go :: Text -> NonEmpty Text
go Text
Empty = Text
Empty forall a. a -> [a] -> NonEmpty a
:| []
go (Chunk Text
x Text
xs)
| Text -> Bool
hasNlEnd Text
x = forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
P.map Text -> Text
fromStrict (Text -> [Text]
T.lines Text
x) forall a. [a] -> [a] -> [a]
++ Text -> [Text]
lines Text
xs
| Bool
otherwise = case forall a. [a] -> Maybe ([a], a)
unsnocList (Text -> [Text]
T.lines Text
x) of
Maybe ([Text], Text)
Nothing -> forall a. HasCallStack => String -> a
impossibleError String
"lines"
Just ([Text]
ls, Text
l) -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
P.foldr (forall a. a -> NonEmpty a -> NonEmpty a
NE.cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromStrict) (Text -> NonEmpty Text -> NonEmpty Text
prependToHead Text
l (Text -> NonEmpty Text
go Text
xs)) [Text]
ls
prependToHead :: T.Text -> NonEmpty Text -> NonEmpty Text
prependToHead :: Text -> NonEmpty Text -> NonEmpty Text
prependToHead Text
l ~(Text
x :| [Text]
xs) = Text -> Text -> Text
chunk Text
l Text
x forall a. a -> [a] -> NonEmpty a
:| [Text]
xs
unsnocList :: [a] -> Maybe ([a], a)
unsnocList :: forall a. [a] -> Maybe ([a], a)
unsnocList [] = forall a. Maybe a
Nothing
unsnocList (a
x : [a]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> [a] -> ([a], a)
go a
x [a]
xs
where
go :: a -> [a] -> ([a], a)
go a
y [] = ([], a
y)
go a
y (a
z : [a]
zs) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
y forall a. a -> [a] -> [a]
:) (a -> [a] -> ([a], a)
go a
z [a]
zs)
hasNlEnd :: T.Text -> Bool
hasNlEnd :: Text -> Bool
hasNlEnd (T.Text Array
arr Int
off Int
len) = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
off forall a. Num a => a -> a -> a
+ Int
len forall a. Num a => a -> a -> a
- Int
1) forall a. Eq a => a -> a -> Bool
== Word8
0x0A
words :: Text -> [Text]
words :: Text -> [Text]
words = forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
split Char -> Bool
isSpace
{-# INLINE words #-}
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 Text
Empty Text
_ = Bool
True
isPrefixOf Text
_ Text
Empty = Bool
False
isPrefixOf (Chunk Text
x Text
xs) (Chunk Text
y Text
ys)
| Int
lx forall a. Eq a => a -> a -> Bool
== Int
ly = Text
x forall a. Eq a => a -> a -> Bool
== Text
y Bool -> Bool -> Bool
&& Text -> Text -> Bool
isPrefixOf Text
xs Text
ys
| Int
lx forall a. Ord a => a -> a -> Bool
< Int
ly = Text
x forall a. Eq a => a -> a -> Bool
== Text
yh Bool -> Bool -> Bool
&& Text -> Text -> Bool
isPrefixOf Text
xs (Text -> Text -> Text
Chunk Text
yt Text
ys)
| Bool
otherwise = Text
xh forall a. Eq a => a -> a -> Bool
== Text
y Bool -> Bool -> Bool
&& Text -> Text -> Bool
isPrefixOf (Text -> Text -> Text
Chunk Text
xt Text
xs) Text
ys
where (Text
xh,Text
xt) = Int -> Text -> (Text, Text)
T.splitAt Int
ly Text
x
(Text
yh,Text
yt) = Int -> Text -> (Text, Text)
T.splitAt Int
lx Text
y
lx :: Int
lx = Text -> Int
T.length Text
x
ly :: Int
ly = Text -> Int
T.length Text
y
isSuffixOf :: Text -> Text -> Bool
isSuffixOf :: Text -> Text -> Bool
isSuffixOf Text
x Text
y = Text -> Text
reverse Text
x Text -> Text -> Bool
`isPrefixOf` Text -> Text
reverse Text
y
{-# 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 (HasCallStack => Text -> Char
head 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 -> [Int64]
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 Text
p Text
t
| Text -> Bool
null Text
p = forall a. a -> Maybe a
Just Text
t
| Bool
otherwise = case Text -> Text -> Maybe (Text, Text, Text)
commonPrefixes Text
p Text
t of
Just (Text
_,Text
c,Text
r) | Text -> Bool
null Text
c -> forall a. a -> Maybe a
Just Text
r
Maybe (Text, Text, Text)
_ -> forall a. Maybe a
Nothing
commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
commonPrefixes :: Text -> Text -> Maybe (Text, Text, Text)
commonPrefixes Text
Empty Text
_ = forall a. Maybe a
Nothing
commonPrefixes Text
_ Text
Empty = forall a. Maybe a
Nothing
commonPrefixes Text
a0 Text
b0 = forall a. a -> Maybe a
Just (Text -> Text -> [Text] -> (Text, Text, Text)
go Text
a0 Text
b0 [])
where
go :: Text -> Text -> [Text] -> (Text, Text, Text)
go t0 :: Text
t0@(Chunk Text
x Text
xs) t1 :: Text
t1@(Chunk Text
y Text
ys) [Text]
ps
= case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
x Text
y of
Just (Text
p,Text
a,Text
b)
| Text -> Bool
T.null Text
a -> Text -> Text -> [Text] -> (Text, Text, Text)
go Text
xs (Text -> Text -> Text
chunk Text
b Text
ys) (Text
pforall a. a -> [a] -> [a]
:[Text]
ps)
| Text -> Bool
T.null Text
b -> Text -> Text -> [Text] -> (Text, Text, Text)
go (Text -> Text -> Text
chunk Text
a Text
xs) Text
ys (Text
pforall a. a -> [a] -> [a]
:[Text]
ps)
| Bool
otherwise -> ([Text] -> Text
fromChunks (forall a. [a] -> [a]
L.reverse (Text
pforall a. a -> [a] -> [a]
:[Text]
ps)),Text -> Text -> Text
chunk Text
a Text
xs, Text -> Text -> Text
chunk Text
b Text
ys)
Maybe (Text, Text, Text)
Nothing -> ([Text] -> Text
fromChunks (forall a. [a] -> [a]
L.reverse [Text]
ps),Text
t0,Text
t1)
go Text
t0 Text
t1 [Text]
ps = ([Text] -> Text
fromChunks (forall a. [a] -> [a]
L.reverse [Text]
ps),Text
t0,Text
t1)
stripSuffix :: Text -> Text -> Maybe Text
stripSuffix :: Text -> Text -> Maybe Text
stripSuffix Text
p Text
t = Text -> Text
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Text -> Maybe Text
stripPrefix (Text -> Text
reverse Text
p) (Text -> Text
reverse Text
t)
filter :: (Char -> Bool) -> Text -> Text
filter :: (Char -> Bool) -> Text -> Text
filter Char -> Bool
p = forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks (Text -> Text -> Text
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
p) Text
Empty
{-# INLINE [1] filter #-}
{-# RULES
"TEXT filter/filter -> filter" forall p q t.
filter p (filter q t) = filter (\c -> p c && q c) t
#-}
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 #-}
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 #-}
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 #-}
index :: HasCallStack => Text -> Int64 -> Char
index :: HasCallStack => Text -> Int64 -> Char
index Text
t Int64
n = HasCallStack => Stream Char -> Int64 -> Char
S.index (Text -> Stream Char
stream Text
t) Int64
n
{-# INLINE index #-}
count :: HasCallStack => Text -> Text -> Int64
count :: HasCallStack => Text -> Text -> Int64
count Text
pat
| Text -> Bool
null Text
pat = forall a. HasCallStack => String -> a
emptyError String
"count"
| Bool
otherwise = forall {t} {a}. Num t => t -> [a] -> t
go Int64
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Int64]
indices Text
pat
where go :: t -> [a] -> t
go !t
n [] = t
n
go !t
n (a
_:[a]
xs) = t -> [a] -> t
go (t
nforall a. Num a => a -> a -> a
+t
1) [a]
xs
{-# INLINE [1] count #-}
{-# RULES
"LAZY TEXT count/singleton -> countChar" [~1] forall c t.
count (singleton c) t = countChar c t
#-}
countChar :: Char -> Text -> Int64
countChar :: Char -> Text -> Int64
countChar Char
c Text
t = Char -> Stream Char -> Int64
S.countChar Char
c (Text -> Stream Char
stream Text
t)
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 [0] 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 [0] zipWith #-}
revChunks :: [T.Text] -> Text
revChunks :: [Text] -> Text
revChunks = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
chunk) Text
Empty
emptyError :: HasCallStack => String -> a
emptyError :: forall a. HasCallStack => String -> a
emptyError String
fun = forall a. HasCallStack => String -> a
P.error (String
"Data.Text.Lazy." forall a. [a] -> [a] -> [a]
++ String
fun forall a. [a] -> [a] -> [a]
++ String
": empty input")
impossibleError :: HasCallStack => String -> a
impossibleError :: forall a. HasCallStack => String -> a
impossibleError String
fun = forall a. HasCallStack => String -> a
P.error (String
"Data.Text.Lazy." forall a. [a] -> [a] -> [a]
++ String
fun forall a. [a] -> [a] -> [a]
++ String
": impossible case")
intToInt64 :: Exts.Int -> Int64
intToInt64 :: Int -> Int64
intToInt64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
int64ToInt :: Int64 -> Exts.Int
int64ToInt :: Int64 -> Int
int64ToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral