{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK not-home #-}

-- |
-- Module      : Data.Text.Internal.Lazy
-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!
--
-- A module containing private 'Text' internals. This exposes the
-- 'Text' representation and low level construction functions.
-- Modules which extend the 'Text' system may need to use this module.

module Data.Text.Internal.Lazy
    (
      Text(..)
    , chunk
    , empty
    , foldrChunks
    , foldlChunks
    -- * Data type invariant and abstraction functions

    -- $invariant
    , strictInvariant
    , lazyInvariant
    , showStructure

    -- * Chunk allocation sizes
    , 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)

-- $invariant
--
-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
-- consists of non-null 'T.Text's.  All functions must preserve this,
-- and the QC properties must check this.

-- | Check the invariant strictly.
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

-- | Check the invariant lazily.
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

-- | Display the internal structure of a lazy 'Text'.
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]
")"

-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
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

-- | Smart constructor for 'Empty'.
empty :: Text
{-# INLINE [0] empty #-}
empty :: Text
empty = Text
Empty

-- | Consume the chunks of a lazy 'Text' with a natural right fold.
foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
foldrChunks :: (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 #-}

-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
-- accumulating left fold.
foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
foldlChunks :: (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 #-}

-- | Currently set to 16 KiB, less the memory management overhead.
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int
16384 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead
{-# INLINE defaultChunkSize #-}

-- | Currently set to 128 bytes, less the memory management overhead.
smallChunkSize :: Int
smallChunkSize :: Int
smallChunkSize = Int
128 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead
{-# INLINE smallChunkSize #-}

-- | The memory management overhead. Currently this is tuned for GHC only.
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