{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Codec.CBOR.ByteArray
(
ByteArray(..)
, sizeofByteArray
, fromShortByteString
, toShortByteString
, fromByteString
, toBuilder
, toSliced
) where
import Data.Char (ord)
import Data.Word
import GHC.Exts (IsList(..), IsString(..))
import qualified Data.Primitive.ByteArray as Prim
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as BSS
import qualified Data.ByteString.Short.Internal as BSS
import qualified Data.ByteString.Builder as BSB
import qualified Codec.CBOR.ByteArray.Sliced as Sliced
import Codec.CBOR.ByteArray.Internal
newtype ByteArray = BA {unBA :: Prim.ByteArray}
sizeofByteArray :: ByteArray -> Int
{-# INLINE sizeofByteArray #-}
sizeofByteArray (BA ba) = Prim.sizeofByteArray ba
fromShortByteString :: BSS.ShortByteString -> ByteArray
fromShortByteString (BSS.SBS ba) = BA (Prim.ByteArray ba)
toShortByteString :: ByteArray -> BSS.ShortByteString
toShortByteString (BA (Prim.ByteArray ba)) = BSS.SBS ba
fromByteString :: BS.ByteString -> ByteArray
fromByteString = fromShortByteString . BSS.toShort
toBuilder :: ByteArray -> BSB.Builder
toBuilder = Sliced.toBuilder . toSliced
toSliced :: ByteArray -> Sliced.SlicedByteArray
toSliced ba@(BA arr) = Sliced.SBA arr 0 (sizeofByteArray ba)
instance Show ByteArray where
showsPrec _ = shows . toSliced
instance Eq ByteArray where
ba1 == ba2 = toSliced ba1 == toSliced ba2
instance Ord ByteArray where
ba1 `compare` ba2 = toSliced ba1 `compare` toSliced ba2
instance IsString ByteArray where
fromString = fromList . map checkedOrd
where
checkedOrd c
| c > '\xff' = error "IsString(Codec.CBOR.ByteArray): Non-ASCII character"
| otherwise = fromIntegral $ ord c
instance IsList ByteArray where
type Item ByteArray = Word8
fromList xs = fromListN (Prelude.length xs) xs
fromListN n xs =
let arr = mkByteArray n xs
in BA arr
toList ba@(BA arr) =
foldrByteArray (:) [] 0 (sizeofByteArray ba) arr