{- | Safe, if silly, byte representation for use at the type level.

'Word8' is a special type that GHC doesn't (and I think can't) promote to the
type level. We only have 'Natural's, which are unbounded. So we define a safe,
promotable representation, to allow us to prove well-sizedness at compile time.
Then we provide a bunch of type families and reifying typeclasses to enable
going between "similar" kinds ('Natural') and types ('Word8', 'B.ByteString')
respectively.

Type-level functionality is stored in 'Binrep.Type.Byte.TypeLevel' because the
definitions are even sillier than the ones here.

Do not use this on the term level. That would be _extremely_ silly.
-}

{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}

module Binrep.Type.Byte where

import Mason.Builder qualified as Mason
import Data.ByteString.Builder.Prim.Internal qualified as BI
import Binrep.Util ( natVal'' )
import Binrep.Put ( Builder )
import GHC.TypeNats
import GHC.Exts

-- Needs to be a function type to work. Interesting. It's perhaps not an
-- improvement on regular boxed. But interesting idea, so sticking with it.
class ByteVal (n :: Natural) where byteVal :: Proxy# n -> Word8#

instance ByteVal 0x00 where
    byteVal :: Proxy# 0 -> Word8#
byteVal Proxy# 0
_ = Word# -> Word8#
wordToWord8# Word#
0x00##
    {-# INLINE byteVal #-}
instance ByteVal 0x01 where
    byteVal :: Proxy# 1 -> Word8#
byteVal Proxy# 1
_ = Word# -> Word8#
wordToWord8# Word#
0x01##
    {-# INLINE byteVal #-}
instance ByteVal 0x02 where
    byteVal :: Proxy# 2 -> Word8#
byteVal Proxy# 2
_ = Word# -> Word8#
wordToWord8# Word#
0x02##
    {-# INLINE byteVal #-}
instance ByteVal 0x03 where
    byteVal :: Proxy# 3 -> Word8#
byteVal Proxy# 3
_ = Word# -> Word8#
wordToWord8# Word#
0x03##
    {-# INLINE byteVal #-}
instance ByteVal 0x04 where
    byteVal :: Proxy# 4 -> Word8#
byteVal Proxy# 4
_ = Word# -> Word8#
wordToWord8# Word#
0x04##
    {-# INLINE byteVal #-}
instance ByteVal 0x05 where
    byteVal :: Proxy# 5 -> Word8#
byteVal Proxy# 5
_ = Word# -> Word8#
wordToWord8# Word#
0x05##
    {-# INLINE byteVal #-}
instance ByteVal 0x06 where
    byteVal :: Proxy# 6 -> Word8#
byteVal Proxy# 6
_ = Word# -> Word8#
wordToWord8# Word#
0x06##
    {-# INLINE byteVal #-}
instance ByteVal 0x07 where
    byteVal :: Proxy# 7 -> Word8#
byteVal Proxy# 7
_ = Word# -> Word8#
wordToWord8# Word#
0x07##
    {-# INLINE byteVal #-}
instance ByteVal 0x08 where
    byteVal :: Proxy# 8 -> Word8#
byteVal Proxy# 8
_ = Word# -> Word8#
wordToWord8# Word#
0x08##
    {-# INLINE byteVal #-}
instance ByteVal 0x09 where
    byteVal :: Proxy# 9 -> Word8#
byteVal Proxy# 9
_ = Word# -> Word8#
wordToWord8# Word#
0x09##
    {-# INLINE byteVal #-}
instance ByteVal 0x0a where
    byteVal :: Proxy# 10 -> Word8#
byteVal Proxy# 10
_ = Word# -> Word8#
wordToWord8# Word#
0x0a##
    {-# INLINE byteVal #-}
instance ByteVal 0x0b where
    byteVal :: Proxy# 11 -> Word8#
byteVal Proxy# 11
_ = Word# -> Word8#
wordToWord8# Word#
0x0b##
    {-# INLINE byteVal #-}
instance ByteVal 0x0c where
    byteVal :: Proxy# 12 -> Word8#
byteVal Proxy# 12
_ = Word# -> Word8#
wordToWord8# Word#
0x0c##
    {-# INLINE byteVal #-}
instance ByteVal 0x0d where
    byteVal :: Proxy# 13 -> Word8#
byteVal Proxy# 13
_ = Word# -> Word8#
wordToWord8# Word#
0x0d##
    {-# INLINE byteVal #-}
instance ByteVal 0x0e where
    byteVal :: Proxy# 14 -> Word8#
byteVal Proxy# 14
_ = Word# -> Word8#
wordToWord8# Word#
0x0e##
    {-# INLINE byteVal #-}
instance ByteVal 0x0f where
    byteVal :: Proxy# 15 -> Word8#
byteVal Proxy# 15
_ = Word# -> Word8#
wordToWord8# Word#
0x0f##
    {-# INLINE byteVal #-}
instance ByteVal 0x10 where
    byteVal :: Proxy# 16 -> Word8#
byteVal Proxy# 16
_ = Word# -> Word8#
wordToWord8# Word#
0x10##
    {-# INLINE byteVal #-}
instance ByteVal 0x11 where
    byteVal :: Proxy# 17 -> Word8#
byteVal Proxy# 17
_ = Word# -> Word8#
wordToWord8# Word#
0x11##
    {-# INLINE byteVal #-}
instance ByteVal 0x12 where
    byteVal :: Proxy# 18 -> Word8#
byteVal Proxy# 18
_ = Word# -> Word8#
wordToWord8# Word#
0x12##
    {-# INLINE byteVal #-}
instance ByteVal 0x13 where
    byteVal :: Proxy# 19 -> Word8#
byteVal Proxy# 19
_ = Word# -> Word8#
wordToWord8# Word#
0x13##
    {-# INLINE byteVal #-}
instance ByteVal 0x14 where
    byteVal :: Proxy# 20 -> Word8#
byteVal Proxy# 20
_ = Word# -> Word8#
wordToWord8# Word#
0x14##
    {-# INLINE byteVal #-}
instance ByteVal 0x15 where
    byteVal :: Proxy# 21 -> Word8#
byteVal Proxy# 21
_ = Word# -> Word8#
wordToWord8# Word#
0x15##
    {-# INLINE byteVal #-}
instance ByteVal 0x16 where
    byteVal :: Proxy# 22 -> Word8#
byteVal Proxy# 22
_ = Word# -> Word8#
wordToWord8# Word#
0x16##
    {-# INLINE byteVal #-}
instance ByteVal 0x17 where
    byteVal :: Proxy# 23 -> Word8#
byteVal Proxy# 23
_ = Word# -> Word8#
wordToWord8# Word#
0x17##
    {-# INLINE byteVal #-}
instance ByteVal 0x18 where
    byteVal :: Proxy# 24 -> Word8#
byteVal Proxy# 24
_ = Word# -> Word8#
wordToWord8# Word#
0x18##
    {-# INLINE byteVal #-}
instance ByteVal 0x19 where
    byteVal :: Proxy# 25 -> Word8#
byteVal Proxy# 25
_ = Word# -> Word8#
wordToWord8# Word#
0x19##
    {-# INLINE byteVal #-}
instance ByteVal 0x1a where
    byteVal :: Proxy# 26 -> Word8#
byteVal Proxy# 26
_ = Word# -> Word8#
wordToWord8# Word#
0x1a##
    {-# INLINE byteVal #-}
instance ByteVal 0x1b where
    byteVal :: Proxy# 27 -> Word8#
byteVal Proxy# 27
_ = Word# -> Word8#
wordToWord8# Word#
0x1b##
    {-# INLINE byteVal #-}
instance ByteVal 0x1c where
    byteVal :: Proxy# 28 -> Word8#
byteVal Proxy# 28
_ = Word# -> Word8#
wordToWord8# Word#
0x1c##
    {-# INLINE byteVal #-}
instance ByteVal 0x1d where
    byteVal :: Proxy# 29 -> Word8#
byteVal Proxy# 29
_ = Word# -> Word8#
wordToWord8# Word#
0x1d##
    {-# INLINE byteVal #-}
instance ByteVal 0x1e where
    byteVal :: Proxy# 30 -> Word8#
byteVal Proxy# 30
_ = Word# -> Word8#
wordToWord8# Word#
0x1e##
    {-# INLINE byteVal #-}
instance ByteVal 0x1f where
    byteVal :: Proxy# 31 -> Word8#
byteVal Proxy# 31
_ = Word# -> Word8#
wordToWord8# Word#
0x1f##
    {-# INLINE byteVal #-}
instance ByteVal 0x20 where
    byteVal :: Proxy# 32 -> Word8#
byteVal Proxy# 32
_ = Word# -> Word8#
wordToWord8# Word#
0x20##
    {-# INLINE byteVal #-}
instance ByteVal 0x21 where
    byteVal :: Proxy# 33 -> Word8#
byteVal Proxy# 33
_ = Word# -> Word8#
wordToWord8# Word#
0x21##
    {-# INLINE byteVal #-}
instance ByteVal 0x22 where
    byteVal :: Proxy# 34 -> Word8#
byteVal Proxy# 34
_ = Word# -> Word8#
wordToWord8# Word#
0x22##
    {-# INLINE byteVal #-}
instance ByteVal 0x23 where
    byteVal :: Proxy# 35 -> Word8#
byteVal Proxy# 35
_ = Word# -> Word8#
wordToWord8# Word#
0x23##
    {-# INLINE byteVal #-}
instance ByteVal 0x24 where
    byteVal :: Proxy# 36 -> Word8#
byteVal Proxy# 36
_ = Word# -> Word8#
wordToWord8# Word#
0x24##
    {-# INLINE byteVal #-}
instance ByteVal 0x25 where
    byteVal :: Proxy# 37 -> Word8#
byteVal Proxy# 37
_ = Word# -> Word8#
wordToWord8# Word#
0x25##
    {-# INLINE byteVal #-}
instance ByteVal 0x26 where
    byteVal :: Proxy# 38 -> Word8#
byteVal Proxy# 38
_ = Word# -> Word8#
wordToWord8# Word#
0x26##
    {-# INLINE byteVal #-}
instance ByteVal 0x27 where
    byteVal :: Proxy# 39 -> Word8#
byteVal Proxy# 39
_ = Word# -> Word8#
wordToWord8# Word#
0x27##
    {-# INLINE byteVal #-}
instance ByteVal 0x28 where
    byteVal :: Proxy# 40 -> Word8#
byteVal Proxy# 40
_ = Word# -> Word8#
wordToWord8# Word#
0x28##
    {-# INLINE byteVal #-}
instance ByteVal 0x29 where
    byteVal :: Proxy# 41 -> Word8#
byteVal Proxy# 41
_ = Word# -> Word8#
wordToWord8# Word#
0x29##
    {-# INLINE byteVal #-}
instance ByteVal 0x2a where
    byteVal :: Proxy# 42 -> Word8#
byteVal Proxy# 42
_ = Word# -> Word8#
wordToWord8# Word#
0x2a##
    {-# INLINE byteVal #-}
instance ByteVal 0x2b where
    byteVal :: Proxy# 43 -> Word8#
byteVal Proxy# 43
_ = Word# -> Word8#
wordToWord8# Word#
0x2b##
    {-# INLINE byteVal #-}
instance ByteVal 0x2c where
    byteVal :: Proxy# 44 -> Word8#
byteVal Proxy# 44
_ = Word# -> Word8#
wordToWord8# Word#
0x2c##
    {-# INLINE byteVal #-}
instance ByteVal 0x2d where
    byteVal :: Proxy# 45 -> Word8#
byteVal Proxy# 45
_ = Word# -> Word8#
wordToWord8# Word#
0x2d##
    {-# INLINE byteVal #-}
instance ByteVal 0x2e where
    byteVal :: Proxy# 46 -> Word8#
byteVal Proxy# 46
_ = Word# -> Word8#
wordToWord8# Word#
0x2e##
    {-# INLINE byteVal #-}
instance ByteVal 0x2f where
    byteVal :: Proxy# 47 -> Word8#
byteVal Proxy# 47
_ = Word# -> Word8#
wordToWord8# Word#
0x2f##
    {-# INLINE byteVal #-}
instance ByteVal 0x30 where
    byteVal :: Proxy# 48 -> Word8#
byteVal Proxy# 48
_ = Word# -> Word8#
wordToWord8# Word#
0x30##
    {-# INLINE byteVal #-}
instance ByteVal 0x31 where
    byteVal :: Proxy# 49 -> Word8#
byteVal Proxy# 49
_ = Word# -> Word8#
wordToWord8# Word#
0x31##
    {-# INLINE byteVal #-}
instance ByteVal 0x32 where
    byteVal :: Proxy# 50 -> Word8#
byteVal Proxy# 50
_ = Word# -> Word8#
wordToWord8# Word#
0x32##
    {-# INLINE byteVal #-}
instance ByteVal 0x33 where
    byteVal :: Proxy# 51 -> Word8#
byteVal Proxy# 51
_ = Word# -> Word8#
wordToWord8# Word#
0x33##
    {-# INLINE byteVal #-}
instance ByteVal 0x34 where
    byteVal :: Proxy# 52 -> Word8#
byteVal Proxy# 52
_ = Word# -> Word8#
wordToWord8# Word#
0x34##
    {-# INLINE byteVal #-}
instance ByteVal 0x35 where
    byteVal :: Proxy# 53 -> Word8#
byteVal Proxy# 53
_ = Word# -> Word8#
wordToWord8# Word#
0x35##
    {-# INLINE byteVal #-}
instance ByteVal 0x36 where
    byteVal :: Proxy# 54 -> Word8#
byteVal Proxy# 54
_ = Word# -> Word8#
wordToWord8# Word#
0x36##
    {-# INLINE byteVal #-}
instance ByteVal 0x37 where
    byteVal :: Proxy# 55 -> Word8#
byteVal Proxy# 55
_ = Word# -> Word8#
wordToWord8# Word#
0x37##
    {-# INLINE byteVal #-}
instance ByteVal 0x38 where
    byteVal :: Proxy# 56 -> Word8#
byteVal Proxy# 56
_ = Word# -> Word8#
wordToWord8# Word#
0x38##
    {-# INLINE byteVal #-}
instance ByteVal 0x39 where
    byteVal :: Proxy# 57 -> Word8#
byteVal Proxy# 57
_ = Word# -> Word8#
wordToWord8# Word#
0x39##
    {-# INLINE byteVal #-}
instance ByteVal 0x3a where
    byteVal :: Proxy# 58 -> Word8#
byteVal Proxy# 58
_ = Word# -> Word8#
wordToWord8# Word#
0x3a##
    {-# INLINE byteVal #-}
instance ByteVal 0x3b where
    byteVal :: Proxy# 59 -> Word8#
byteVal Proxy# 59
_ = Word# -> Word8#
wordToWord8# Word#
0x3b##
    {-# INLINE byteVal #-}
instance ByteVal 0x3c where
    byteVal :: Proxy# 60 -> Word8#
byteVal Proxy# 60
_ = Word# -> Word8#
wordToWord8# Word#
0x3c##
    {-# INLINE byteVal #-}
instance ByteVal 0x3d where
    byteVal :: Proxy# 61 -> Word8#
byteVal Proxy# 61
_ = Word# -> Word8#
wordToWord8# Word#
0x3d##
    {-# INLINE byteVal #-}
instance ByteVal 0x3e where
    byteVal :: Proxy# 62 -> Word8#
byteVal Proxy# 62
_ = Word# -> Word8#
wordToWord8# Word#
0x3e##
    {-# INLINE byteVal #-}
instance ByteVal 0x3f where
    byteVal :: Proxy# 63 -> Word8#
byteVal Proxy# 63
_ = Word# -> Word8#
wordToWord8# Word#
0x3f##
    {-# INLINE byteVal #-}
instance ByteVal 0x40 where
    byteVal :: Proxy# 64 -> Word8#
byteVal Proxy# 64
_ = Word# -> Word8#
wordToWord8# Word#
0x40##
    {-# INLINE byteVal #-}
instance ByteVal 0x41 where
    byteVal :: Proxy# 65 -> Word8#
byteVal Proxy# 65
_ = Word# -> Word8#
wordToWord8# Word#
0x41##
    {-# INLINE byteVal #-}
instance ByteVal 0x42 where
    byteVal :: Proxy# 66 -> Word8#
byteVal Proxy# 66
_ = Word# -> Word8#
wordToWord8# Word#
0x42##
    {-# INLINE byteVal #-}
instance ByteVal 0x43 where
    byteVal :: Proxy# 67 -> Word8#
byteVal Proxy# 67
_ = Word# -> Word8#
wordToWord8# Word#
0x43##
    {-# INLINE byteVal #-}
instance ByteVal 0x44 where
    byteVal :: Proxy# 68 -> Word8#
byteVal Proxy# 68
_ = Word# -> Word8#
wordToWord8# Word#
0x44##
    {-# INLINE byteVal #-}
instance ByteVal 0x45 where
    byteVal :: Proxy# 69 -> Word8#
byteVal Proxy# 69
_ = Word# -> Word8#
wordToWord8# Word#
0x45##
    {-# INLINE byteVal #-}
instance ByteVal 0x46 where
    byteVal :: Proxy# 70 -> Word8#
byteVal Proxy# 70
_ = Word# -> Word8#
wordToWord8# Word#
0x46##
    {-# INLINE byteVal #-}
instance ByteVal 0x47 where
    byteVal :: Proxy# 71 -> Word8#
byteVal Proxy# 71
_ = Word# -> Word8#
wordToWord8# Word#
0x47##
    {-# INLINE byteVal #-}
instance ByteVal 0x48 where
    byteVal :: Proxy# 72 -> Word8#
byteVal Proxy# 72
_ = Word# -> Word8#
wordToWord8# Word#
0x48##
    {-# INLINE byteVal #-}
instance ByteVal 0x49 where
    byteVal :: Proxy# 73 -> Word8#
byteVal Proxy# 73
_ = Word# -> Word8#
wordToWord8# Word#
0x49##
    {-# INLINE byteVal #-}
instance ByteVal 0x4a where
    byteVal :: Proxy# 74 -> Word8#
byteVal Proxy# 74
_ = Word# -> Word8#
wordToWord8# Word#
0x4a##
    {-# INLINE byteVal #-}
instance ByteVal 0x4b where
    byteVal :: Proxy# 75 -> Word8#
byteVal Proxy# 75
_ = Word# -> Word8#
wordToWord8# Word#
0x4b##
    {-# INLINE byteVal #-}
instance ByteVal 0x4c where
    byteVal :: Proxy# 76 -> Word8#
byteVal Proxy# 76
_ = Word# -> Word8#
wordToWord8# Word#
0x4c##
    {-# INLINE byteVal #-}
instance ByteVal 0x4d where
    byteVal :: Proxy# 77 -> Word8#
byteVal Proxy# 77
_ = Word# -> Word8#
wordToWord8# Word#
0x4d##
    {-# INLINE byteVal #-}
instance ByteVal 0x4e where
    byteVal :: Proxy# 78 -> Word8#
byteVal Proxy# 78
_ = Word# -> Word8#
wordToWord8# Word#
0x4e##
    {-# INLINE byteVal #-}
instance ByteVal 0x4f where
    byteVal :: Proxy# 79 -> Word8#
byteVal Proxy# 79
_ = Word# -> Word8#
wordToWord8# Word#
0x4f##
    {-# INLINE byteVal #-}
instance ByteVal 0x50 where
    byteVal :: Proxy# 80 -> Word8#
byteVal Proxy# 80
_ = Word# -> Word8#
wordToWord8# Word#
0x50##
    {-# INLINE byteVal #-}
instance ByteVal 0x51 where
    byteVal :: Proxy# 81 -> Word8#
byteVal Proxy# 81
_ = Word# -> Word8#
wordToWord8# Word#
0x51##
    {-# INLINE byteVal #-}
instance ByteVal 0x52 where
    byteVal :: Proxy# 82 -> Word8#
byteVal Proxy# 82
_ = Word# -> Word8#
wordToWord8# Word#
0x52##
    {-# INLINE byteVal #-}
instance ByteVal 0x53 where
    byteVal :: Proxy# 83 -> Word8#
byteVal Proxy# 83
_ = Word# -> Word8#
wordToWord8# Word#
0x53##
    {-# INLINE byteVal #-}
instance ByteVal 0x54 where
    byteVal :: Proxy# 84 -> Word8#
byteVal Proxy# 84
_ = Word# -> Word8#
wordToWord8# Word#
0x54##
    {-# INLINE byteVal #-}
instance ByteVal 0x55 where
    byteVal :: Proxy# 85 -> Word8#
byteVal Proxy# 85
_ = Word# -> Word8#
wordToWord8# Word#
0x55##
    {-# INLINE byteVal #-}
instance ByteVal 0x56 where
    byteVal :: Proxy# 86 -> Word8#
byteVal Proxy# 86
_ = Word# -> Word8#
wordToWord8# Word#
0x56##
    {-# INLINE byteVal #-}
instance ByteVal 0x57 where
    byteVal :: Proxy# 87 -> Word8#
byteVal Proxy# 87
_ = Word# -> Word8#
wordToWord8# Word#
0x57##
    {-# INLINE byteVal #-}
instance ByteVal 0x58 where
    byteVal :: Proxy# 88 -> Word8#
byteVal Proxy# 88
_ = Word# -> Word8#
wordToWord8# Word#
0x58##
    {-# INLINE byteVal #-}
instance ByteVal 0x59 where
    byteVal :: Proxy# 89 -> Word8#
byteVal Proxy# 89
_ = Word# -> Word8#
wordToWord8# Word#
0x59##
    {-# INLINE byteVal #-}
instance ByteVal 0x5a where
    byteVal :: Proxy# 90 -> Word8#
byteVal Proxy# 90
_ = Word# -> Word8#
wordToWord8# Word#
0x5a##
    {-# INLINE byteVal #-}
instance ByteVal 0x5b where
    byteVal :: Proxy# 91 -> Word8#
byteVal Proxy# 91
_ = Word# -> Word8#
wordToWord8# Word#
0x5b##
    {-# INLINE byteVal #-}
instance ByteVal 0x5c where
    byteVal :: Proxy# 92 -> Word8#
byteVal Proxy# 92
_ = Word# -> Word8#
wordToWord8# Word#
0x5c##
    {-# INLINE byteVal #-}
instance ByteVal 0x5d where
    byteVal :: Proxy# 93 -> Word8#
byteVal Proxy# 93
_ = Word# -> Word8#
wordToWord8# Word#
0x5d##
    {-# INLINE byteVal #-}
instance ByteVal 0x5e where
    byteVal :: Proxy# 94 -> Word8#
byteVal Proxy# 94
_ = Word# -> Word8#
wordToWord8# Word#
0x5e##
    {-# INLINE byteVal #-}
instance ByteVal 0x5f where
    byteVal :: Proxy# 95 -> Word8#
byteVal Proxy# 95
_ = Word# -> Word8#
wordToWord8# Word#
0x5f##
    {-# INLINE byteVal #-}
instance ByteVal 0x60 where
    byteVal :: Proxy# 96 -> Word8#
byteVal Proxy# 96
_ = Word# -> Word8#
wordToWord8# Word#
0x60##
    {-# INLINE byteVal #-}
instance ByteVal 0x61 where
    byteVal :: Proxy# 97 -> Word8#
byteVal Proxy# 97
_ = Word# -> Word8#
wordToWord8# Word#
0x61##
    {-# INLINE byteVal #-}
instance ByteVal 0x62 where
    byteVal :: Proxy# 98 -> Word8#
byteVal Proxy# 98
_ = Word# -> Word8#
wordToWord8# Word#
0x62##
    {-# INLINE byteVal #-}
instance ByteVal 0x63 where
    byteVal :: Proxy# 99 -> Word8#
byteVal Proxy# 99
_ = Word# -> Word8#
wordToWord8# Word#
0x63##
    {-# INLINE byteVal #-}
instance ByteVal 0x64 where
    byteVal :: Proxy# 100 -> Word8#
byteVal Proxy# 100
_ = Word# -> Word8#
wordToWord8# Word#
0x64##
    {-# INLINE byteVal #-}
instance ByteVal 0x65 where
    byteVal :: Proxy# 101 -> Word8#
byteVal Proxy# 101
_ = Word# -> Word8#
wordToWord8# Word#
0x65##
    {-# INLINE byteVal #-}
instance ByteVal 0x66 where
    byteVal :: Proxy# 102 -> Word8#
byteVal Proxy# 102
_ = Word# -> Word8#
wordToWord8# Word#
0x66##
    {-# INLINE byteVal #-}
instance ByteVal 0x67 where
    byteVal :: Proxy# 103 -> Word8#
byteVal Proxy# 103
_ = Word# -> Word8#
wordToWord8# Word#
0x67##
    {-# INLINE byteVal #-}
instance ByteVal 0x68 where
    byteVal :: Proxy# 104 -> Word8#
byteVal Proxy# 104
_ = Word# -> Word8#
wordToWord8# Word#
0x68##
    {-# INLINE byteVal #-}
instance ByteVal 0x69 where
    byteVal :: Proxy# 105 -> Word8#
byteVal Proxy# 105
_ = Word# -> Word8#
wordToWord8# Word#
0x69##
    {-# INLINE byteVal #-}
instance ByteVal 0x6a where
    byteVal :: Proxy# 106 -> Word8#
byteVal Proxy# 106
_ = Word# -> Word8#
wordToWord8# Word#
0x6a##
    {-# INLINE byteVal #-}
instance ByteVal 0x6b where
    byteVal :: Proxy# 107 -> Word8#
byteVal Proxy# 107
_ = Word# -> Word8#
wordToWord8# Word#
0x6b##
    {-# INLINE byteVal #-}
instance ByteVal 0x6c where
    byteVal :: Proxy# 108 -> Word8#
byteVal Proxy# 108
_ = Word# -> Word8#
wordToWord8# Word#
0x6c##
    {-# INLINE byteVal #-}
instance ByteVal 0x6d where
    byteVal :: Proxy# 109 -> Word8#
byteVal Proxy# 109
_ = Word# -> Word8#
wordToWord8# Word#
0x6d##
    {-# INLINE byteVal #-}
instance ByteVal 0x6e where
    byteVal :: Proxy# 110 -> Word8#
byteVal Proxy# 110
_ = Word# -> Word8#
wordToWord8# Word#
0x6e##
    {-# INLINE byteVal #-}
instance ByteVal 0x6f where
    byteVal :: Proxy# 111 -> Word8#
byteVal Proxy# 111
_ = Word# -> Word8#
wordToWord8# Word#
0x6f##
    {-# INLINE byteVal #-}
instance ByteVal 0x70 where
    byteVal :: Proxy# 112 -> Word8#
byteVal Proxy# 112
_ = Word# -> Word8#
wordToWord8# Word#
0x70##
    {-# INLINE byteVal #-}
instance ByteVal 0x71 where
    byteVal :: Proxy# 113 -> Word8#
byteVal Proxy# 113
_ = Word# -> Word8#
wordToWord8# Word#
0x71##
    {-# INLINE byteVal #-}
instance ByteVal 0x72 where
    byteVal :: Proxy# 114 -> Word8#
byteVal Proxy# 114
_ = Word# -> Word8#
wordToWord8# Word#
0x72##
    {-# INLINE byteVal #-}
instance ByteVal 0x73 where
    byteVal :: Proxy# 115 -> Word8#
byteVal Proxy# 115
_ = Word# -> Word8#
wordToWord8# Word#
0x73##
    {-# INLINE byteVal #-}
instance ByteVal 0x74 where
    byteVal :: Proxy# 116 -> Word8#
byteVal Proxy# 116
_ = Word# -> Word8#
wordToWord8# Word#
0x74##
    {-# INLINE byteVal #-}
instance ByteVal 0x75 where
    byteVal :: Proxy# 117 -> Word8#
byteVal Proxy# 117
_ = Word# -> Word8#
wordToWord8# Word#
0x75##
    {-# INLINE byteVal #-}
instance ByteVal 0x76 where
    byteVal :: Proxy# 118 -> Word8#
byteVal Proxy# 118
_ = Word# -> Word8#
wordToWord8# Word#
0x76##
    {-# INLINE byteVal #-}
instance ByteVal 0x77 where
    byteVal :: Proxy# 119 -> Word8#
byteVal Proxy# 119
_ = Word# -> Word8#
wordToWord8# Word#
0x77##
    {-# INLINE byteVal #-}
instance ByteVal 0x78 where
    byteVal :: Proxy# 120 -> Word8#
byteVal Proxy# 120
_ = Word# -> Word8#
wordToWord8# Word#
0x78##
    {-# INLINE byteVal #-}
instance ByteVal 0x79 where
    byteVal :: Proxy# 121 -> Word8#
byteVal Proxy# 121
_ = Word# -> Word8#
wordToWord8# Word#
0x79##
    {-# INLINE byteVal #-}
instance ByteVal 0x7a where
    byteVal :: Proxy# 122 -> Word8#
byteVal Proxy# 122
_ = Word# -> Word8#
wordToWord8# Word#
0x7a##
    {-# INLINE byteVal #-}
instance ByteVal 0x7b where
    byteVal :: Proxy# 123 -> Word8#
byteVal Proxy# 123
_ = Word# -> Word8#
wordToWord8# Word#
0x7b##
    {-# INLINE byteVal #-}
instance ByteVal 0x7c where
    byteVal :: Proxy# 124 -> Word8#
byteVal Proxy# 124
_ = Word# -> Word8#
wordToWord8# Word#
0x7c##
    {-# INLINE byteVal #-}
instance ByteVal 0x7d where
    byteVal :: Proxy# 125 -> Word8#
byteVal Proxy# 125
_ = Word# -> Word8#
wordToWord8# Word#
0x7d##
    {-# INLINE byteVal #-}
instance ByteVal 0x7e where
    byteVal :: Proxy# 126 -> Word8#
byteVal Proxy# 126
_ = Word# -> Word8#
wordToWord8# Word#
0x7e##
    {-# INLINE byteVal #-}
instance ByteVal 0x7f where
    byteVal :: Proxy# 127 -> Word8#
byteVal Proxy# 127
_ = Word# -> Word8#
wordToWord8# Word#
0x7f##
    {-# INLINE byteVal #-}
instance ByteVal 0x80 where
    byteVal :: Proxy# 128 -> Word8#
byteVal Proxy# 128
_ = Word# -> Word8#
wordToWord8# Word#
0x80##
    {-# INLINE byteVal #-}
instance ByteVal 0x81 where
    byteVal :: Proxy# 129 -> Word8#
byteVal Proxy# 129
_ = Word# -> Word8#
wordToWord8# Word#
0x81##
    {-# INLINE byteVal #-}
instance ByteVal 0x82 where
    byteVal :: Proxy# 130 -> Word8#
byteVal Proxy# 130
_ = Word# -> Word8#
wordToWord8# Word#
0x82##
    {-# INLINE byteVal #-}
instance ByteVal 0x83 where
    byteVal :: Proxy# 131 -> Word8#
byteVal Proxy# 131
_ = Word# -> Word8#
wordToWord8# Word#
0x83##
    {-# INLINE byteVal #-}
instance ByteVal 0x84 where
    byteVal :: Proxy# 132 -> Word8#
byteVal Proxy# 132
_ = Word# -> Word8#
wordToWord8# Word#
0x84##
    {-# INLINE byteVal #-}
instance ByteVal 0x85 where
    byteVal :: Proxy# 133 -> Word8#
byteVal Proxy# 133
_ = Word# -> Word8#
wordToWord8# Word#
0x85##
    {-# INLINE byteVal #-}
instance ByteVal 0x86 where
    byteVal :: Proxy# 134 -> Word8#
byteVal Proxy# 134
_ = Word# -> Word8#
wordToWord8# Word#
0x86##
    {-# INLINE byteVal #-}
instance ByteVal 0x87 where
    byteVal :: Proxy# 135 -> Word8#
byteVal Proxy# 135
_ = Word# -> Word8#
wordToWord8# Word#
0x87##
    {-# INLINE byteVal #-}
instance ByteVal 0x88 where
    byteVal :: Proxy# 136 -> Word8#
byteVal Proxy# 136
_ = Word# -> Word8#
wordToWord8# Word#
0x88##
    {-# INLINE byteVal #-}
instance ByteVal 0x89 where
    byteVal :: Proxy# 137 -> Word8#
byteVal Proxy# 137
_ = Word# -> Word8#
wordToWord8# Word#
0x89##
    {-# INLINE byteVal #-}
instance ByteVal 0x8a where
    byteVal :: Proxy# 138 -> Word8#
byteVal Proxy# 138
_ = Word# -> Word8#
wordToWord8# Word#
0x8a##
    {-# INLINE byteVal #-}
instance ByteVal 0x8b where
    byteVal :: Proxy# 139 -> Word8#
byteVal Proxy# 139
_ = Word# -> Word8#
wordToWord8# Word#
0x8b##
    {-# INLINE byteVal #-}
instance ByteVal 0x8c where
    byteVal :: Proxy# 140 -> Word8#
byteVal Proxy# 140
_ = Word# -> Word8#
wordToWord8# Word#
0x8c##
    {-# INLINE byteVal #-}
instance ByteVal 0x8d where
    byteVal :: Proxy# 141 -> Word8#
byteVal Proxy# 141
_ = Word# -> Word8#
wordToWord8# Word#
0x8d##
    {-# INLINE byteVal #-}
instance ByteVal 0x8e where
    byteVal :: Proxy# 142 -> Word8#
byteVal Proxy# 142
_ = Word# -> Word8#
wordToWord8# Word#
0x8e##
    {-# INLINE byteVal #-}
instance ByteVal 0x8f where
    byteVal :: Proxy# 143 -> Word8#
byteVal Proxy# 143
_ = Word# -> Word8#
wordToWord8# Word#
0x8f##
    {-# INLINE byteVal #-}
instance ByteVal 0x90 where
    byteVal :: Proxy# 144 -> Word8#
byteVal Proxy# 144
_ = Word# -> Word8#
wordToWord8# Word#
0x90##
    {-# INLINE byteVal #-}
instance ByteVal 0x91 where
    byteVal :: Proxy# 145 -> Word8#
byteVal Proxy# 145
_ = Word# -> Word8#
wordToWord8# Word#
0x91##
    {-# INLINE byteVal #-}
instance ByteVal 0x92 where
    byteVal :: Proxy# 146 -> Word8#
byteVal Proxy# 146
_ = Word# -> Word8#
wordToWord8# Word#
0x92##
    {-# INLINE byteVal #-}
instance ByteVal 0x93 where
    byteVal :: Proxy# 147 -> Word8#
byteVal Proxy# 147
_ = Word# -> Word8#
wordToWord8# Word#
0x93##
    {-# INLINE byteVal #-}
instance ByteVal 0x94 where
    byteVal :: Proxy# 148 -> Word8#
byteVal Proxy# 148
_ = Word# -> Word8#
wordToWord8# Word#
0x94##
    {-# INLINE byteVal #-}
instance ByteVal 0x95 where
    byteVal :: Proxy# 149 -> Word8#
byteVal Proxy# 149
_ = Word# -> Word8#
wordToWord8# Word#
0x95##
    {-# INLINE byteVal #-}
instance ByteVal 0x96 where
    byteVal :: Proxy# 150 -> Word8#
byteVal Proxy# 150
_ = Word# -> Word8#
wordToWord8# Word#
0x96##
    {-# INLINE byteVal #-}
instance ByteVal 0x97 where
    byteVal :: Proxy# 151 -> Word8#
byteVal Proxy# 151
_ = Word# -> Word8#
wordToWord8# Word#
0x97##
    {-# INLINE byteVal #-}
instance ByteVal 0x98 where
    byteVal :: Proxy# 152 -> Word8#
byteVal Proxy# 152
_ = Word# -> Word8#
wordToWord8# Word#
0x98##
    {-# INLINE byteVal #-}
instance ByteVal 0x99 where
    byteVal :: Proxy# 153 -> Word8#
byteVal Proxy# 153
_ = Word# -> Word8#
wordToWord8# Word#
0x99##
    {-# INLINE byteVal #-}
instance ByteVal 0x9a where
    byteVal :: Proxy# 154 -> Word8#
byteVal Proxy# 154
_ = Word# -> Word8#
wordToWord8# Word#
0x9a##
    {-# INLINE byteVal #-}
instance ByteVal 0x9b where
    byteVal :: Proxy# 155 -> Word8#
byteVal Proxy# 155
_ = Word# -> Word8#
wordToWord8# Word#
0x9b##
    {-# INLINE byteVal #-}
instance ByteVal 0x9c where
    byteVal :: Proxy# 156 -> Word8#
byteVal Proxy# 156
_ = Word# -> Word8#
wordToWord8# Word#
0x9c##
    {-# INLINE byteVal #-}
instance ByteVal 0x9d where
    byteVal :: Proxy# 157 -> Word8#
byteVal Proxy# 157
_ = Word# -> Word8#
wordToWord8# Word#
0x9d##
    {-# INLINE byteVal #-}
instance ByteVal 0x9e where
    byteVal :: Proxy# 158 -> Word8#
byteVal Proxy# 158
_ = Word# -> Word8#
wordToWord8# Word#
0x9e##
    {-# INLINE byteVal #-}
instance ByteVal 0x9f where
    byteVal :: Proxy# 159 -> Word8#
byteVal Proxy# 159
_ = Word# -> Word8#
wordToWord8# Word#
0x9f##
    {-# INLINE byteVal #-}
instance ByteVal 0xa0 where
    byteVal :: Proxy# 160 -> Word8#
byteVal Proxy# 160
_ = Word# -> Word8#
wordToWord8# Word#
0xa0##
    {-# INLINE byteVal #-}
instance ByteVal 0xa1 where
    byteVal :: Proxy# 161 -> Word8#
byteVal Proxy# 161
_ = Word# -> Word8#
wordToWord8# Word#
0xa1##
    {-# INLINE byteVal #-}
instance ByteVal 0xa2 where
    byteVal :: Proxy# 162 -> Word8#
byteVal Proxy# 162
_ = Word# -> Word8#
wordToWord8# Word#
0xa2##
    {-# INLINE byteVal #-}
instance ByteVal 0xa3 where
    byteVal :: Proxy# 163 -> Word8#
byteVal Proxy# 163
_ = Word# -> Word8#
wordToWord8# Word#
0xa3##
    {-# INLINE byteVal #-}
instance ByteVal 0xa4 where
    byteVal :: Proxy# 164 -> Word8#
byteVal Proxy# 164
_ = Word# -> Word8#
wordToWord8# Word#
0xa4##
    {-# INLINE byteVal #-}
instance ByteVal 0xa5 where
    byteVal :: Proxy# 165 -> Word8#
byteVal Proxy# 165
_ = Word# -> Word8#
wordToWord8# Word#
0xa5##
    {-# INLINE byteVal #-}
instance ByteVal 0xa6 where
    byteVal :: Proxy# 166 -> Word8#
byteVal Proxy# 166
_ = Word# -> Word8#
wordToWord8# Word#
0xa6##
    {-# INLINE byteVal #-}
instance ByteVal 0xa7 where
    byteVal :: Proxy# 167 -> Word8#
byteVal Proxy# 167
_ = Word# -> Word8#
wordToWord8# Word#
0xa7##
    {-# INLINE byteVal #-}
instance ByteVal 0xa8 where
    byteVal :: Proxy# 168 -> Word8#
byteVal Proxy# 168
_ = Word# -> Word8#
wordToWord8# Word#
0xa8##
    {-# INLINE byteVal #-}
instance ByteVal 0xa9 where
    byteVal :: Proxy# 169 -> Word8#
byteVal Proxy# 169
_ = Word# -> Word8#
wordToWord8# Word#
0xa9##
    {-# INLINE byteVal #-}
instance ByteVal 0xaa where
    byteVal :: Proxy# 170 -> Word8#
byteVal Proxy# 170
_ = Word# -> Word8#
wordToWord8# Word#
0xaa##
    {-# INLINE byteVal #-}
instance ByteVal 0xab where
    byteVal :: Proxy# 171 -> Word8#
byteVal Proxy# 171
_ = Word# -> Word8#
wordToWord8# Word#
0xab##
    {-# INLINE byteVal #-}
instance ByteVal 0xac where
    byteVal :: Proxy# 172 -> Word8#
byteVal Proxy# 172
_ = Word# -> Word8#
wordToWord8# Word#
0xac##
    {-# INLINE byteVal #-}
instance ByteVal 0xad where
    byteVal :: Proxy# 173 -> Word8#
byteVal Proxy# 173
_ = Word# -> Word8#
wordToWord8# Word#
0xad##
    {-# INLINE byteVal #-}
instance ByteVal 0xae where
    byteVal :: Proxy# 174 -> Word8#
byteVal Proxy# 174
_ = Word# -> Word8#
wordToWord8# Word#
0xae##
    {-# INLINE byteVal #-}
instance ByteVal 0xaf where
    byteVal :: Proxy# 175 -> Word8#
byteVal Proxy# 175
_ = Word# -> Word8#
wordToWord8# Word#
0xaf##
    {-# INLINE byteVal #-}
instance ByteVal 0xb0 where
    byteVal :: Proxy# 176 -> Word8#
byteVal Proxy# 176
_ = Word# -> Word8#
wordToWord8# Word#
0xb0##
    {-# INLINE byteVal #-}
instance ByteVal 0xb1 where
    byteVal :: Proxy# 177 -> Word8#
byteVal Proxy# 177
_ = Word# -> Word8#
wordToWord8# Word#
0xb1##
    {-# INLINE byteVal #-}
instance ByteVal 0xb2 where
    byteVal :: Proxy# 178 -> Word8#
byteVal Proxy# 178
_ = Word# -> Word8#
wordToWord8# Word#
0xb2##
    {-# INLINE byteVal #-}
instance ByteVal 0xb3 where
    byteVal :: Proxy# 179 -> Word8#
byteVal Proxy# 179
_ = Word# -> Word8#
wordToWord8# Word#
0xb3##
    {-# INLINE byteVal #-}
instance ByteVal 0xb4 where
    byteVal :: Proxy# 180 -> Word8#
byteVal Proxy# 180
_ = Word# -> Word8#
wordToWord8# Word#
0xb4##
    {-# INLINE byteVal #-}
instance ByteVal 0xb5 where
    byteVal :: Proxy# 181 -> Word8#
byteVal Proxy# 181
_ = Word# -> Word8#
wordToWord8# Word#
0xb5##
    {-# INLINE byteVal #-}
instance ByteVal 0xb6 where
    byteVal :: Proxy# 182 -> Word8#
byteVal Proxy# 182
_ = Word# -> Word8#
wordToWord8# Word#
0xb6##
    {-# INLINE byteVal #-}
instance ByteVal 0xb7 where
    byteVal :: Proxy# 183 -> Word8#
byteVal Proxy# 183
_ = Word# -> Word8#
wordToWord8# Word#
0xb7##
    {-# INLINE byteVal #-}
instance ByteVal 0xb8 where
    byteVal :: Proxy# 184 -> Word8#
byteVal Proxy# 184
_ = Word# -> Word8#
wordToWord8# Word#
0xb8##
    {-# INLINE byteVal #-}
instance ByteVal 0xb9 where
    byteVal :: Proxy# 185 -> Word8#
byteVal Proxy# 185
_ = Word# -> Word8#
wordToWord8# Word#
0xb9##
    {-# INLINE byteVal #-}
instance ByteVal 0xba where
    byteVal :: Proxy# 186 -> Word8#
byteVal Proxy# 186
_ = Word# -> Word8#
wordToWord8# Word#
0xba##
    {-# INLINE byteVal #-}
instance ByteVal 0xbb where
    byteVal :: Proxy# 187 -> Word8#
byteVal Proxy# 187
_ = Word# -> Word8#
wordToWord8# Word#
0xbb##
    {-# INLINE byteVal #-}
instance ByteVal 0xbc where
    byteVal :: Proxy# 188 -> Word8#
byteVal Proxy# 188
_ = Word# -> Word8#
wordToWord8# Word#
0xbc##
    {-# INLINE byteVal #-}
instance ByteVal 0xbd where
    byteVal :: Proxy# 189 -> Word8#
byteVal Proxy# 189
_ = Word# -> Word8#
wordToWord8# Word#
0xbd##
    {-# INLINE byteVal #-}
instance ByteVal 0xbe where
    byteVal :: Proxy# 190 -> Word8#
byteVal Proxy# 190
_ = Word# -> Word8#
wordToWord8# Word#
0xbe##
    {-# INLINE byteVal #-}
instance ByteVal 0xbf where
    byteVal :: Proxy# 191 -> Word8#
byteVal Proxy# 191
_ = Word# -> Word8#
wordToWord8# Word#
0xbf##
    {-# INLINE byteVal #-}
instance ByteVal 0xc0 where
    byteVal :: Proxy# 192 -> Word8#
byteVal Proxy# 192
_ = Word# -> Word8#
wordToWord8# Word#
0xc0##
    {-# INLINE byteVal #-}
instance ByteVal 0xc1 where
    byteVal :: Proxy# 193 -> Word8#
byteVal Proxy# 193
_ = Word# -> Word8#
wordToWord8# Word#
0xc1##
    {-# INLINE byteVal #-}
instance ByteVal 0xc2 where
    byteVal :: Proxy# 194 -> Word8#
byteVal Proxy# 194
_ = Word# -> Word8#
wordToWord8# Word#
0xc2##
    {-# INLINE byteVal #-}
instance ByteVal 0xc3 where
    byteVal :: Proxy# 195 -> Word8#
byteVal Proxy# 195
_ = Word# -> Word8#
wordToWord8# Word#
0xc3##
    {-# INLINE byteVal #-}
instance ByteVal 0xc4 where
    byteVal :: Proxy# 196 -> Word8#
byteVal Proxy# 196
_ = Word# -> Word8#
wordToWord8# Word#
0xc4##
    {-# INLINE byteVal #-}
instance ByteVal 0xc5 where
    byteVal :: Proxy# 197 -> Word8#
byteVal Proxy# 197
_ = Word# -> Word8#
wordToWord8# Word#
0xc5##
    {-# INLINE byteVal #-}
instance ByteVal 0xc6 where
    byteVal :: Proxy# 198 -> Word8#
byteVal Proxy# 198
_ = Word# -> Word8#
wordToWord8# Word#
0xc6##
    {-# INLINE byteVal #-}
instance ByteVal 0xc7 where
    byteVal :: Proxy# 199 -> Word8#
byteVal Proxy# 199
_ = Word# -> Word8#
wordToWord8# Word#
0xc7##
    {-# INLINE byteVal #-}
instance ByteVal 0xc8 where
    byteVal :: Proxy# 200 -> Word8#
byteVal Proxy# 200
_ = Word# -> Word8#
wordToWord8# Word#
0xc8##
    {-# INLINE byteVal #-}
instance ByteVal 0xc9 where
    byteVal :: Proxy# 201 -> Word8#
byteVal Proxy# 201
_ = Word# -> Word8#
wordToWord8# Word#
0xc9##
    {-# INLINE byteVal #-}
instance ByteVal 0xca where
    byteVal :: Proxy# 202 -> Word8#
byteVal Proxy# 202
_ = Word# -> Word8#
wordToWord8# Word#
0xca##
    {-# INLINE byteVal #-}
instance ByteVal 0xcb where
    byteVal :: Proxy# 203 -> Word8#
byteVal Proxy# 203
_ = Word# -> Word8#
wordToWord8# Word#
0xcb##
    {-# INLINE byteVal #-}
instance ByteVal 0xcc where
    byteVal :: Proxy# 204 -> Word8#
byteVal Proxy# 204
_ = Word# -> Word8#
wordToWord8# Word#
0xcc##
    {-# INLINE byteVal #-}
instance ByteVal 0xcd where
    byteVal :: Proxy# 205 -> Word8#
byteVal Proxy# 205
_ = Word# -> Word8#
wordToWord8# Word#
0xcd##
    {-# INLINE byteVal #-}
instance ByteVal 0xce where
    byteVal :: Proxy# 206 -> Word8#
byteVal Proxy# 206
_ = Word# -> Word8#
wordToWord8# Word#
0xce##
    {-# INLINE byteVal #-}
instance ByteVal 0xcf where
    byteVal :: Proxy# 207 -> Word8#
byteVal Proxy# 207
_ = Word# -> Word8#
wordToWord8# Word#
0xcf##
    {-# INLINE byteVal #-}
instance ByteVal 0xd0 where
    byteVal :: Proxy# 208 -> Word8#
byteVal Proxy# 208
_ = Word# -> Word8#
wordToWord8# Word#
0xd0##
    {-# INLINE byteVal #-}
instance ByteVal 0xd1 where
    byteVal :: Proxy# 209 -> Word8#
byteVal Proxy# 209
_ = Word# -> Word8#
wordToWord8# Word#
0xd1##
    {-# INLINE byteVal #-}
instance ByteVal 0xd2 where
    byteVal :: Proxy# 210 -> Word8#
byteVal Proxy# 210
_ = Word# -> Word8#
wordToWord8# Word#
0xd2##
    {-# INLINE byteVal #-}
instance ByteVal 0xd3 where
    byteVal :: Proxy# 211 -> Word8#
byteVal Proxy# 211
_ = Word# -> Word8#
wordToWord8# Word#
0xd3##
    {-# INLINE byteVal #-}
instance ByteVal 0xd4 where
    byteVal :: Proxy# 212 -> Word8#
byteVal Proxy# 212
_ = Word# -> Word8#
wordToWord8# Word#
0xd4##
    {-# INLINE byteVal #-}
instance ByteVal 0xd5 where
    byteVal :: Proxy# 213 -> Word8#
byteVal Proxy# 213
_ = Word# -> Word8#
wordToWord8# Word#
0xd5##
    {-# INLINE byteVal #-}
instance ByteVal 0xd6 where
    byteVal :: Proxy# 214 -> Word8#
byteVal Proxy# 214
_ = Word# -> Word8#
wordToWord8# Word#
0xd6##
    {-# INLINE byteVal #-}
instance ByteVal 0xd7 where
    byteVal :: Proxy# 215 -> Word8#
byteVal Proxy# 215
_ = Word# -> Word8#
wordToWord8# Word#
0xd7##
    {-# INLINE byteVal #-}
instance ByteVal 0xd8 where
    byteVal :: Proxy# 216 -> Word8#
byteVal Proxy# 216
_ = Word# -> Word8#
wordToWord8# Word#
0xd8##
    {-# INLINE byteVal #-}
instance ByteVal 0xd9 where
    byteVal :: Proxy# 217 -> Word8#
byteVal Proxy# 217
_ = Word# -> Word8#
wordToWord8# Word#
0xd9##
    {-# INLINE byteVal #-}
instance ByteVal 0xda where
    byteVal :: Proxy# 218 -> Word8#
byteVal Proxy# 218
_ = Word# -> Word8#
wordToWord8# Word#
0xda##
    {-# INLINE byteVal #-}
instance ByteVal 0xdb where
    byteVal :: Proxy# 219 -> Word8#
byteVal Proxy# 219
_ = Word# -> Word8#
wordToWord8# Word#
0xdb##
    {-# INLINE byteVal #-}
instance ByteVal 0xdc where
    byteVal :: Proxy# 220 -> Word8#
byteVal Proxy# 220
_ = Word# -> Word8#
wordToWord8# Word#
0xdc##
    {-# INLINE byteVal #-}
instance ByteVal 0xdd where
    byteVal :: Proxy# 221 -> Word8#
byteVal Proxy# 221
_ = Word# -> Word8#
wordToWord8# Word#
0xdd##
    {-# INLINE byteVal #-}
instance ByteVal 0xde where
    byteVal :: Proxy# 222 -> Word8#
byteVal Proxy# 222
_ = Word# -> Word8#
wordToWord8# Word#
0xde##
    {-# INLINE byteVal #-}
instance ByteVal 0xdf where
    byteVal :: Proxy# 223 -> Word8#
byteVal Proxy# 223
_ = Word# -> Word8#
wordToWord8# Word#
0xdf##
    {-# INLINE byteVal #-}
instance ByteVal 0xe0 where
    byteVal :: Proxy# 224 -> Word8#
byteVal Proxy# 224
_ = Word# -> Word8#
wordToWord8# Word#
0xe0##
    {-# INLINE byteVal #-}
instance ByteVal 0xe1 where
    byteVal :: Proxy# 225 -> Word8#
byteVal Proxy# 225
_ = Word# -> Word8#
wordToWord8# Word#
0xe1##
    {-# INLINE byteVal #-}
instance ByteVal 0xe2 where
    byteVal :: Proxy# 226 -> Word8#
byteVal Proxy# 226
_ = Word# -> Word8#
wordToWord8# Word#
0xe2##
    {-# INLINE byteVal #-}
instance ByteVal 0xe3 where
    byteVal :: Proxy# 227 -> Word8#
byteVal Proxy# 227
_ = Word# -> Word8#
wordToWord8# Word#
0xe3##
    {-# INLINE byteVal #-}
instance ByteVal 0xe4 where
    byteVal :: Proxy# 228 -> Word8#
byteVal Proxy# 228
_ = Word# -> Word8#
wordToWord8# Word#
0xe4##
    {-# INLINE byteVal #-}
instance ByteVal 0xe5 where
    byteVal :: Proxy# 229 -> Word8#
byteVal Proxy# 229
_ = Word# -> Word8#
wordToWord8# Word#
0xe5##
    {-# INLINE byteVal #-}
instance ByteVal 0xe6 where
    byteVal :: Proxy# 230 -> Word8#
byteVal Proxy# 230
_ = Word# -> Word8#
wordToWord8# Word#
0xe6##
    {-# INLINE byteVal #-}
instance ByteVal 0xe7 where
    byteVal :: Proxy# 231 -> Word8#
byteVal Proxy# 231
_ = Word# -> Word8#
wordToWord8# Word#
0xe7##
    {-# INLINE byteVal #-}
instance ByteVal 0xe8 where
    byteVal :: Proxy# 232 -> Word8#
byteVal Proxy# 232
_ = Word# -> Word8#
wordToWord8# Word#
0xe8##
    {-# INLINE byteVal #-}
instance ByteVal 0xe9 where
    byteVal :: Proxy# 233 -> Word8#
byteVal Proxy# 233
_ = Word# -> Word8#
wordToWord8# Word#
0xe9##
    {-# INLINE byteVal #-}
instance ByteVal 0xea where
    byteVal :: Proxy# 234 -> Word8#
byteVal Proxy# 234
_ = Word# -> Word8#
wordToWord8# Word#
0xea##
    {-# INLINE byteVal #-}
instance ByteVal 0xeb where
    byteVal :: Proxy# 235 -> Word8#
byteVal Proxy# 235
_ = Word# -> Word8#
wordToWord8# Word#
0xeb##
    {-# INLINE byteVal #-}
instance ByteVal 0xec where
    byteVal :: Proxy# 236 -> Word8#
byteVal Proxy# 236
_ = Word# -> Word8#
wordToWord8# Word#
0xec##
    {-# INLINE byteVal #-}
instance ByteVal 0xed where
    byteVal :: Proxy# 237 -> Word8#
byteVal Proxy# 237
_ = Word# -> Word8#
wordToWord8# Word#
0xed##
    {-# INLINE byteVal #-}
instance ByteVal 0xee where
    byteVal :: Proxy# 238 -> Word8#
byteVal Proxy# 238
_ = Word# -> Word8#
wordToWord8# Word#
0xee##
    {-# INLINE byteVal #-}
instance ByteVal 0xef where
    byteVal :: Proxy# 239 -> Word8#
byteVal Proxy# 239
_ = Word# -> Word8#
wordToWord8# Word#
0xef##
    {-# INLINE byteVal #-}
instance ByteVal 0xf0 where
    byteVal :: Proxy# 240 -> Word8#
byteVal Proxy# 240
_ = Word# -> Word8#
wordToWord8# Word#
0xf0##
    {-# INLINE byteVal #-}
instance ByteVal 0xf1 where
    byteVal :: Proxy# 241 -> Word8#
byteVal Proxy# 241
_ = Word# -> Word8#
wordToWord8# Word#
0xf1##
    {-# INLINE byteVal #-}
instance ByteVal 0xf2 where
    byteVal :: Proxy# 242 -> Word8#
byteVal Proxy# 242
_ = Word# -> Word8#
wordToWord8# Word#
0xf2##
    {-# INLINE byteVal #-}
instance ByteVal 0xf3 where
    byteVal :: Proxy# 243 -> Word8#
byteVal Proxy# 243
_ = Word# -> Word8#
wordToWord8# Word#
0xf3##
    {-# INLINE byteVal #-}
instance ByteVal 0xf4 where
    byteVal :: Proxy# 244 -> Word8#
byteVal Proxy# 244
_ = Word# -> Word8#
wordToWord8# Word#
0xf4##
    {-# INLINE byteVal #-}
instance ByteVal 0xf5 where
    byteVal :: Proxy# 245 -> Word8#
byteVal Proxy# 245
_ = Word# -> Word8#
wordToWord8# Word#
0xf5##
    {-# INLINE byteVal #-}
instance ByteVal 0xf6 where
    byteVal :: Proxy# 246 -> Word8#
byteVal Proxy# 246
_ = Word# -> Word8#
wordToWord8# Word#
0xf6##
    {-# INLINE byteVal #-}
instance ByteVal 0xf7 where
    byteVal :: Proxy# 247 -> Word8#
byteVal Proxy# 247
_ = Word# -> Word8#
wordToWord8# Word#
0xf7##
    {-# INLINE byteVal #-}
instance ByteVal 0xf8 where
    byteVal :: Proxy# 248 -> Word8#
byteVal Proxy# 248
_ = Word# -> Word8#
wordToWord8# Word#
0xf8##
    {-# INLINE byteVal #-}
instance ByteVal 0xf9 where
    byteVal :: Proxy# 249 -> Word8#
byteVal Proxy# 249
_ = Word# -> Word8#
wordToWord8# Word#
0xf9##
    {-# INLINE byteVal #-}
instance ByteVal 0xfa where
    byteVal :: Proxy# 250 -> Word8#
byteVal Proxy# 250
_ = Word# -> Word8#
wordToWord8# Word#
0xfa##
    {-# INLINE byteVal #-}
instance ByteVal 0xfb where
    byteVal :: Proxy# 251 -> Word8#
byteVal Proxy# 251
_ = Word# -> Word8#
wordToWord8# Word#
0xfb##
    {-# INLINE byteVal #-}
instance ByteVal 0xfc where
    byteVal :: Proxy# 252 -> Word8#
byteVal Proxy# 252
_ = Word# -> Word8#
wordToWord8# Word#
0xfc##
    {-# INLINE byteVal #-}
instance ByteVal 0xfd where
    byteVal :: Proxy# 253 -> Word8#
byteVal Proxy# 253
_ = Word# -> Word8#
wordToWord8# Word#
0xfd##
    {-# INLINE byteVal #-}
instance ByteVal 0xfe where
    byteVal :: Proxy# 254 -> Word8#
byteVal Proxy# 254
_ = Word# -> Word8#
wordToWord8# Word#
0xfe##
    {-# INLINE byteVal #-}
instance ByteVal 0xff where
    byteVal :: Proxy# 255 -> Word8#
byteVal Proxy# 255
_ = Word# -> Word8#
wordToWord8# Word#
0xff##
    {-# INLINE byteVal #-}

type family Length (a :: [k]) :: Natural where
    Length '[]       = 0
    Length (a ': as) = 1 + Length as

-- | Efficiently reify a list of type-level 'Natural' bytes to to a bytestring
--   builder.
--
-- Attempting to reify a 'Natural' larger than 255 results in a type error.
--
-- This is about as far as one should go for pointless performance here, I
-- should think.
class ReifyBytes (ns :: [Natural]) where reifyBytes :: Builder
instance (n ~ Length ns, KnownNat n, WriteReifiedBytes ns) => ReifyBytes ns where
    reifyBytes :: Builder
reifyBytes = forall s a. Buildable s => FixedPrim a -> a -> BuilderFor s
Mason.primFixed (forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
BI.fixedPrim (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) () -> Ptr Word8 -> IO ()
go) ()
      where
        n :: Natural
n = forall (a :: Natural). KnownNat a => Natural
natVal'' @n
        go :: () -> Ptr Word8 -> IO ()
go = \() (Ptr Addr#
p#) -> forall (ns :: [Natural]). WriteReifiedBytes ns => Addr# -> IO ()
writeReifiedBytes @ns Addr#
p#

-- bit ugly
class WriteReifiedBytes (ns :: [Natural]) where writeReifiedBytes :: Addr# -> IO ()
instance WriteReifiedBytes '[] where writeReifiedBytes :: Addr# -> IO ()
writeReifiedBytes Addr#
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (ByteVal n, WriteReifiedBytes ns) => WriteReifiedBytes (n ': ns) where
    writeReifiedBytes :: Addr# -> IO ()
writeReifiedBytes Addr#
p# =
        case forall o. (State# RealWorld -> o) -> o
runRW# (forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
p# Int#
0# Word8#
w#) of
          State# RealWorld
_ -> forall (ns :: [Natural]). WriteReifiedBytes ns => Addr# -> IO ()
writeReifiedBytes @ns (Addr# -> Int# -> Addr#
plusAddr# Addr#
p# Int#
1#)
      where w# :: Word8#
w# = forall (n :: Natural). ByteVal n => Proxy# n -> Word8#
byteVal @n forall {k} (a :: k). Proxy# a
proxy#