    {-# 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(..)
        , LazyText
        , 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
    import qualified Data.Text as T

    data Text = Empty
              | Chunk {-# UNPACK #-} !T.Text Text
                deriving (Typeable)

    -- | Type synonym for the lazy flavour of 'Text'.
    type LazyText = Text

    -- $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 [0] chunk #-}
    chunk :: Text -> Text -> Text
    chunk Text
    t Text
    ts | Text -> Bool
    T.null Text
    t = Text
    ts
               | Bool
    otherwise = Text -> Text -> Text
    Chunk Text
    t Text
    ts

    {-# RULES
    "TEXT chunk/text" forall arr off len.
        chunk (T.text arr off len) = chunk (T.Text arr off len)
    "TEXT chunk/empty" forall ts.
        chunk T.empty ts = 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 :: 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 #-}

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

    -- | 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