1 {-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
    2 -- |
    3 -- Module      : Data.Text.Lazy.Internal
    4 -- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
    5 --
    6 -- License     : BSD-style
    7 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
    8 --               duncan@haskell.org
    9 -- Stability   : experimental
   10 -- Portability : GHC
   11 -- 
   12 -- A module containing semi-public 'Text' internals. This exposes the
   13 -- 'Text' representation and low level construction functions.
   14 -- Modules which extend the 'Text' system may need to use this module.
   15 -- Regular users should not.
   16 module Data.Text.Lazy.Internal
   17     (
   18       Text(..)
   19     , chunk
   20     , empty
   21     , foldrChunks
   22     , foldlChunks
   23     -- * Data type invariant and abstraction functions
   24 
   25     -- $invariant
   26     , strictInvariant
   27     , lazyInvariant
   28     , showStructure
   29 
   30     -- * Chunk allocation sizes
   31     , defaultChunkSize
   32     , smallChunkSize
   33     , chunkOverhead
   34     ) where
   35 
   36 import qualified Data.Text.Internal as T
   37 import Data.Text ()
   38 import Data.Text.UnsafeShift
   39 import Data.Typeable (Typeable)
   40 import Foreign.Storable (sizeOf)
   41 
   42 data Text = Empty
   43           | Chunk {-# UNPACK #-} !T.Text Text
   44             deriving (-- never enteredTypeable)
   45 
   46 -- $invariant
   47 --
   48 -- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
   49 -- consists of non-null 'T.Text's.  All functions must preserve this,
   50 -- and the QC properties must check this.
   51 
   52 -- | Check the invariant strictly.
   53 strictInvariant :: Text -> Bool
   54 -- never enteredstrictInvariant Empty = True
   55 strictInvariant x@(Chunk (T.Text _ _ len) cs)
   56     | len > 0   = strictInvariant cs
   57     | otherwise = error $ "Data.Text.Lazy: invariant violation: "
   58                   ++ showStructure x
   59 
   60 -- | Check the invariant lazily.
   61 lazyInvariant :: Text -> Text
   62 -- entered 11,660 timeslazyInvariant Empty = Empty
   63 lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
   64     | len > 0   = Chunk c (lazyInvariant cs)
   65     | otherwise = error $ "Data.Text.Lazy: invariant violation: "
   66                   ++ showStructure x
   67 
   68 -- | Display the internal structure of a lazy 'Text'.
   69 showStructure :: Text -> String
   70 -- never enteredshowStructure Empty           = "Empty"
   71 showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
   72 showStructure (Chunk t ts)    =
   73     "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
   74 
   75 -- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
   76 chunk :: T.Text -> Text -> Text
   77 {-# INLINE chunk #-}
   78 -- entered 98,281 timeschunk t@(T.Text _ _ len) ts | len == 0 = ts
   79                             | otherwise = Chunk t ts
   80 
   81 -- | Smart constructor for 'Empty'.
   82 empty :: Text
   83 {-# INLINE [0] empty #-}
   84 -- entered onceempty = Empty
   85 
   86 -- | Consume the chunks of a lazy 'Text' with a natural right fold.
   87 foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
   88 -- entered 8006 timesfoldrChunks f z = go
   89   where go Empty        = z
   90         go (Chunk c cs) = f c (go cs)
   91 {-# INLINE foldrChunks #-}
   92 
   93 -- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
   94 -- accumulating left fold.
   95 foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
   96 -- entered 4628 timesfoldlChunks f z = go z
   97   where go !a Empty        = a
   98         go !a (Chunk c cs) = go (f a c) cs
   99 {-# INLINE foldlChunks #-}
  100 
  101 -- | Currently set to 16 KiB, less the memory management overhead.
  102 defaultChunkSize :: Int
  103 -- entered 36,822 timesdefaultChunkSize = 16384 - chunkOverhead
  104 {-# INLINE defaultChunkSize #-}
  105 
  106 -- | Currently set to 128 bytes, less the memory management overhead.
  107 smallChunkSize :: Int
  108 -- entered 852 timessmallChunkSize = 128 - chunkOverhead
  109 {-# INLINE smallChunkSize #-}
  110 
  111 -- | The memory management overhead. Currently this is tuned for GHC only.
  112 chunkOverhead :: Int
  113 -- entered 37,673 timeschunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
  114 {-# INLINE chunkOverhead #-}