content: {-# LANGUAGE BangPatterns        #-}
  {-# LANGUAGE MagicHash           #-}
  {-# LANGUAGE CPP                 #-}
  {-# LANGUAGE TypeFamilies        #-}
  
  -- |
  -- Module      : Codec.CBOR.ByteArray.Sliced
  -- Copyright   : (c) Ben Gamari 2017-2018
  -- License     : BSD3-style (see LICENSE.txt)
  --
  -- Maintainer  : duncan@community.haskell.org
  -- Stability   : experimental
  -- Portability : non-portable (GHC extensions)
  --
  -- A ByteArray with more instances than 'Data.Primitive.ByteArray.ByteArray'.
  -- Some day when these instances are reliably available from @primitive@ we can
  -- likely replace this with 'Data.Primitive.ByteArray.ByteArray'.
  --
  module Codec.CBOR.ByteArray.Sliced
    ( SlicedByteArray(..)
      -- * Conversions
    , sizeofSlicedByteArray
    , fromShortByteString
    , fromByteString
    , fromByteArray
    , toByteString
    , toBuilder
    ) where
  
  import GHC.Exts
  import Data.Char (chr, ord)
  import Data.Word
  import Foreign.Ptr
  import Control.Monad.ST
  import System.IO.Unsafe
  
  import qualified Data.Primitive.ByteArray as Prim
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Unsafe as BS
  import qualified Data.ByteString.Short as BSS
  #if !MIN_VERSION_bytestring(0,11,1)
  import qualified Data.ByteString.Short.Internal as BSS
  #endif
  import qualified Data.ByteString.Builder as BSB
  import qualified Data.ByteString.Builder.Internal as BSB
  
  import Codec.CBOR.ByteArray.Internal
  
  data SlicedByteArray = SBA {unSBA :: !Prim.ByteArray, offset :: !Int, length :: !Int}
  
  fromShortByteString :: BSS.ShortByteString -> SlicedByteArray
  #if MIN_VERSION_bytestring(0,12,0)
  fromShortByteString (BSS.ShortByteString ba) = fromByteArray ba
  #else
  fromShortByteString (BSS.SBS ba) = fromByteArray (Prim.ByteArray ba)
  #endif
  
  fromByteString :: BS.ByteString -> SlicedByteArray
  fromByteString = fromShortByteString . BSS.toShort
  
  fromByteArray :: Prim.ByteArray -> SlicedByteArray
  fromByteArray ba = SBA ba 0 (Prim.sizeofByteArray ba)
  
  sizeofSlicedByteArray :: SlicedByteArray -> Int
  sizeofSlicedByteArray (SBA _ _ len) = len
  
  -- | Note that this may require a copy.
  toByteString :: SlicedByteArray -> BS.ByteString
  toByteString sba =
      unsafePerformIO
      $ BS.unsafePackCStringFinalizer ptr (sizeofSlicedByteArray sba) (touch pinned)
    where
      pinned = toPinned sba
      !(Ptr addr#) = Prim.byteArrayContents pinned
      ptr = Ptr addr#
  
  toPinned :: SlicedByteArray -> Prim.ByteArray
  toPinned (SBA ba off len)
    | isByteArrayPinned ba = ba
    | otherwise = runST $ do
          ba' <- Prim.newPinnedByteArray len
          Prim.copyByteArray ba' 0 ba off len
          Prim.unsafeFreezeByteArray ba'
  
  toBuilder :: SlicedByteArray -> BSB.Builder
  toBuilder = \(SBA ba off len) -> BSB.builder (go ba off (len + off))
    where
      go ba !ip !ipe !k (BSB.BufferRange op ope)
        | inpRemaining <= outRemaining = do
            copyToAddr ba ip op inpRemaining
            let !br' = BSB.BufferRange (op `plusPtr` inpRemaining) ope
            k br'
        | otherwise = do
            copyToAddr ba ip op outRemaining
            let !ip' = ip + outRemaining
            return $ BSB.bufferFull 1 ope (go ba ip' ipe k)
        where
          outRemaining = ope `minusPtr` op
          inpRemaining = ipe - ip
  
  instance IsString SlicedByteArray where
    fromString = fromList . map checkedOrd
      where
        checkedOrd c
          | c > '\xff' = error "IsString(Codec.CBOR.ByteArray.Sliced): Non-ASCII character"
          | otherwise  = fromIntegral $ ord c
  
  instance IsList SlicedByteArray where
    type Item SlicedByteArray = Word8
    fromList xs = fromListN (Prelude.length xs) xs
    -- Note that we make no attempt to behave sensibly if @n /= length xs@.
    -- The class definition allows this.
    fromListN n xs =
        let arr = mkByteArray n xs
        in SBA arr 0 n
    toList (SBA arr off len) =
        foldrByteArray (:) [] off len arr
  
  instance Show SlicedByteArray where
    showsPrec _ = shows . map (chr . fromIntegral) . toList
  
  instance Eq SlicedByteArray where
    SBA arr1 off1 len1 == SBA arr2 off2 len2
      | len1 /= len2
      = False
  
      | sameByteArray arr1 arr2
      , off1 == off2
      , len1 == len2
      = True
  
      | otherwise
      = let (!) :: Prim.ByteArray -> Int -> Word8
            (!) = Prim.indexByteArray
            -- len1 and len2 are known to be equal at this point
            len1' = len1 + off1
            go i1 i2
              | i1 == len1' = True
              | (arr1 ! i1) == (arr2 ! i2) = go (i1+1) (i2+1)
              | otherwise                  = False
        in go off1 off2
  
  instance Ord SlicedByteArray where
    SBA arr1 off1 len1 `compare` SBA arr2 off2 len2
      | sameByteArray arr1 arr2
      , off1 == off2
      , len1 == len2
      = EQ
  
      | otherwise
      = let (!) :: Prim.ByteArray -> Int -> Word8
            (!) = Prim.indexByteArray
            len1' = len1 + off1
            len2' = len2 + off2
            go i1 i2
              | i1 == len1' && i2 == len2' = EQ
              | i1 == len1' || i2 == len2' = len1 `compare` len2
              | EQ <- o                    = go (i1+1) (i2+1)
              | otherwise                  = o
              where o = (arr1 ! i1) `compare` (arr2 ! i2)
        in go off1 off2
  