{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Text.Internal.Lazy
(
Text(..)
, chunk
, empty
, foldrChunks
, foldlChunks
, strictInvariant
, lazyInvariant
, showStructure
, defaultChunkSize
, smallChunkSize
, chunkOverhead
, equal
) where
import Data.Bits (shiftL)
import Data.Text ()
import Data.Typeable (Typeable)
import Foreign.Storable (sizeOf)
import qualified Data.Text.Array as A
import qualified Data.Text.Internal as T
data Text = Empty
| Chunk {-# UNPACK #-} !T.Text Text
deriving (Typeable)
strictInvariant :: Text -> Bool
strictInvariant :: Text -> Bool
strictInvariant Text
Empty = Bool
True
strictInvariant x :: Text
x@(Chunk (T.Text Array
_ Int
_ Int
len) Text
cs)
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Text -> Bool
strictInvariant Text
cs
| Bool
otherwise = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Text.Lazy: invariant violation: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
showStructure Text
x
lazyInvariant :: Text -> Text
lazyInvariant :: Text -> Text
lazyInvariant Text
Empty = Text
Empty
lazyInvariant x :: Text
x@(Chunk c :: Text
c@(T.Text Array
_ Int
_ Int
len) Text
cs)
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Text -> Text -> Text
Chunk Text
c (Text -> Text
lazyInvariant Text
cs)
| Bool
otherwise = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Text.Lazy: invariant violation: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
showStructure Text
x
showStructure :: Text -> String
showStructure :: Text -> [Char]
showStructure Text
Empty = [Char]
"Empty"
showStructure (Chunk Text
t Text
Empty) = [Char]
"Chunk " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Empty"
showStructure (Chunk Text
t Text
ts) =
[Char]
"Chunk " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
showStructure Text
ts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
chunk :: T.Text -> Text -> Text
{-# INLINE chunk #-}
chunk :: Text -> Text -> Text
chunk t :: Text
t@(T.Text Array
_ Int
_ Int
len) Text
ts | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
ts
| Bool
otherwise = Text -> Text -> Text
Chunk Text
t Text
ts
empty :: Text
{-# INLINE [0] empty #-}
empty :: Text
empty = Text
Empty
foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
foldrChunks :: forall a. (Text -> a -> a) -> a -> Text -> a
foldrChunks Text -> a -> a
f a
z = Text -> a
go
where go :: Text -> a
go Text
Empty = a
z
go (Chunk Text
c Text
cs) = Text -> a -> a
f Text
c (Text -> a
go Text
cs)
{-# INLINE foldrChunks #-}
foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
foldlChunks :: forall a. (a -> Text -> a) -> a -> Text -> a
foldlChunks a -> Text -> a
f a
z = a -> Text -> a
go a
z
where go :: a -> Text -> a
go !a
a Text
Empty = a
a
go !a
a (Chunk Text
c Text
cs) = a -> Text -> a
go (a -> Text -> a
f a
a Text
c) Text
cs
{-# INLINE foldlChunks #-}
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int
16384 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead
{-# INLINE defaultChunkSize #-}
smallChunkSize :: Int
smallChunkSize :: Int
smallChunkSize = Int
128 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead
{-# INLINE smallChunkSize #-}
chunkOverhead :: Int
chunkOverhead :: Int
chunkOverhead = Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
{-# INLINE chunkOverhead #-}
equal :: Text -> Text -> Bool
equal :: Text -> Text -> Bool
equal Text
Empty Text
Empty = Bool
True
equal Text
Empty Text
_ = Bool
False
equal Text
_ Text
Empty = Bool
False
equal (Chunk (T.Text Array
arrA Int
offA Int
lenA) Text
as) (Chunk (T.Text Array
arrB Int
offB Int
lenB) Text
bs) =
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lenA Int
lenB of
Ordering
LT -> Array -> Int -> Array -> Int -> Int -> Bool
A.equal Array
arrA Int
offA Array
arrB Int
offB Int
lenA Bool -> Bool -> Bool
&&
Text
as Text -> Text -> Bool
`equal` Text -> Text -> Text
Chunk (Array -> Int -> Int -> Text
T.Text Array
arrB (Int
offB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenA) (Int
lenB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenA)) Text
bs
Ordering
EQ -> Array -> Int -> Array -> Int -> Int -> Bool
A.equal Array
arrA Int
offA Array
arrB Int
offB Int
lenA Bool -> Bool -> Bool
&&
Text
as Text -> Text -> Bool
`equal` Text
bs
Ordering
GT -> Array -> Int -> Array -> Int -> Int -> Bool
A.equal Array
arrA Int
offA Array
arrB Int
offB Int
lenB Bool -> Bool -> Bool
&&
Text -> Text -> Text
Chunk (Array -> Int -> Int -> Text
T.Text Array
arrA (Int
offA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenB) (Int
lenA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenB)) Text
as Text -> Text -> Bool
`equal` Text
bs