{-# LANGUAGE BangPatterns    #-}
{-# LANGUAGE CPP             #-}
{-# LANGUAGE MagicHash       #-}
#if !(MIN_VERSION_bytestring(0,10,0))
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-|
Module:      TextShow.Data.ByteString
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances for data types in the @bytestring@ library.

/Since: 2/
-}
module TextShow.Data.ByteString () where

import qualified Data.ByteString.Internal      as BS
import qualified Data.ByteString.Lazy.Internal as BL
import qualified Data.ByteString.Short         as SBS
import           Data.ByteString.Short.Internal (ShortByteString(..))

import           GHC.Exts (ByteArray#, Char(C#), Int(I#), indexCharArray#)

import           TextShow.Classes (TextShow(..))
import           TextShow.Data.Char ()
import           TextShow.Data.List ()

#if !(MIN_VERSION_bytestring(0,10,0))
import           Data.Word (Word8)

import           Foreign.ForeignPtr (withForeignPtr)
import           Foreign.Ptr (plusPtr)
import           Foreign.Storable (peek, peekByteOff)

import           TextShow.TH.Internal (deriveTextShow)
#endif

------------------------------------------------------------------------
-- Primop wrappers

data BA = BA# ByteArray#

indexCharArray :: BA -> Int -> Char
indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#)

------------------------------------------------------------------------
-- Internal utils

asBA :: ShortByteString -> BA
asBA (SBS ba#) = BA# ba#
------------------------------------------------------------------------

-- | /Since: 2/
instance TextShow BS.ByteString where
    {-# INLINE showb #-}
#if MIN_VERSION_bytestring(0,10,0)
    showb = showb . BS.unpackChars
#else
    showb = showb . unpackWith BS.w2c

-- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function.
unpackWith :: (Word8 -> a) -> BS.ByteString -> [a]
unpackWith _ (BS.PS _  _ 0) = []
unpackWith k (BS.PS ps s l) = BS.inlinePerformIO $ withForeignPtr ps $ \p ->
        go (p `plusPtr` s) (l - 1) []
    where
        go !p !0 !acc = peek p          >>= \e -> return (k e : acc)
        go !p !n !acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc)
{-# INLINE unpackWith #-}
#endif

#if MIN_VERSION_bytestring(0,10,0)
-- | /Since: 2/
instance TextShow BL.ByteString where
    showb = showb . BL.unpackChars
    {-# INLINE showb #-}
#else
-- | /Since: 2/
$(deriveTextShow ''BL.ByteString)
#endif

-- | /Since: 2/
instance TextShow ShortByteString where
    showb = showb . unpackChars
    {-# INLINE showb #-}

-- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand
-- we would like to write a tight loop that just blats the list into memory, on
-- the other hand we want it to be unpacked lazily so we don't end up with a
-- massive list data structure in memory.
--
-- Our strategy is to combine both: we will unpack lazily in reasonable sized
-- chunks, where each chunk is unpacked strictly.
--
-- unpackChars does the lazy loop, while unpackAppendBytes and
-- unpackAppendChars do the chunks strictly.

unpackChars :: ShortByteString -> [Char]
unpackChars bs = unpackAppendCharsLazy bs []

-- Why 100 bytes you ask? Because on a 64bit machine the list we allocate
-- takes just shy of 4k which seems like a reasonable amount.
-- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)

unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char]
unpackAppendCharsLazy sbs cs0 =
    go 0 (SBS.length sbs) cs0
  where
    sz = 100

    go off len cs
      | len <= sz = unpackAppendCharsStrict sbs off len cs
      | otherwise = unpackAppendCharsStrict sbs off sz  remainder
                      where remainder = go (off+sz) (len-sz) cs

-- For these unpack functions, since we're unpacking the whole list strictly we
-- build up the result list in an accumulator. This means we have to build up
-- the list starting at the end. So our traversal starts at the end of the
-- buffer and loops down until we hit the sentinal:

unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]
unpackAppendCharsStrict !sbs off len cs =
    go (off-1) (off-1 + len) cs
  where
    go !sentinal !i !acc
      | i == sentinal = acc
      | otherwise     = let !c = indexCharArray (asBA sbs) i
                        in go sentinal (i-1) (c:acc)