{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Base16.Internal.W16.ShortLoop
( innerLoop
, decodeLoop
, 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 :: Int -> MutableByteArray s -> MutableByteArray s -> ST s ()
innerLoop !Int
slen !MutableByteArray s
dst !MutableByteArray s
src = Int -> Int -> ST s ()
go (0 :: Int) (0 :: Int)
  where
    !hex :: Addr#
hex = "0123456789abcdef"#

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

decodeLoop
    :: Int
    -> MutableByteArray s
    -> MutableByteArray s
    -> ST s (Either Text ByteArray)
decodeLoop :: 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)
go (0 :: Int) (0 :: Int)
  where
    err :: a -> m (Either Text b)
err i :: a
i = Either Text b -> m (Either Text b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text b -> m (Either Text b))
-> (String -> Either Text b) -> String -> 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)
-> (String -> Text) -> String -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      (String -> m (Either Text b)) -> String -> m (Either Text b)
forall a b. (a -> b) -> a -> b
$ "invalid character at offset: "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i

    !lo :: Addr#
lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 -> ST s (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)
-> ST s ByteArray -> ST s (Either Text ByteArray)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst
      | Bool
otherwise = do
        Word8
x <- MutableByteArray (PrimState (ST s)) -> Int -> ST s Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
src Int
soff
        Word8
y <- MutableByteArray (PrimState (ST s)) -> Int -> ST s Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
src (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)

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

        if
          | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff -> Int -> ST s (Either Text ByteArray)
forall (m :: * -> *) a b.
(Monad m, Show a) =>
a -> m (Either Text b)
err Int
soff
          | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff -> Int -> ST s (Either Text ByteArray)
forall (m :: * -> *) a b.
(Monad m, Show a) =>
a -> m (Either Text b)
err (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
          | Bool
otherwise -> do
            MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
doff (Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b)
            Int -> Int -> ST s (Either Text ByteArray)
go (Int
doff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
{-# inline decodeLoop #-}

lenientLoop
    :: Int
    -> MutableByteArray s
    -> MutableByteArray s
    -> ST s Int
lenientLoop :: Int -> MutableByteArray s -> MutableByteArray s -> ST s Int
lenientLoop !Int
slen !MutableByteArray s
dst !MutableByteArray s
src = Int -> Int -> ST s Int
goHi (0 :: Int) (0 :: Int)
  where
    !lo :: Addr#
lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 -> ST s Int
goHi !Int
doff !Int
soff
      | Int
soff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slen = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
doff
      | Bool
otherwise = do
        Word8
x <- MutableByteArray (PrimState (ST s)) -> Int -> ST s Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
src Int
soff

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

        if Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff
        then Int -> Int -> ST s Int
goHi Int
doff (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
        else Int -> Int -> Word8 -> ST s Int
goLo Int
doff (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Word8
a

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

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

        if Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff
        then Int -> Int -> Word8 -> ST s Int
goLo Int
doff (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Word8
a
        else do
          MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
doff (Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b)
          Int -> Int -> ST s Int
goHi (Int
doff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
{-# inline lenientLoop #-}