{-# 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 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
        Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
innerLoop
          Ptr Word8
dptr
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int -> Ptr Word8) -> Int -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
  where
    !dlen :: Int
dlen = Int
2 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
BS.empty
  | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Text -> Either Text ByteString
forall a b. a -> Either a b
Left Text
"invalid bytestring size"
  | Bool
otherwise = IO (Either Text ByteString) -> Either Text ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text ByteString) -> Either Text ByteString)
-> IO (Either Text ByteString) -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ do
    dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    withForeignPtr dfp $ \Ptr Word8
dptr ->
      ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Text ByteString))
-> IO (Either Text ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Either Text ByteString))
 -> IO (Either Text ByteString))
-> (Ptr Word8 -> IO (Either Text ByteString))
-> IO (Either Text ByteString)
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
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int -> Ptr Word8) -> Int -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
          Int
q
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
    !r :: Int
r = Int
slen Int -> Int -> Int
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 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
      Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
decodeLoopTyped
        Ptr Word8
dptr
        (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
        (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int -> Ptr Word8) -> Int -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
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) =
  IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    withForeignPtr dfp $ \Ptr Word8
dptr ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
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
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int -> Ptr Word8) -> Int -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
          Int
0
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
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 s. ST s ByteArray) -> ShortByteString)
-> (forall s. ST s ByteArray) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
    dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
l'
    Short.innerLoop l dst (MutableByteArray (unsafeCoerce# ba#))
    unsafeFreezeByteArray dst
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !l' :: Int
l' = Int
l Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ShortByteString -> Either Text ShortByteString
forall a b. b -> Either a b
Right ShortByteString
SBS.empty
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Text -> Either Text ShortByteString
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 s. ST s (Either Text ByteArray))
 -> Either Text ShortByteString)
-> (forall s. ST s (Either Text ByteArray))
-> Either Text ShortByteString
forall a b. (a -> b) -> a -> b
$ do
      dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      Short.decodeLoop l dst (MutableByteArray (unsafeCoerce# ba#))
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
    !r :: Int
r = Int
l Int -> Int -> Int
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 s. ST s ByteArray) -> ShortByteString)
-> (forall s. ST s ByteArray) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
    dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
    Short.decodeLoopTyped l dst (MutableByteArray (unsafeCoerce# ba#))
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16ShortTyped_ #-}


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