module Haste.Binary.Types (
Blob (..), BlobData (..),
blobSize, blobDataSize, toByteString, toBlob, strToBlob
) where
import Haste.Prim
import Haste.Foreign
import qualified Data.ByteString.Lazy as BS
#ifndef __HASTE__
import qualified Data.ByteString.UTF8 as BU
#else
import System.IO.Unsafe
#endif
#ifdef __HASTE__
data BlobData = BlobData Int Int JSAny
newtype Blob = Blob JSAny deriving (ToAny, FromAny)
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 . toAny
sliceBlob :: Blob -> Int -> Int -> Blob
sliceBlob b off len = unsafePerformIO $ jsSlice b off len
jsSlice :: Blob -> Int -> Int -> IO Blob
jsSlice = ffi "(function(b,off,len){return b.slice(off,len);})"
newBlob :: JSAny -> Blob
newBlob = unsafePerformIO . jsNewBlob
jsNewBlob :: JSAny -> 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
clientOnly :: a
clientOnly = error "ToAny/FromAny only usable client-side!"
instance ToAny BlobData where toAny = clientOnly
instance FromAny BlobData where fromAny = clientOnly
instance ToAny Blob where toAny = clientOnly
instance FromAny Blob where fromAny = clientOnly
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