{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Base16.Internal.W16.ShortLoop
( innerLoop
, decodeLoop
, decodeLoopTyped
, lenientLoop
) where


import Control.Monad.ST

import Data.Bits
import Data.ByteString.Base16.Internal.Utils
import Data.Primitive.ByteArray
import Data.Text (Text)
import qualified Data.Text as T


innerLoop
    :: Int
    -> MutableByteArray s
    -> MutableByteArray s
    -> ST s ()
innerLoop :: forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s ()
innerLoop !Int
slen !MutableByteArray s
dst !MutableByteArray s
src = Int -> Int -> ST s ()
forall {m :: * -> *}.
(PrimState m ~ s, PrimMonad m) =>
Int -> Int -> m ()
go (Int
0 :: Int) (Int
0 :: Int)
  where
    !hex :: Addr#
hex = Addr#
"0123456789abcdef"#

    go :: Int -> Int -> m ()
go !Int
doff !Int
soff
      | Int
soff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slen = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = do
        x <- MutableByteArray (PrimState m) -> Int -> m Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
src Int
soff
        writeByteArray dst doff (aix (unsafeShiftR x 4) hex)
        writeByteArray dst (doff + 1) (aix (x .&. 0x0f) hex)
        go (doff + 2) (soff + 1)
{-# inline innerLoop #-}

decodeLoop
    :: Int
    -> MutableByteArray s
    -> MutableByteArray s
    -> ST s (Either Text ByteArray)
decodeLoop :: forall s.
Int
-> MutableByteArray s
-> MutableByteArray s
-> ST s (Either Text ByteArray)
decodeLoop !Int
slen !MutableByteArray s
dst !MutableByteArray s
src = Int -> Int -> ST s (Either Text ByteArray)
forall {f :: * -> *}.
(PrimState f ~ s, PrimMonad f) =>
Int -> Int -> f (Either Text ByteArray)
go (Int
0 :: Int) (Int
0 :: Int)
  where
    err :: a -> m (Either Text b)
err a
i = Either Text b -> m (Either Text b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text b -> m (Either Text b))
-> ([Char] -> Either Text b) -> [Char] -> m (Either Text b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text b
forall a b. a -> Either a b
Left (Text -> Either Text b)
-> ([Char] -> Text) -> [Char] -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
      ([Char] -> m (Either Text b)) -> [Char] -> m (Either Text b)
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid character at offset: "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
i

    !lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

    !hi :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

    go :: Int -> Int -> f (Either Text ByteArray)
go !Int
doff !Int
soff
      | Int
soff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slen = ByteArray -> Either Text ByteArray
forall a b. b -> Either a b
Right (ByteArray -> Either Text ByteArray)
-> f ByteArray -> f (Either Text ByteArray)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState f) -> f ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState f)
dst
      | Bool
otherwise = do
        x <- MutableByteArray (PrimState f) -> Int -> f Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState f)
src Int
soff
        y <- readByteArray src (soff + 1)

        let !a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi
            !b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo

        if
          | a == 0xff -> err soff
          | b == 0xff -> err (soff + 1)
          | otherwise -> do
            writeByteArray dst doff (a .|. b)
            go (doff + 1) (soff + 2)
{-# inline decodeLoop #-}

decodeLoopTyped
    :: Int
    -> MutableByteArray s
    -> MutableByteArray s
    -> ST s ByteArray
decodeLoopTyped :: forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s ByteArray
decodeLoopTyped !Int
slen !MutableByteArray s
dst !MutableByteArray s
src = Int -> Int -> ST s ByteArray
forall {m :: * -> *}.
(PrimState m ~ s, PrimMonad m) =>
Int -> Int -> m ByteArray
go (Int
0 :: Int) (Int
0 :: Int)
  where
    !lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

    !hi :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

    go :: Int -> Int -> m ByteArray
go !Int
doff !Int
soff
      | Int
soff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slen = MutableByteArray (PrimState m) -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState m)
dst
      | Bool
otherwise = do
        x <- MutableByteArray (PrimState m) -> Int -> m Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
src Int
soff
        y <- readByteArray src (soff + 1)

        let !a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi
            !b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo

        writeByteArray dst doff (a .|. b)
        go (doff + 1) (soff + 2)
{-# inline decodeLoopTyped #-}


lenientLoop
    :: Int
    -> MutableByteArray s
    -> MutableByteArray s
    -> ST s Int
lenientLoop :: forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s Int
lenientLoop !Int
slen !MutableByteArray s
dst !MutableByteArray s
src = Int -> Int -> ST s Int
forall {m :: * -> *}.
(PrimState m ~ s, PrimMonad m) =>
Int -> Int -> m Int
goHi (Int
0 :: Int) (Int
0 :: Int)
  where
    !lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

    !hi :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

    goHi :: Int -> Int -> m Int
goHi !Int
doff !Int
soff
      | Int
soff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slen = Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
doff
      | Bool
otherwise = do
        x <- MutableByteArray (PrimState m) -> Int -> m Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
src Int
soff

        let !a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi

        if a == 0xff
        then goHi doff (soff + 1)
        else goLo doff (soff + 1) a

    goLo :: Int -> Int -> Word8 -> m Int
goLo !Int
doff !Int
soff !Word8
a
      | Int
soff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slen = Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
doff
      | Bool
otherwise = do
        y <- MutableByteArray (PrimState m) -> Int -> m Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
src Int
soff

        let !b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo

        if b == 0xff
        then goLo doff (soff + 1) a
        else do
          writeByteArray dst doff (a .|. b)
          goHi (doff + 1) (soff + 1)
{-# inline lenientLoop #-}