{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Base16.Internal.Head
( encodeBase16_
, decodeBase16_
, decodeBase16Typed_
, decodeBase16Lenient_
, encodeBase16Short_
, decodeBase16Short_
, decodeBase16ShortTyped_
, decodeBase16ShortLenient_
) where


import Data.Base16.Types.Internal (Base16(..))
import qualified Data.ByteString as BS (empty)
import Data.ByteString.Internal
import qualified Data.ByteString.Short as SBS (empty)
import Data.ByteString.Base16.Internal.Utils
import Data.ByteString.Base16.Internal.W16.Loop
import qualified Data.ByteString.Base16.Internal.W16.ShortLoop as Short
import Data.ByteString.Short.Internal (ShortByteString(..))
import Data.Primitive.ByteArray
import Data.Text (Text)

import Foreign.Ptr
import Foreign.ForeignPtr

import GHC.Exts
import GHC.ForeignPtr

import System.IO.Unsafe


-- | Head of the base16 encoding loop - marshal data, assemble loops
--
encodeBase16_ :: ByteString -> ByteString
encodeBase16_ :: ByteString -> ByteString
encodeBase16_ (PS ForeignPtr Word8
sfp Int
soff Int
slen) =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
dlen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
        Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
innerLoop
          Ptr Word8
dptr
          (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr forall a b. (a -> b) -> a -> b
$ Int
slen forall a. Num a => a -> a -> a
+ Int
soff)
  where
    !dlen :: Int
dlen = Int
2 forall a. Num a => a -> a -> a
* Int
slen
{-# INLINE encodeBase16_ #-}

decodeBase16_ :: ByteString -> Either Text ByteString
decodeBase16_ :: ByteString -> Either Text ByteString
decodeBase16_ (PS ForeignPtr Word8
sfp Int
soff Int
slen)
  | Int
slen forall a. Eq a => a -> a -> Bool
== Int
0 = forall a b. b -> Either a b
Right ByteString
BS.empty
  | Int
r forall a. Eq a => a -> a -> Bool
/= Int
0 = forall a b. a -> Either a b
Left Text
"invalid bytestring size"
  | Bool
otherwise = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
        ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO (Either Text ByteString)
decodeLoop
          ForeignPtr Word8
dfp
          Ptr Word8
dptr
          (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr forall a b. (a -> b) -> a -> b
$ Int
slen forall a. Num a => a -> a -> a
+ Int
soff)
          Int
q
  where
    !q :: Int
q = Int
slen forall a. Integral a => a -> a -> a
`quot` Int
2
    !r :: Int
r = Int
slen forall a. Integral a => a -> a -> a
`rem` Int
2
{-# INLINE decodeBase16_ #-}

decodeBase16Typed_ :: Base16 ByteString -> ByteString
decodeBase16Typed_ :: Base16 ByteString -> ByteString
decodeBase16Typed_ (Base16 (PS ForeignPtr Word8
sfp Int
soff Int
slen)) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
q forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
      Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
decodeLoopTyped
        Ptr Word8
dptr
        (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
        (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr forall a b. (a -> b) -> a -> b
$ Int
slen forall a. Num a => a -> a -> a
+ Int
soff)
  where
    !q :: Int
q = Int
slen forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16Typed_ #-}

decodeBase16Lenient_ :: ByteString -> ByteString
decodeBase16Lenient_ :: ByteString -> ByteString
decodeBase16Lenient_ (PS ForeignPtr Word8
sfp Int
soff Int
slen) =
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
        ForeignPtr Word8
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
lenientLoop
          ForeignPtr Word8
dfp
          Ptr Word8
dptr
          (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr forall a b. (a -> b) -> a -> b
$ Int
slen forall a. Num a => a -> a -> a
+ Int
soff)
          Int
0
  where
    !q :: Int
q = Int
slen forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16Lenient_ #-}

-- ---------------------------------------------------------------- --
-- Short encode/decode

encodeBase16Short_ :: ShortByteString -> ShortByteString
encodeBase16Short_ :: ShortByteString -> ShortByteString
encodeBase16Short_ (SBS !ByteArray#
ba#) = (forall s. ST s ByteArray) -> ShortByteString
runShortST forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
dst <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
l'
    forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s ()
Short.innerLoop Int
l MutableByteArray s
dst (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba#))
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
dst
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !l' :: Int
l' = Int
l forall a. Num a => a -> a -> a
* Int
2
{-# INLINE encodeBase16Short_ #-}

decodeBase16Short_ :: ShortByteString -> Either Text ShortByteString
decodeBase16Short_ :: ShortByteString -> Either Text ShortByteString
decodeBase16Short_ (SBS !ByteArray#
ba#)
    | Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = forall a b. b -> Either a b
Right ShortByteString
SBS.empty
    | Int
r forall a. Eq a => a -> a -> Bool
/= Int
0 = forall a b. a -> Either a b
Left Text
"invalid bytestring size"
    | Bool
otherwise = (forall s. ST s (Either Text ByteArray))
-> Either Text ShortByteString
runDecodeST forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
dst <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      forall s.
Int
-> MutableByteArray s
-> MutableByteArray s
-> ST s (Either Text ByteArray)
Short.decodeLoop Int
l MutableByteArray s
dst (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba#))
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l forall a. Integral a => a -> a -> a
`quot` Int
2
    !r :: Int
r = Int
l forall a. Integral a => a -> a -> a
`rem` Int
2
{-# INLINE decodeBase16Short_ #-}

decodeBase16ShortTyped_ :: Base16 ShortByteString -> ShortByteString
decodeBase16ShortTyped_ :: Base16 ShortByteString -> ShortByteString
decodeBase16ShortTyped_ (Base16 (SBS !ByteArray#
ba#)) = (forall s. ST s ByteArray) -> ShortByteString
runDecodeST' forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
dst <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
    forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s ByteArray
Short.decodeLoopTyped Int
l MutableByteArray s
dst (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba#))
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16ShortTyped_ #-}


decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString
decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString
decodeBase16ShortLenient_ (SBS !ByteArray#
ba#)
    | Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = ShortByteString
SBS.empty
    | Bool
otherwise = (forall s. ST s ByteArray) -> ShortByteString
runShortST forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
dst <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      Int
q' <- forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s Int
Short.lenientLoop Int
l MutableByteArray s
dst (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba#))
      !MutableByteArray s
_ <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> m (MutableByteArray (PrimState m))
resizeMutableByteArray MutableByteArray s
dst Int
q'
      forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
dst
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16ShortLenient_ #-}