{-# LANGUAGE BangPatterns    #-}
{-# LANGUAGE MagicHash       #-}
{-# OPTIONS_GHC -Wno-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 ()

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

data BA = BA# ByteArray#

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

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

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

-- | /Since: 2/
instance TextShow BS.ByteString where
    {-# INLINE showb #-}
    showb :: ByteString -> Builder
showb = [Char] -> Builder
forall a. TextShow a => a -> Builder
showb ([Char] -> Builder)
-> (ByteString -> [Char]) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpackChars

-- | /Since: 2/
instance TextShow BL.ByteString where
    showb :: ByteString -> Builder
showb = [Char] -> Builder
forall a. TextShow a => a -> Builder
showb ([Char] -> Builder)
-> (ByteString -> [Char]) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BL.unpackChars
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow ShortByteString where
    showb :: ShortByteString -> Builder
showb = [Char] -> Builder
forall a. TextShow a => a -> Builder
showb ([Char] -> Builder)
-> (ShortByteString -> [Char]) -> ShortByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Char]
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 :: ShortByteString -> [Char]
unpackChars ShortByteString
bs = ShortByteString -> [Char] -> [Char]
unpackAppendCharsLazy ShortByteString
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 :: ShortByteString -> [Char] -> [Char]
unpackAppendCharsLazy ShortByteString
sbs [Char]
cs0 =
    Int -> Int -> [Char] -> [Char]
go Int
0 (ShortByteString -> Int
SBS.length ShortByteString
sbs) [Char]
cs0
  where
    sz :: Int
sz = Int
100

    go :: Int -> Int -> [Char] -> [Char]
go Int
off Int
len [Char]
cs
      | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sz = ShortByteString -> Int -> Int -> [Char] -> [Char]
unpackAppendCharsStrict ShortByteString
sbs Int
off Int
len [Char]
cs
      | Bool
otherwise = ShortByteString -> Int -> Int -> [Char] -> [Char]
unpackAppendCharsStrict ShortByteString
sbs Int
off Int
sz  [Char]
remainder
                      where remainder :: [Char]
remainder = Int -> Int -> [Char] -> [Char]
go (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sz) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sz) [Char]
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 :: ShortByteString -> Int -> Int -> [Char] -> [Char]
unpackAppendCharsStrict !ShortByteString
sbs Int
off Int
len [Char]
cs =
    Int -> Int -> [Char] -> [Char]
go (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) [Char]
cs
  where
    go :: Int -> Int -> [Char] -> [Char]
go !Int
sentinal !Int
i ![Char]
acc
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sentinal = [Char]
acc
      | Bool
otherwise     = let !c :: Char
c = BA -> Int -> Char
indexCharArray (ShortByteString -> BA
asBA ShortByteString
sbs) Int
i
                        in Int -> Int -> [Char] -> [Char]
go Int
sentinal (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
acc)