src/Data/Text/Internal/Fusion/Size.hs

    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -fno-warn-missing-methods #-}
    -- |
    -- Module      : Data.Text.Internal.Fusion.Internal
    -- Copyright   : (c) Roman Leshchinskiy 2008,
    --               (c) Bryan O'Sullivan 2009
    --
    -- License     : BSD-style
    -- Maintainer  : bos@serpentine.com
    -- Stability   : experimental
    -- Portability : portable
    --
    -- /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!
    --
    -- Size hints.

    module Data.Text.Internal.Fusion.Size
        (
          Size
          -- * Sizes
        , exactSize
        , maxSize
        , betweenSize
        , unknownSize
        , unionSize
        , charSize
        , codePointsSize
          -- * Querying sizes
        , exactly
        , smaller
        , larger
        , upperBound
        , lowerBound
        , compareSize
        , isEmpty
        ) where

    import Data.Char (ord)
    import Data.Text.Internal (mul)
    #if defined(ASSERTS)
    import Control.Exception (assert)
    #endif

    -- | A size in UTF-16 code units.
    data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
              | Unknown                                         -- ^ Unknown size.
                deriving (Eq, Show)

    exactly :: Size -> Maybe Int
    exactly (Between na nb) | na == nb = Just na
    exactly _ = Nothing
    {-# INLINE exactly #-}

    -- | The 'Size' of the given code point.
    charSize :: Char -> Size
    charSize c
      | ord c < 0x10000 = exactSize 1
      | otherwise       = exactSize 2

    -- | The 'Size' of @n@ code points.
    codePointsSize :: Int -> Size
    codePointsSize n =
    #if defined(ASSERTS)
        assert (n >= 0)
    #endif
        Between n (2*n)
    {-# INLINE codePointsSize #-}

    exactSize :: Int -> Size
    exactSize n =
    #if defined(ASSERTS)
        assert (n >= 0)
    #endif
        Between n n
    {-# INLINE exactSize #-}

    maxSize :: Int -> Size
    maxSize n =
    #if defined(ASSERTS)
        assert (n >= 0)
    #endif
        Between 0 n
    {-# INLINE maxSize #-}

    betweenSize :: Int -> Int -> Size
    betweenSize m n =
    #if defined(ASSERTS)
        assert (m >= 0)
        assert (n >= m)
    #endif
        Between m n
    {-# INLINE betweenSize #-}

    unionSize :: Size -> Size -> Size
    unionSize (Between a b) (Between c d) = Between (min a c) (max b d)
    unionSize _ _ = Unknown

    unknownSize :: Size
    unknownSize = Unknown
    {-# INLINE unknownSize #-}

    instance Num Size where
        (+) = addSize
        (-) = subtractSize
        (*) = mulSize

        fromInteger = f where f = exactSize . fromInteger
                              {-# INLINE f #-}

    add :: Int -> Int -> Int
    add m n | mn >=   0 = mn
            | otherwise = overflowError
      where mn = m + n
    {-# INLINE add #-}

    addSize :: Size -> Size -> Size
    addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
    addSize _               _               = Unknown
    {-# INLINE addSize #-}

    subtractSize :: Size -> Size -> Size
    subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
    subtractSize a@(Between 0 _) Unknown         = a
    subtractSize (Between _ mb)  Unknown         = Between 0 mb
    subtractSize _               _               = Unknown
    {-# INLINE subtractSize #-}

    mulSize :: Size -> Size -> Size
    mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
    mulSize _               _               = Unknown
    {-# INLINE mulSize #-}

    -- | Minimum of two size hints.
    smaller :: Size -> Size -> Size
    smaller a@(Between ma mb) b@(Between na nb)
        | mb <= na  = a
        | nb <= ma  = b
        | otherwise = Between (ma `min` na) (mb `min` nb)
    smaller a@(Between 0 _) Unknown         = a
    smaller (Between _ mb)  Unknown         = Between 0 mb
    smaller Unknown         b@(Between 0 _) = b
    smaller Unknown         (Between _ nb)  = Between 0 nb
    smaller Unknown         Unknown         = Unknown
    {-# INLINE smaller #-}

    -- | Maximum of two size hints.
    larger :: Size -> Size -> Size
    larger a@(Between ma mb) b@(Between na nb)
        | ma >= nb  = a
        | na >= mb  = b
        | otherwise = Between (ma `max` na) (mb `max` nb)
    larger _ _ = Unknown
    {-# INLINE larger #-}

    -- | Compute the maximum size from a size hint, if possible.
    upperBound :: Int -> Size -> Int
    upperBound _ (Between _ n) = n
    upperBound k _             = k
    {-# INLINE upperBound #-}

    -- | Compute the maximum size from a size hint, if possible.
    lowerBound :: Int -> Size -> Int
    lowerBound _ (Between n _) = n
    lowerBound k _             = k
    {-# INLINE lowerBound #-}

    -- | Determine the ordering relationship between two 'Size's, or 'Nothing' in
    -- the indeterminate case.
    compareSize :: Size -> Size -> Maybe Ordering
    compareSize (Between ma mb) (Between na nb)
      | mb < na            = Just LT
      | ma > nb            = Just GT
      | ma == mb
      , ma == na
      , ma == nb           = Just EQ
    compareSize _ _        = Nothing

    isEmpty :: Size -> Bool
    isEmpty (Between _ n) = n <= 0
    isEmpty _             = False
    {-# INLINE isEmpty #-}

    overflowError :: Int
    overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"