{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE CPP           #-}
{-# LANGUAGE MagicHash     #-}
{-# LANGUAGE RankNTypes    #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Network.DNS.Pattern.Internal
-- Description : Internal DNS types and definitions
--
-- This module is not part of public API and may change even between patch versions.

module Network.DNS.Internal
  ( DomainLabel(..)
  , Domain(..)
  , DList(..)
  , toDList
  , fromDList
  , singleton
  , sbsMap
  , sbsSingleton
  , isLitChar
  , pprLabelUtf16
  , pprLabelUtf8
  , pprLabelsUtf16
  , pprLabelsUtf8
  , pprLabels
  )

where

import           Data.ByteString.Internal (c2w)
import qualified Data.ByteString.Short as SBS
import           Data.Foldable (foldl')
import           Data.Function (on)
import qualified Data.Text as T
import           GHC.Word
import           Data.ByteString.Short.Internal (ShortByteString(SBS))
import qualified Data.Text.Array as T
import qualified Data.Text.Internal as T
import           GHC.ST (ST(..), runST)
#if !MIN_VERSION_bytestring(0,11,3)
import           GHC.Exts (Int(..), Int#, MutableByteArray#, indexWord8Array#,
                           isTrue#, newByteArray#, unsafeFreezeByteArray#,
                           writeWord8Array#, (+#), (<#))

#else
import           GHC.Exts (Int(..), Int#, indexWord8Array#, isTrue#, (+#), (<#))
#endif

import           Network.DNS.Internal.Prim

isLitChar :: Word8 -> Bool
isLitChar :: Word8 -> Bool
isLitChar Word8
c = (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'a' Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'z')
           Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'0' Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'9')
           Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'A' Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'Z')
           Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'_')
           Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'-')


-- | Domain label with case-insensitive 'Eq' and 'Ord' as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343#section-3).
data DomainLabel = DomainLabel { DomainLabel -> ShortByteString
getDomainLabel_ :: !SBS.ShortByteString
                               , DomainLabel -> ShortByteString
getDomainLabelCF_ :: !SBS.ShortByteString }

-- | A domain parsed into labels. Each label is a 'SBS.ShortByteString' rather than 'T.Text' or 'String' because a label can contain arbitrary bytes.
-- However, the 'Ord' and 'Eq' instances do limited case-folding according to [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343#section-3).
newtype Domain = Domain [DomainLabel] deriving (Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
/= :: Domain -> Domain -> Bool
Eq, Eq Domain
Eq Domain =>
(Domain -> Domain -> Ordering)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Domain)
-> (Domain -> Domain -> Domain)
-> Ord Domain
Domain -> Domain -> Bool
Domain -> Domain -> Ordering
Domain -> Domain -> Domain
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Domain -> Domain -> Ordering
compare :: Domain -> Domain -> Ordering
$c< :: Domain -> Domain -> Bool
< :: Domain -> Domain -> Bool
$c<= :: Domain -> Domain -> Bool
<= :: Domain -> Domain -> Bool
$c> :: Domain -> Domain -> Bool
> :: Domain -> Domain -> Bool
$c>= :: Domain -> Domain -> Bool
>= :: Domain -> Domain -> Bool
$cmax :: Domain -> Domain -> Domain
max :: Domain -> Domain -> Domain
$cmin :: Domain -> Domain -> Domain
min :: Domain -> Domain -> Domain
Ord)

instance Ord DomainLabel where
  <= :: DomainLabel -> DomainLabel -> Bool
(<=) = ShortByteString -> ShortByteString -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
  compare :: DomainLabel -> DomainLabel -> Ordering
compare = ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ShortByteString -> ShortByteString -> Ordering)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_

instance Eq DomainLabel where
  == :: DomainLabel -> DomainLabel -> Bool
(==) = ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_

-- | Difference list à la Huhges
newtype DList a = DList ([a] -> [a])

-- | Turn a list into 'DList'
{-# INLINE toDList #-}
toDList :: [a] -> DList a
toDList :: forall a. [a] -> DList a
toDList = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> ([a] -> [a] -> [a]) -> [a] -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

-- | Turn 'DList' back into a list.
{-# INLINE fromDList #-}
fromDList :: DList a -> [a]
fromDList :: forall a. DList a -> [a]
fromDList (DList [a] -> [a]
dl) = [a] -> [a]
dl []

-- | Create a 'DList' containing just the specified element
{-# INLINE singleton #-}
singleton :: a -> DList a
singleton :: forall a. a -> DList a
singleton = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)

instance Semigroup (DList a) where
  {-# INLINE (<>) #-}
  DList [a] -> [a]
l <> :: DList a -> DList a -> DList a
<> DList [a] -> [a]
r = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList ([a] -> [a]
l ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
r)

instance Monoid (DList a) where
  {-# INLINE mempty #-}
  mempty :: DList a
mempty = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList [a] -> [a]
forall a. a -> a
id

{-# INLINE sbsSingleton #-}
sbsSingleton :: Word8 -> SBS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsSingleton :: Word8 -> ShortByteString
sbsSingleton = Word8 -> ShortByteString
SBS.singleton
#else
sbsSingleton (W8# w) = runST $ ST $ \s1 ->
  case newByteArray# 1# s1 of
    (# s2, mba #) -> case writeWord8Array# mba 0# w s2 of
          s3 -> case unsafeFreezeByteArray# mba s3 of
             (# s4, ma #) -> (# s4, SBS ma #)

#endif

sbsMap :: (Word8 -> Word8) -> SBS.ShortByteString -> SBS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsMap :: (Word8 -> Word8) -> ShortByteString -> ShortByteString
sbsMap = (Word8 -> Word8) -> ShortByteString -> ShortByteString
SBS.map
#else
sbsMap m sbs@(SBS ba) = runST $ ST $ \s1 ->
  case newByteArray# l# s1 of
    (# s2, mba #) -> case go mba 0# l# of
      ST f -> case f s2 of
        (# s3, _ #) -> case unsafeFreezeByteArray# mba s3 of
           (# s4, ma #) -> (# s4, SBS ma #)
  where
    !(I# l#) = SBS.length sbs
    go :: MutableByteArray# s -> Int# -> Int# -> ST s ()
    go !mba !i !l
      | I# i >= I# l = return ()
      | otherwise = (ST $ \s ->
          let !(W8# w') = m (W8# (indexWord8Array# ba i)) in
          (# writeWord8Array# mba i w' s, () #)
       ) >> go mba (i +# 1#) l
#endif

pprLabels :: [SBS.ShortByteString] -> T.Text
#if MIN_VERSION_text(2,0,0)
pprLabels :: [ShortByteString] -> Text
pprLabels [ShortByteString]
xs = let !(# Int
codePoints, SBS ByteArray#
ba #) = [ShortByteString] -> (# Int, ShortByteString #)
pprLabelsUtf8' [ShortByteString]
xs
               in Array -> Int -> Int -> Text
T.text (ByteArray# -> Array
T.ByteArray ByteArray#
ba) Int
0 Int
codePoints
#else
pprLabels xs = let !(# codePoints, SBS ba #) = pprLabelsUtf16' xs
               in T.text (T.Array ba) 0 codePoints
#endif


pprLabelsUtf8 :: [SBS.ShortByteString] -> SBS.ShortByteString
pprLabelsUtf8 :: [ShortByteString] -> ShortByteString
pprLabelsUtf8 [ShortByteString]
xs = case [ShortByteString] -> (# Int, ShortByteString #)
pprLabelsUtf8' [ShortByteString]
xs of
  (# Int
_, ShortByteString
out #) -> ShortByteString
out

pprLabelsUtf8' :: [SBS.ShortByteString] -> (# Int, SBS.ShortByteString #)
pprLabelsUtf8' :: [ShortByteString] -> (# Int, ShortByteString #)
pprLabelsUtf8' xs :: [ShortByteString]
xs@(ShortByteString
_:[ShortByteString]
_) = (# Int
codePoints, Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
forall a. Int -> (forall s. MBA s -> ST s a) -> ShortByteString
createSBS Int
codePoints ([ShortByteString] -> Int# -> MBA s -> ST s ()
forall {s}. [ShortByteString] -> Int# -> MBA s -> ST s ()
go [ShortByteString]
xs Int#
0#) #)
  where
    -- We adjust for an extra codepoint to account per label for the dot separators.
    -- The case of root zone domain names (empty list, pretty-prints to ".") is handled
    -- in a separate `domainEncoderUtf8` definition below.
    codePoints :: Int
codePoints = (Int -> ShortByteString -> Int) -> Int -> [ShortByteString] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a ShortByteString
x -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortByteString -> Int
labelUnicodeCodepoints ShortByteString
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 [ShortByteString]
xs

    go :: [ShortByteString] -> Int# -> MBA s -> ST s ()
go (ShortByteString
a:[ShortByteString]
as) Int#
off MBA s
mba  = do I# Int#
off' <- ShortByteString -> Int# -> MBA s -> ST s Int
forall s. ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf8 ShortByteString
a Int#
off MBA s
mba
                            MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba Int#
off' (Char -> Word8
c2w Char
'.')
                            [ShortByteString] -> Int# -> MBA s -> ST s ()
go [ShortByteString]
as (Int#
off' Int# -> Int# -> Int#
+# Int#
1#) MBA s
mba

    go []    Int#
_off MBA s
_mba = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pprLabelsUtf8' [] = (# Int
1, [Word8] -> ShortByteString
SBS.pack [Char -> Word8
c2w Char
'.'] #)

pprLabelsUtf16 :: [SBS.ShortByteString] -> SBS.ShortByteString
pprLabelsUtf16 :: [ShortByteString] -> ShortByteString
pprLabelsUtf16 [ShortByteString]
xs = case [ShortByteString] -> (# Int, ShortByteString #)
pprLabelsUtf16' [ShortByteString]
xs of
  (# Int
_, ShortByteString
out #) -> ShortByteString
out

pprLabelsUtf16' :: [SBS.ShortByteString] -> (# Int, SBS.ShortByteString #)
pprLabelsUtf16' :: [ShortByteString] -> (# Int, ShortByteString #)
pprLabelsUtf16' xs :: [ShortByteString]
xs@(ShortByteString
_:[ShortByteString]
_) = (# Int
codePoints, Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
forall a. Int -> (forall s. MBA s -> ST s a) -> ShortByteString
createSBS (Int
codePoints Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) ([ShortByteString] -> Int# -> MBA s -> ST s ()
forall {s}. [ShortByteString] -> Int# -> MBA s -> ST s ()
go [ShortByteString]
xs Int#
0#) #)
  where
    -- We adjust for an extra codepoint to account per label for the dot separators.
    -- The case of root zone domain names (empty list, pretty-prints to ".") is handled
    -- in a separate `domainEncoderUtf16` definition below.
    codePoints :: Int
codePoints = (Int -> ShortByteString -> Int) -> Int -> [ShortByteString] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a ShortByteString
x -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortByteString -> Int
labelUnicodeCodepoints ShortByteString
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 [ShortByteString]
xs

    go :: [ShortByteString] -> Int# -> MBA s -> ST s ()
go (ShortByteString
a:[ShortByteString]
as) Int#
off MBA s
mba  = do I# Int#
off' <- ShortByteString -> Int# -> MBA s -> ST s Int
forall s. ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf16 ShortByteString
a Int#
off MBA s
mba
                            MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba Int#
off' (Char -> Word8
c2w Char
'.')
                            [ShortByteString] -> Int# -> MBA s -> ST s ()
go [ShortByteString]
as (Int#
off' Int# -> Int# -> Int#
+# Int#
2#) MBA s
mba

    go []    Int#
_off MBA s
_mba = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pprLabelsUtf16' [] = (# Int
1, [Word8] -> ShortByteString
SBS.pack [Char -> Word8
c2w Char
'.'] #)

createSBS :: Int -> (forall s. MBA s -> ST s a) -> SBS.ShortByteString
createSBS :: forall a. Int -> (forall s. MBA s -> ST s a) -> ShortByteString
createSBS Int
len forall s. MBA s -> ST s a
fill = (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
  MBA s
mba <- Int -> ST s (MBA s)
forall s. Int -> ST s (MBA s)
newByteArray Int
len
  a
_ <- MBA s -> ST s a
forall s. MBA s -> ST s a
fill MBA s
mba
  BA# ByteArray#
ba# <- MBA s -> ST s BA
forall s. MBA s -> ST s BA
unsafeFreezeByteArray MBA s
mba
  ShortByteString -> ST s ShortByteString
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)

pprLabelUtf8 :: SBS.ShortByteString -> SBS.ShortByteString
pprLabelUtf8 :: ShortByteString -> ShortByteString
pprLabelUtf8 ShortByteString
bs = Int -> (forall s. MBA s -> ST s Int) -> ShortByteString
forall a. Int -> (forall s. MBA s -> ST s a) -> ShortByteString
createSBS (ShortByteString -> Int
labelUnicodeCodepoints ShortByteString
bs) (ShortByteString -> Int# -> MBA s -> ST s Int
forall s. ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf8 ShortByteString
bs Int#
0#)

pprLabelUtf16 :: SBS.ShortByteString -> SBS.ShortByteString
pprLabelUtf16 :: ShortByteString -> ShortByteString
pprLabelUtf16 ShortByteString
bs = Int -> (forall s. MBA s -> ST s Int) -> ShortByteString
forall a. Int -> (forall s. MBA s -> ST s a) -> ShortByteString
createSBS (ShortByteString -> Int
labelUnicodeCodepoints ShortByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (ShortByteString -> Int# -> MBA s -> ST s Int
forall s. ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf16 ShortByteString
bs Int#
0#)

labelUnicodeCodepoints :: SBS.ShortByteString -> Int
labelUnicodeCodepoints :: ShortByteString -> Int
labelUnicodeCodepoints sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) = Int# -> Int
go Int#
0#
  where
    !(I# Int#
len) = ShortByteString -> Int
SBS.length ShortByteString
sbs
    go :: Int# -> Int
go Int#
i# | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# Int#
len) =
            let a :: Word8
a = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
i#)
             in case () of
                       ()
_ | Word8 -> Bool
isLitChar Word8
a    -> Int# -> Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#)
                         -- We escape backslashes with a backslash
                         | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\'  -> Int# -> Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
2#)

                         -- We escape dots with a backslash
                         | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'.'   -> Int# -> Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
2#)

                         -- Everything else gets octal encoded (three octals) and a backslash
                         | Bool
otherwise      -> Int# -> Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
4#)
    go Int#
i = Int# -> Int
I# Int#
i

-- Create an ST action to write to a mutable byte array, starting at some offset. Returns
-- the new offset where we can resume writing to.
labelWriterUtf8 :: SBS.ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf8 :: forall s. ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf8 sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) Int#
off' MBA s
mba = Int# -> Int# -> ST s Int
go Int#
0# Int#
off'
  where
    !(I# Int#
len) = ShortByteString -> Int
SBS.length ShortByteString
sbs

    go :: Int# -> Int# -> ST s Int
go Int#
i# Int#
off | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# Int#
len)
           = let a :: Word8
a = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
i#)
             in case () of
                       ()
_ | Word8 -> Bool
isLitChar Word8
a
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off) Word8
a
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
1#)

                         | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\'
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off)       (Char -> Word8
c2w Char
'\\')
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
1#) (Char -> Word8
c2w Char
'\\')
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
2#)

                         | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'.'
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off)       (Char -> Word8
c2w Char
'\\')
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
1#) (Char -> Word8
c2w Char
'.')
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
2#)

                         | Bool
otherwise
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off)       (Char -> Word8
c2w Char
'\\')
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
1#) (Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
o1)
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
2#) (Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
o2)
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
3#) (Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
o3)
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
4#)
                           where
                            (# Word8
o1, Word8
o2, Word8
o3 #) = case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
a Word8
8 of
                                (Word8
v1, Word8
r3) -> case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
v1 Word8
8 of
                                    (Word8
v2, Word8
r2) -> case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
v2 Word8
8 of
                                      (Word8
_, Word8
r1) -> (# Word8
r1, Word8
r2, Word8
r3 #)
           | Bool
otherwise
           = Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int
I# Int#
off)


-- Create an ST action to write to a mutable byte array, starting at some offset. Returns
-- the new offset where we can resume writing to.
labelWriterUtf16 :: SBS.ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf16 :: forall s. ShortByteString -> Int# -> MBA s -> ST s Int
labelWriterUtf16 sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) Int#
off' MBA s
mba = Int# -> Int# -> ST s Int
go Int#
0# Int#
off'
  where
    !(I# Int#
len) = ShortByteString -> Int
SBS.length ShortByteString
sbs

    go :: Int# -> Int# -> ST s Int
go Int#
i# Int#
off | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# Int#
len)
           = let a :: Word8
a = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
i#)
             in case () of
                       ()
_ | Word8 -> Bool
isLitChar Word8
a
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off) Word8
a
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
2#)

                         | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\'
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off)       (Char -> Word8
c2w Char
'\\')
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
2#) (Char -> Word8
c2w Char
'\\')
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
4#)

                         | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'.'
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off)       (Char -> Word8
c2w Char
'\\')
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
2#) (Char -> Word8
c2w Char
'.')
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
4#)

                         | Bool
otherwise
                         -> do MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off)       (Char -> Word8
c2w Char
'\\')
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
2#) (Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
o1)
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
4#) (Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
o2)
                               MBA s -> Int# -> Word8 -> ST s ()
forall s. MBA s -> Int# -> Word8 -> ST s ()
writeWord8Array0 MBA s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
6#) (Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
o3)
                               Int# -> Int# -> ST s Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) (Int#
off Int# -> Int# -> Int#
+# Int#
8#)
                           where
                            (# Word8
o1, Word8
o2, Word8
o3 #) = case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
a Word8
8 of
                                (Word8
v1, Word8
r3) -> case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
v1 Word8
8 of
                                    (Word8
v2, Word8
r2) -> case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
v2 Word8
8 of
                                      (Word8
_, Word8
r1) -> (# Word8
r1, Word8
r2, Word8
r3 #)
           | Bool
otherwise
           = Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int
I# Int#
off)