module Bytezap.Poke.Json where
import Data.Word
import Data.Text.Internal qualified as T
import Data.Text.Array qualified as A
import Bytezap.Poke.Derived ( unsafePokeIndexed )
import Bytezap.Poke
import GHC.Exts
import Foreign.C.Types ( CChar )
import GHC.Word
escapedLength8 :: T.Text -> Int
escapedLength8 :: Text -> Int
escapedLength8 (T.Text Array
arr Int
off Int
len) = Int -> Int -> Int
go Int
off Int
0
where
go :: Int -> Int -> Int
go !Int
i Int
escLen
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iend = Int
escLen
| Bool
otherwise = Int -> Int -> Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
escapeW8 (Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i))
iend :: Int
iend = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
escapeW8 :: Word8 -> Int
escapeW8 :: Word8 -> Int
escapeW8 Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 = Int
1
| Bool
otherwise = case Word8
w of Word8
0x5C -> Int
2
Word8
0x22 -> Int
2
Word8
0x0A -> Int
2
Word8
0x0D -> Int
2
Word8
0x09 -> Int
2
Word8
_ -> if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x20 then Int
6 else Int
1
pokeEscapedTextUnquoted :: T.Text -> Poke s
pokeEscapedTextUnquoted :: forall s. Text -> Poke s
pokeEscapedTextUnquoted (T.Text Array
arr Int
off Int
len) =
(Int -> Poke s) -> Int -> Int -> Poke s
forall s. (Int -> Poke s) -> Int -> Int -> Poke s
unsafePokeIndexed (Word8 -> Poke s
forall s. Word8 -> Poke s
pokeEscapeW8 (Word8 -> Poke s) -> (Int -> Word8) -> Int -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Int -> Word8
A.unsafeIndex Array
arr) Int
off Int
len
pokeEscapeW8 :: Word8 -> Poke s
pokeEscapeW8 :: forall s. Word8 -> Poke s
pokeEscapeW8 Word8
w
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 = Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
w
| Bool
otherwise =
case Word8
w of
Word8
0x5C -> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C
Word8
0x22 -> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x22
Word8
0x0A -> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x6E
Word8
0x0D -> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x72
Word8
0x09 -> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x74
Word8
_ ->
if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x20 then Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
w else Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x5C Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x75 Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x30 Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8 Word8
0x30 Poke s -> Poke s -> Poke s
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poke s
forall s. Word8 -> Poke s
w8AsciiHex Word8
w
where w8 :: Word8 -> Poke s
w8 = forall a s. Prim' a => a -> Poke s
prim @Word8
w8AsciiHex :: Word8 -> Poke s
w8AsciiHex :: forall s. Word8 -> Poke s
w8AsciiHex Word8
w = Word16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word16# -> Word16
W16# (Addr# -> Int# -> Word16#
indexWord16OffAddr# Addr#
c_lower_hex_table# Int#
wI))
where
!(I# Int#
wI) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
!(Ptr Addr#
c_lower_hex_table#) = Ptr CChar
c_lower_hex_table
foreign import ccall safe "&hs_bytestring_lower_hex_table"
c_lower_hex_table :: Ptr CChar