module Haste.Binary.Types (
Blob (..), BlobData (..),
blobSize, blobDataSize, toByteString, toBlob, strToBlob
) where
import Haste.Prim
import Haste.Foreign
import System.IO.Unsafe
import qualified Data.ByteString.Lazy as BS
#ifndef __HASTE__
import qualified Data.ByteString.UTF8 as BU
#endif
#ifdef __HASTE__
data BlobData = BlobData Int Int Unpacked
newtype Blob = Blob Unpacked deriving (Pack, Unpack)
blobSize :: Blob -> Int
blobSize = unsafePerformIO . ffi "(function(b){return b.size;})"
blobDataSize :: BlobData -> Int
blobDataSize (BlobData _ len _) = len
toByteString :: BlobData -> BS.ByteString
toByteString =
error "Haste.Binary.Types.toByteString called in browser context!"
toBlob :: BlobData -> Blob
toBlob (BlobData 0 len buf) =
case newBlob buf of
b | blobSize b > len -> sliceBlob b 0 len
| otherwise -> b
toBlob (BlobData off len buf) =
sliceBlob (newBlob buf) off (off+len)
strToBlob :: JSString -> Blob
strToBlob = newBlob . unpack
sliceBlob :: Blob -> Int -> Int -> Blob
sliceBlob b off len = unsafePerformIO $ do
ffi "(function(b,off,len){return b.slice(off,len);})" b off len
newBlob :: Unpacked -> Blob
newBlob = unsafePerformIO . jsNewBlob
jsNewBlob :: Unpacked -> IO Blob
jsNewBlob =
ffi "(function(b){try {return new Blob([b]);} catch (e) {return new Blob([b.buffer]);}})"
#else
newtype BlobData = BlobData BS.ByteString
newtype Blob = Blob BS.ByteString
instance Pack BlobData
instance Unpack BlobData
instance Pack Blob
instance Unpack Blob
blobSize :: Blob -> Int
blobSize (Blob b) = fromIntegral $ BS.length b
blobDataSize :: BlobData -> Int
blobDataSize (BlobData bd) = fromIntegral $ BS.length bd
toByteString :: BlobData -> BS.ByteString
toByteString (BlobData bd) = bd
toBlob :: BlobData -> Blob
toBlob (BlobData bs) = Blob bs
strToBlob :: JSString -> Blob
strToBlob s = Blob $ BS.fromChunks [BU.fromString $ fromJSStr s]
#endif