{-# 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
  , pprLabelsUtf16
  )

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#, MutableByteArray#, indexWord8Array#,
                           isTrue#, newByteArray#, unsafeFreezeByteArray#,
                           writeWord8Array#, (+#), (<#))
#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
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: 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
min :: Domain -> Domain -> Domain
$cmin :: Domain -> Domain -> Domain
max :: Domain -> Domain -> Domain
$cmax :: Domain -> Domain -> Domain
>= :: Domain -> Domain -> Bool
$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
compare :: Domain -> Domain -> Ordering
$ccompare :: Domain -> Domain -> Ordering
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 = SBS.singleton
#else
sbsSingleton :: Word8 -> ShortByteString
sbsSingleton (W8# Word#
w) = (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
$ STRep s ShortByteString -> ST s ShortByteString
forall s a. STRep s a -> ST s a
ST (STRep s ShortByteString -> ST s ShortByteString)
-> STRep s ShortByteString -> ST s ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
  case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
1# State# s
s1 of
    (# State# s
s2, MutableByteArray# s
mba #) -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
0# Word#
w State# s
s2 of
          State# s
s3 -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s3 of
             (# State# s
s4, ByteArray#
ma #) -> (# State# s
s4, ByteArray# -> ShortByteString
SBS ByteArray#
ma #)

#endif

sbsMap :: (Word8 -> Word8) -> SBS.ShortByteString -> SBS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsMap = SBS.map
#else
sbsMap :: (Word8 -> Word8) -> ShortByteString -> ShortByteString
sbsMap Word8 -> Word8
m sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) = (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
$ STRep s ShortByteString -> ST s ShortByteString
forall s a. STRep s a -> ST s a
ST (STRep s ShortByteString -> ST s ShortByteString)
-> STRep s ShortByteString -> ST s ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
  case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
l# State# s
s1 of
    (# State# s
s2, MutableByteArray# s
mba #) -> case MutableByteArray# s -> Int# -> Int# -> ST s ()
forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go MutableByteArray# s
mba Int#
0# Int#
l# of
      ST STRep s ()
f -> case STRep s ()
f State# s
s2 of
        (# State# s
s3, ()
_ #) -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s3 of
           (# State# s
s4, ByteArray#
ma #) -> (# State# s
s4, ByteArray# -> ShortByteString
SBS ByteArray#
ma #)
  where
    !(I# Int#
l#) = ShortByteString -> Int
SBS.length ShortByteString
sbs
    go :: MutableByteArray# s -> Int# -> Int# -> ST s ()
    go :: forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go !MutableByteArray# s
mba !Int#
i !Int#
l
      | Int# -> Int
I# Int#
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int# -> Int
I# Int#
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = (STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
          let !(W8# Word#
w') = Word8 -> Word8
m (Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba Int#
i)) in
          (# MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
i Word#
w' State# s
s, () #)
       ) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableByteArray# s -> Int# -> Int# -> ST s ()
forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go MutableByteArray# s
mba (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Int#
l
#endif

pprLabelsUtf16 :: [SBS.ShortByteString] -> T.Text
pprLabelsUtf16 :: [ShortByteString] -> Text
pprLabelsUtf16 xs :: [ShortByteString]
xs@(ShortByteString
_:[ShortByteString]
_) = let SBS ByteArray#
ba = 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#)
                           in Array -> Int -> Int -> Text
T.text (ByteArray# -> Array
T.Array ByteArray#
ba) Int
0 Int
codePoints
  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 (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
pprLabelCodepoints 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
pprLabelsUtf16 [] = String -> Text
T.pack String
"."

domainEncoderUtf16 :: [a] -> ShortByteString
domainEncoderUtf16 :: forall a. [a] -> ShortByteString
domainEncoderUtf16 [] = [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
  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 (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)

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
pprLabelCodepoints 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#)

pprLabelCodepoints :: SBS.ShortByteString -> Int
pprLabelCodepoints :: ShortByteString -> Int
pprLabelCodepoints 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 = Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba Int#
i#)
             in case () of
                       ()
_ | Word8 -> Bool
isLitChar Word8
a    -> Int# -> Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
1#)
                         | 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#)
                         | 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#)
                         | Bool
otherwise      -> Int# -> Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
3#)
    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.
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 = Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int
I# Int#
off)