{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternSynonyms     #-}

#include "cbor.h"

#if defined(OPTIMIZE_GMP) && defined(HAVE_GHC_BIGNUM)
{-# LANGUAGE UnboxedSums         #-}
#endif

-- |
-- Module      : Codec.CBOR.Write
-- Copyright   : (c) Duncan Coutts 2015-2017
-- License     : BSD3-style (see LICENSE.txt)
--
-- Maintainer  : duncan@community.haskell.org
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- Functions for writing out CBOR 'Encoding' values in a variety of forms.
--
module Codec.CBOR.Write
  ( toBuilder          -- :: Encoding -> B.Builder
  , toLazyByteString   -- :: Encoding -> L.ByteString
  , toStrictByteString -- :: Encoding -> S.ByteString
  ) where

import           Data.Bits
import           Data.Int

#if ! MIN_VERSION_base(4,11,0)
import           Data.Monoid
#endif

import           Data.Word
import           Foreign.Ptr

import qualified Data.ByteString                       as S
import qualified Data.ByteString.Builder               as B
import qualified Data.ByteString.Builder.Internal      as BI
import           Data.ByteString.Builder.Prim          (condB, (>$<), (>*<))
import qualified Data.ByteString.Builder.Prim          as P
import qualified Data.ByteString.Builder.Prim.Internal as PI
import qualified Data.ByteString.Lazy                  as L
import qualified Data.Text                             as T
import qualified Data.Text.Encoding                    as T
#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Foreign                     as T
#endif

import           Control.Exception.Base                (assert)
import           GHC.Exts
#if defined(OPTIMIZE_GMP)
#if defined(HAVE_GHC_BIGNUM)
import           GHC.IO                                (IO(IO))
import qualified GHC.Num.Integer
import qualified GHC.Num.BigNat                        as Gmp
import qualified GHC.Num.BigNat
import           GHC.Num.BigNat                        (BigNat)
#else
import qualified GHC.Integer.GMP.Internals             as Gmp
import           GHC.Integer.GMP.Internals             (BigNat)
#endif
#endif

#if __GLASGOW_HASKELL__ < 710
import           GHC.Word
#endif

import qualified Codec.CBOR.ByteArray.Sliced           as BAS
import           Codec.CBOR.Encoding
import           Codec.CBOR.Magic

--------------------------------------------------------------------------------

-- | Turn an 'Encoding' into a lazy 'L.ByteString' in CBOR binary
-- format.
--
-- @since 0.2.0.0
toLazyByteString :: Encoding     -- ^ The 'Encoding' of a CBOR value.
                 -> L.ByteString -- ^ The encoded CBOR value.
toLazyByteString :: Encoding -> ByteString
toLazyByteString = Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
toBuilder

-- | Turn an 'Encoding' into a strict 'S.ByteString' in CBOR binary
-- format.
--
-- @since 0.2.0.0
toStrictByteString :: Encoding     -- ^ The 'Encoding' of a CBOR value.
                   -> S.ByteString -- ^ The encoded value.
toStrictByteString :: Encoding -> ByteString
toStrictByteString = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
toBuilder

-- | Turn an 'Encoding' into a 'L.ByteString' 'B.Builder' in CBOR
-- binary format.
--
-- @since 0.2.0.0
toBuilder :: Encoding  -- ^ The 'Encoding' of a CBOR value.
          -> B.Builder -- ^ The encoded value as a 'B.Builder'.
toBuilder :: Encoding -> Builder
toBuilder =
    \(Encoding Tokens -> Tokens
vs0) -> (forall r. BuildStep r -> BuildStep r) -> Builder
BI.builder (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep (Tokens -> Tokens
vs0 Tokens
TkEnd))

buildStep :: Tokens
          -> (BI.BufferRange -> IO (BI.BuildSignal a))
          -> BI.BufferRange
          -> IO (BI.BuildSignal a)
buildStep :: forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs1 BufferRange -> IO (BuildSignal a)
k (BI.BufferRange Ptr Word8
op0 Ptr Word8
ope0) =
    Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs1 Ptr Word8
op0
  where
    go :: Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs !Ptr Word8
op
      | Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bound forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope0 = case Tokens
vs of
          TkWord     Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
wordMP     Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkWord64   Word64
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
word64MP   Word64
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

          TkInt      Int
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int
intMP      Int
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkInt64    Int64
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int64
int64MP    Int64
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

          TkBytes        ByteString
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                    (ByteString -> Builder
bytesMP  ByteString
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
                                    (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
          TkByteArray    SlicedByteArray
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                    (SlicedByteArray -> Builder
byteArrayMP SlicedByteArray
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
                                    (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)

          TkUtf8ByteArray SlicedByteArray
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                     (SlicedByteArray -> Builder
utf8ByteArrayMP SlicedByteArray
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
                                     (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
          TkString        Text
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                     (Text -> Builder
stringMP Text
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
                                     (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)

          TkBytesBegin Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
bytesBeginMP  () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkStringBegin Tokens
vs'-> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
stringBeginMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

          TkListLen  Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
arrayLenMP     Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkListBegin  Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
arrayBeginMP  () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

          TkMapLen   Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
mapLenMP       Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkMapBegin   Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
mapBeginMP    () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

          TkTag      Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
tagMP          Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkTag64    Word64
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
tag64MP        Word64
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

#if defined(OPTIMIZE_GMP)
          -- This code is specialized for GMP implementation of Integer. By
          -- looking directly at the constructors we can avoid some checks.
          -- S# hold an Int, so we can just use intMP.
          TkInteger (SmallInt Int#
i) Tokens
vs' ->
               forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int
intMP (Int# -> Int
I# Int#
i) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          -- PosBigInt is guaranteed to be > 0.
          TkInteger integer :: Integer
integer@(PosBigInt BigNat#
bigNat) Tokens
vs'
            | Integer
integer forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64) ->
                forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
word64MP (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
            | Bool
otherwise ->
               let buffer :: BufferRange
buffer = Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0
               in forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                    (BigNat# -> Builder
bigNatMP BigNat#
bigNat) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k) BufferRange
buffer
          -- Jn# is guaranteed to be < 0.
          TkInteger integer :: Integer
integer@(NegBigInt BigNat#
bigNat) Tokens
vs'
            | Integer
integer forall a. Ord a => a -> a -> Bool
>= -Integer
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64) ->
                forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
negInt64MP (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Integer
1 forall a. Num a => a -> a -> a
- Integer
integer)) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
            | Bool
otherwise ->
                let buffer :: BufferRange
buffer = Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0
                in forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                     (BigNat# -> Builder
negBigNatMP BigNat#
bigNat) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k) BufferRange
buffer
#else
          TkInteger  x vs'
            | x >= 0
            , x <= fromIntegral (maxBound :: Word64)
                            -> PI.runB word64MP (fromIntegral x) op >>= go vs'
            | x <  0
            , x >= -1 - fromIntegral (maxBound :: Word64)
                            -> PI.runB negInt64MP (fromIntegral (-1 - x)) op >>= go vs'
            | otherwise     -> BI.runBuilderWith
                                 (integerMP x) (buildStep vs' k)
                                 (BI.BufferRange op ope0)
#endif

          TkBool Bool
False Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
falseMP   () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkBool Bool
True  Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
trueMP    () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkNull       Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
nullMP    () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkUndef      Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
undefMP   () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkSimple   Word8
w Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word8
simpleMP   Word8
w Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkFloat16  Float
f Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Float
halfMP     Float
f Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkFloat32  Float
f Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Float
floatMP    Float
f Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkFloat64  Double
f Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Double
doubleMP   Double
f Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
          TkBreak      Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
breakMP   () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'

          TkEncoded  ByteString
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                (ByteString -> Builder
B.byteString ByteString
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
                                (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)

          Tokens
TkEnd            -> BufferRange -> IO (BuildSignal a)
k (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)

      | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
BI.bufferFull Int
bound Ptr Word8
op (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs BufferRange -> IO (BuildSignal a)
k)

    -- The maximum size in bytes of the fixed-size encodings
    bound :: Int
    bound :: Int
bound = Int
9

header :: P.BoundedPrim Word8
header :: BoundedPrim Word8
header = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded FixedPrim Word8
P.word8

constHeader :: Word8 -> P.BoundedPrim ()
constHeader :: Word8 -> BoundedPrim ()
constHeader Word8
h = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (forall a b. a -> b -> a
const Word8
h forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
P.word8)

withHeader :: P.FixedPrim a -> P.BoundedPrim (Word8, a)
withHeader :: forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim a
p = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim a
p)

withConstHeader :: Word8 -> P.FixedPrim a -> P.BoundedPrim a
withConstHeader :: forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
h FixedPrim a
p = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded ((,) Word8
h forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim a
p))


{-
From RFC 7049:

   Major type 0:  an unsigned integer.  The 5-bit additional information
      is either the integer itself (for additional information values 0
      through 23) or the length of additional data.  Additional
      information 24 means the value is represented in an additional
      uint8_t, 25 means a uint16_t, 26 means a uint32_t, and 27 means a
      uint64_t.  For example, the integer 10 is denoted as the one byte
      0b000_01010 (major type 0, additional information 10).  The
      integer 500 would be 0b000_11001 (major type 0, additional
      information 25) followed by the two bytes 0x01f4, which is 500 in
      decimal.

-}

{-# INLINE wordMP #-}
wordMP :: P.BoundedPrim Word
wordMP :: BoundedPrim Word
wordMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
24 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
25 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
26 FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
27 FixedPrim Word64
P.word64BE)
#else
                          (fromIntegral >$< withConstHeader 26 P.word32BE)
#endif

{-# INLINE word64MP #-}
word64MP :: P.BoundedPrim Word64
word64MP :: BoundedPrim Word64
word64MP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
24 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
25 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
26 FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
27 FixedPrim Word64
P.word64BE)

{-
From RFC 7049:

   Major type 1:  a negative integer.  The encoding follows the rules
      for unsigned integers (major type 0), except that the value is
      then -1 minus the encoded unsigned integer.  For example, the
      integer -500 would be 0b001_11001 (major type 1, additional
      information 25) followed by the two bytes 0x01f3, which is 499 in
      decimal.
-}

negInt64MP :: P.BoundedPrim Word64
negInt64MP :: BoundedPrim Word64
negInt64MP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
0x20 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x38 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x39 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x3a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x3b FixedPrim Word64
P.word64BE)

{-
   Major types 0 and 1 are designed in such a way that they can be
   encoded in C from a signed integer without actually doing an if-then-
   else for positive/negative (Figure 2).  This uses the fact that
   (-1-n), the transformation for major type 1, is the same as ~n
   (bitwise complement) in C unsigned arithmetic; ~n can then be
   expressed as (-1)^n for the negative case, while 0^n leaves n
   unchanged for non-negative.  The sign of a number can be converted to
   -1 for negative and 0 for non-negative (0 or positive) by arithmetic-
   shifting the number by one bit less than the bit length of the number
   (for example, by 63 for 64-bit numbers).

   void encode_sint(int64_t n) {
     uint64t ui = n >> 63;    // extend sign to whole length
     mt = ui & 0x20;          // extract major type
     ui ^= n;                 // complement negatives
     if (ui < 24)
       *p++ = mt + ui;
     else if (ui < 256) {
       *p++ = mt + 24;
       *p++ = ui;
     } else
          ...

            Figure 2: Pseudocode for Encoding a Signed Integer
-}

{-# INLINE intMP #-}
intMP :: P.BoundedPrim Int
intMP :: BoundedPrim Int
intMP =
    Int -> (Word8, Word)
prep forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0x17)       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) ((Word8, Word) -> Word8
encIntSmall forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0xff)       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt8  forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt16 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt32 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word32
P.word32BE)
                                    (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt64 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word64
P.word64BE)
#else
                                    (encInt32 >$< withHeader P.word32BE)
#endif
    )
  where
    prep :: Int -> (Word8, Word)
    prep :: Int -> (Word8, Word)
prep Int
n = (Word8
mt, Word
ui)
      where
        sign :: Word     -- extend sign to whole length
        sign :: Word
sign = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
intBits)
#if MIN_VERSION_base(4,7,0)
        intBits :: Int
intBits = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: Int) forall a. Num a => a -> a -> a
- Int
1
#else
        intBits = bitSize (undefined :: Int) - 1
#endif

        mt   :: Word8    -- select major type
        mt :: Word8
mt   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
sign forall a. Bits a => a -> a -> a
.&. Word
0x20)

        ui   :: Word     -- complement negatives
        ui :: Word
ui   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Bits a => a -> a -> a
`xor` Word
sign

    encIntSmall :: (Word8, Word) -> Word8
    encIntSmall :: (Word8, Word) -> Word8
encIntSmall (Word8
mt, Word
ui) =  Word8
mt forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ui
    encInt8 :: (a, a) -> (a, b)
encInt8     (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
24, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt16 :: (a, a) -> (a, b)
encInt16    (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
25, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt32 :: (a, a) -> (a, b)
encInt32    (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
26, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
#if defined(ARCH_64bit)
    encInt64 :: (a, a) -> (a, b)
encInt64    (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
27, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
#endif


{-# INLINE int64MP #-}
int64MP :: P.BoundedPrim Int64
int64MP :: BoundedPrim Int64
int64MP =
    Int64 -> (Word8, Word64)
prep forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a}. (Integral a, Num a) => (a, a) -> a
encIntSmall forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt8  forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt16 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
      forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt32 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word32
P.word32BE)
                                    (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt64 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word64
P.word64BE)
    )
  where
    prep :: Int64 -> (Word8, Word64)
    prep :: Int64 -> (Word8, Word64)
prep Int64
n = (Word8
mt, Word64
ui)
      where
        sign :: Word64   -- extend sign to whole length
        sign :: Word64
sign = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
n forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
intBits)
#if MIN_VERSION_base(4,7,0)
        intBits :: Int
intBits = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: Int64) forall a. Num a => a -> a -> a
- Int
1
#else
        intBits = bitSize (undefined :: Int64) - 1
#endif

        mt   :: Word8    -- select major type
        mt :: Word8
mt   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
sign forall a. Bits a => a -> a -> a
.&. Word64
0x20)

        ui   :: Word64   -- complement negatives
        ui :: Word64
ui   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n forall a. Bits a => a -> a -> a
`xor` Word64
sign

    encIntSmall :: (a, a) -> a
encIntSmall (a
mt, a
ui) =  a
mt forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui
    encInt8 :: (a, a) -> (a, b)
encInt8     (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
24, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt16 :: (a, a) -> (a, b)
encInt16    (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
25, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt32 :: (a, a) -> (a, b)
encInt32    (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
26, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt64 :: (a, a) -> (a, b)
encInt64    (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
27, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)

{-
   Major type 2:  a byte string.  The string's length in bytes is
      represented following the rules for positive integers (major type
      0).  For example, a byte string whose length is 5 would have an
      initial byte of 0b010_00101 (major type 2, additional information
      5 for the length), followed by 5 bytes of binary content.  A byte
      string whose length is 500 would have 3 initial bytes of
      0b010_11001 (major type 2, additional information 25 to indicate a
      two-byte length) followed by the two bytes 0x01f4 for a length of
      500, followed by 500 bytes of binary content.
-}

bytesMP :: S.ByteString -> B.Builder
bytesMP :: ByteString -> Builder
bytesMP ByteString
bs =
    forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs

bytesLenMP :: P.BoundedPrim Word
bytesLenMP :: BoundedPrim Word
bytesLenMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x40 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x58 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x59 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x5a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x5b FixedPrim Word64
P.word64BE)
byteArrayMP :: BAS.SlicedByteArray -> B.Builder
byteArrayMP :: SlicedByteArray -> Builder
byteArrayMP SlicedByteArray
ba =
    forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP Word
n forall a. Semigroup a => a -> a -> a
<> SlicedByteArray -> Builder
BAS.toBuilder SlicedByteArray
ba
  where n :: Word
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> Int
BAS.sizeofSlicedByteArray SlicedByteArray
ba

bytesBeginMP :: P.BoundedPrim ()
bytesBeginMP :: BoundedPrim ()
bytesBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0x5f

{-
   Major type 3:  a text string, specifically a string of Unicode
      characters that is encoded as UTF-8 [RFC3629].  The format of this
      type is identical to that of byte strings (major type 2), that is,
      as with major type 2, the length gives the number of bytes.  This
      type is provided for systems that need to interpret or display
      human-readable text, and allows the differentiation between
      unstructured bytes and text that has a specified repertoire and
      encoding.  In contrast to formats such as JSON, the Unicode
      characters in this type are never escaped.  Thus, a newline
      character (U+000A) is always represented in a string as the byte
      0x0a, and never as the bytes 0x5c6e (the characters "\" and "n")
      or as 0x5c7530303061 (the characters "\", "u", "0", "0", "0", and
      "a").
-}

stringMP :: T.Text -> B.Builder
stringMP :: Text -> Builder
stringMP Text
t =
#if MIN_VERSION_text(2,0,0)
    P.primBounded stringLenMP (fromIntegral $ T.lengthWord8 t) <> T.encodeUtf8Builder t
#else
    forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
stringLenMP (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs
  where
    bs :: ByteString
bs  = Text -> ByteString
T.encodeUtf8 Text
t
#endif

stringLenMP :: P.BoundedPrim Word
stringLenMP :: BoundedPrim Word
stringLenMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x60 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x78 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x79 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x7a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x7b FixedPrim Word64
P.word64BE)

stringBeginMP :: P.BoundedPrim ()
stringBeginMP :: BoundedPrim ()
stringBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0x7f

utf8ByteArrayMP :: BAS.SlicedByteArray -> B.Builder
utf8ByteArrayMP :: SlicedByteArray -> Builder
utf8ByteArrayMP SlicedByteArray
t =
    forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
stringLenMP Word
n forall a. Semigroup a => a -> a -> a
<> SlicedByteArray -> Builder
BAS.toBuilder SlicedByteArray
t
  where
    n :: Word
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> Int
BAS.sizeofSlicedByteArray SlicedByteArray
t

{-
   Major type 4:  an array of data items.  Arrays are also called lists,
      sequences, or tuples.  The array's length follows the rules for
      byte strings (major type 2), except that the length denotes the
      number of data items, not the length in bytes that the array takes
      up.  Items in an array do not need to all be of the same type.
      For example, an array that contains 10 items of any type would
      have an initial byte of 0b100_01010 (major type of 4, additional
      information of 10 for the length) followed by the 10 remaining
      items.
-}

arrayLenMP :: P.BoundedPrim Word
arrayLenMP :: BoundedPrim Word
arrayLenMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x80 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x98 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x99 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x9a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x9b FixedPrim Word64
P.word64BE)

arrayBeginMP :: P.BoundedPrim ()
arrayBeginMP :: BoundedPrim ()
arrayBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0x9f

{-
   Major type 5:  a map of pairs of data items.  Maps are also called
      tables, dictionaries, hashes, or objects (in JSON).  A map is
      comprised of pairs of data items, each pair consisting of a key
      that is immediately followed by a value.  The map's length follows
      the rules for byte strings (major type 2), except that the length
      denotes the number of pairs, not the length in bytes that the map
      takes up.  For example, a map that contains 9 pairs would have an
      initial byte of 0b101_01001 (major type of 5, additional
      information of 9 for the number of pairs) followed by the 18
      remaining items.  The first item is the first key, the second item
      is the first value, the third item is the second key, and so on.
      A map that has duplicate keys may be well-formed, but it is not
      valid, and thus it causes indeterminate decoding; see also
      Section 3.7.
-}

mapLenMP :: P.BoundedPrim Word
mapLenMP :: BoundedPrim Word
mapLenMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0xa0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xb8 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xb9 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xba FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xbb FixedPrim Word64
P.word64BE)

mapBeginMP :: P.BoundedPrim ()
mapBeginMP :: BoundedPrim ()
mapBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0xbf

{-
   Major type 6:  optional semantic tagging of other major types.

      In CBOR, a data item can optionally be preceded by a tag to give it
      additional semantics while retaining its structure.  The tag is major
      type 6, and represents an integer number as indicated by the tag's
      integer value; the (sole) data item is carried as content data.

      The initial bytes of the tag follow the rules for positive integers
      (major type 0).
-}

tagMP :: P.BoundedPrim Word
tagMP :: BoundedPrim Word
tagMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0xc0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd8 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd9 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xda FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xdb FixedPrim Word64
P.word64BE)
#else
                          (fromIntegral >$< withConstHeader 0xda P.word32BE)
#endif

tag64MP :: P.BoundedPrim Word64
tag64MP :: BoundedPrim Word64
tag64MP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
0xc0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd8 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd9 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xda FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xdb FixedPrim Word64
P.word64BE)

{-
   Major type 7:  floating-point numbers and simple data types that need
      no content, as well as the "break" stop code.

      Major type 7 is for two types of data: floating-point numbers and
      "simple values" that do not need any content.  Each value of the
      5-bit additional information in the initial byte has its own separate
      meaning, as defined in Table 1.  Like the major types for integers,
      items of this major type do not carry content data; all the
      information is in the initial bytes.

    +-------------+--------------------------------------------------+
    | 5-Bit Value | Semantics                                        |
    +-------------+--------------------------------------------------+
    | 0..23       | Simple value (value 0..23)                       |
    |             |                                                  |
    | 24          | Simple value (value 32..255 in following byte)   |
    |             |                                                  |
    | 25          | IEEE 754 Half-Precision Float (16 bits follow)   |
    |             |                                                  |
    | 26          | IEEE 754 Single-Precision Float (32 bits follow) |
    |             |                                                  |
    | 27          | IEEE 754 Double-Precision Float (64 bits follow) |
    |             |                                                  |
    | 28-30       | (Unassigned)                                     |
    |             |                                                  |
    | 31          | "break" stop code for indefinite-length items    |
    +-------------+--------------------------------------------------+
-}

simpleMP :: P.BoundedPrim Word8
simpleMP :: BoundedPrim Word8
simpleMP =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word8
0x17) ((Word8
0xe0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
                    (forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xf8 FixedPrim Word8
P.word8)

falseMP :: P.BoundedPrim ()
falseMP :: BoundedPrim ()
falseMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf4

trueMP :: P.BoundedPrim ()
trueMP :: BoundedPrim ()
trueMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf5

nullMP :: P.BoundedPrim ()
nullMP :: BoundedPrim ()
nullMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf6

undefMP :: P.BoundedPrim ()
undefMP :: BoundedPrim ()
undefMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf7

-- Canonical encoding of a NaN as per RFC 7049, section 3.9.
canonicalNaN :: PI.BoundedPrim a
canonicalNaN :: forall a. BoundedPrim a
canonicalNaN = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Word8
0xf9, (Word8
0x7e, Word8
0x00))
                                   forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
P.word8

halfMP :: P.BoundedPrim Float
halfMP :: BoundedPrim Float
halfMP = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB forall a. RealFloat a => a -> Bool
isNaN forall a. BoundedPrim a
canonicalNaN
                     (Float -> Word16
floatToWord16 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xf9 FixedPrim Word16
P.word16BE)

floatMP :: P.BoundedPrim Float
floatMP :: BoundedPrim Float
floatMP = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB forall a. RealFloat a => a -> Bool
isNaN forall a. BoundedPrim a
canonicalNaN
                      (forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xfa FixedPrim Float
P.floatBE)

doubleMP :: P.BoundedPrim Double
doubleMP :: BoundedPrim Double
doubleMP = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB forall a. RealFloat a => a -> Bool
isNaN forall a. BoundedPrim a
canonicalNaN
                       (forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xfb FixedPrim Double
P.doubleBE)

breakMP :: P.BoundedPrim ()
breakMP :: BoundedPrim ()
breakMP = Word8 -> BoundedPrim ()
constHeader Word8
0xff

#if defined(OPTIMIZE_GMP)
-- ---------------------------------------- --
-- Implementation optimized for integer-gmp --
-- ---------------------------------------- --

-- Below is where we try to abstract over the differences between the legacy
-- integer-gmp interface and ghc-bignum, shipped in GHC >= 9.0.

-- | Write the limbs of a 'BigNat' to the given address in big-endian byte
-- ordering.
exportBigNatToAddr :: BigNat -> Addr# -> IO Word

#if defined(HAVE_GHC_BIGNUM)

{-# COMPLETE SmallInt, PosBigInt, NegBigInt #-}
pattern SmallInt :: Int# -> Integer
pattern $bSmallInt :: Int# -> Integer
$mSmallInt :: forall {r}. Integer -> (Int# -> r) -> ((# #) -> r) -> r
SmallInt  n = GHC.Num.Integer.IS n

pattern PosBigInt, NegBigInt :: GHC.Num.BigNat.BigNat# -> Integer
pattern $bPosBigInt :: BigNat# -> Integer
$mPosBigInt :: forall {r}. Integer -> (BigNat# -> r) -> ((# #) -> r) -> r
PosBigInt n = GHC.Num.Integer.IP n
pattern $bNegBigInt :: BigNat# -> Integer
$mNegBigInt :: forall {r}. Integer -> (BigNat# -> r) -> ((# #) -> r) -> r
NegBigInt n = GHC.Num.Integer.IN n

bigNatSizeInBytes :: GHC.Num.BigNat.BigNat -> Word
bigNatSizeInBytes :: BigNat -> Word
bigNatSizeInBytes BigNat
bigNat =
  Word -> BigNat# -> Word
Gmp.bigNatSizeInBase Word
256 (BigNat -> BigNat#
GHC.Num.BigNat.unBigNat BigNat
bigNat)

bigNatMP :: GHC.Num.BigNat.BigNat# -> B.Builder
bigNatMP :: BigNat# -> Builder
bigNatMP BigNat#
n = forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
header Word8
0xc2 forall a. Semigroup a => a -> a -> a
<> BigNat -> Builder
bigNatToBuilder (BigNat# -> BigNat
GHC.Num.BigNat.BN# BigNat#
n)

negBigNatMP :: GHC.Num.BigNat.BigNat# -> B.Builder
negBigNatMP :: BigNat# -> Builder
negBigNatMP BigNat#
n =
  -- If value `n` is stored in CBOR, it is interpreted as -1 - n. Since BigNat
  -- already represents n (note: it's unsigned), we simply decrement it to get
  -- the correct encoding.
     forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
header Word8
0xc3
  forall a. Semigroup a => a -> a -> a
<> BigNat -> Builder
bigNatToBuilder (BigNat -> BigNat
subtractOneBigNat (BigNat# -> BigNat
GHC.Num.BigNat.BN# BigNat#
n))
  where
    subtractOneBigNat :: BigNat -> BigNat
subtractOneBigNat (GHC.Num.BigNat.BN# BigNat#
nat) =
      case BigNat# -> Word# -> (# (# #) | BigNat# #)
GHC.Num.BigNat.bigNatSubWord# BigNat#
nat Word#
1## of
        (#       | BigNat#
r #) -> BigNat# -> BigNat
GHC.Num.BigNat.BN# BigNat#
r
        (# (# #) | #)   -> forall a. HasCallStack => [Char] -> a
error [Char]
"subtractOneBigNat: impossible"

exportBigNatToAddr :: BigNat -> Addr# -> IO Word
exportBigNatToAddr (GHC.Num.BigNat.BN# BigNat#
b) Addr#
addr = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  -- The last parameter (`1#`) makes the export function use big endian encoding.
  case forall s.
BigNat# -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
GHC.Num.BigNat.bigNatToAddr# BigNat#
b Addr#
addr Int#
1# State# RealWorld
s of
    (# State# RealWorld
s', Word#
w #) -> (# State# RealWorld
s', Word# -> Word
W# Word#
w #)
#else /* HAVE_GHC_BIGNUM */

{-# COMPLETE SmallInt, PosBigInt, NegBigInt #-}
pattern SmallInt :: Int# -> Integer
pattern SmallInt  n = Gmp.S# n

pattern PosBigInt :: BigNat -> Integer
pattern NegBigInt :: BigNat -> Integer
pattern PosBigInt n = Gmp.Jp# n
pattern NegBigInt n = Gmp.Jn# n

bigNatSizeInBytes :: BigNat -> Word
bigNatSizeInBytes bigNat = W# (Gmp.sizeInBaseBigNat bigNat 256#)

bigNatMP :: BigNat -> B.Builder
bigNatMP n = P.primBounded header 0xc2 <> bigNatToBuilder n

negBigNatMP :: BigNat -> B.Builder
negBigNatMP n =
  -- If value `n` is stored in CBOR, it is interpreted as -1 - n. Since BigNat
  -- already represents n (note: it's unsigned), we simply decrement it to get
  -- the correct encoding.
     P.primBounded header 0xc3
  <> bigNatToBuilder (subtractOneBigNat n)
  where
    subtractOneBigNat m = Gmp.minusBigNatWord m (int2Word# 1#)

exportBigNatToAddr bigNat addr# =
  -- The last parameter (`1#`) makes the export function use big endian encoding.
  Gmp.exportBigNatToAddr bigNat addr# 1#
#endif /* HAVE_GHC_BIGNUM */

bigNatToBuilder :: BigNat -> B.Builder
bigNatToBuilder :: BigNat -> Builder
bigNatToBuilder = BigNat -> Builder
bigNatBuilder
  where
    bigNatBuilder :: BigNat -> B.Builder
    bigNatBuilder :: BigNat -> Builder
bigNatBuilder BigNat
bigNat =
        let sizeW :: Word
sizeW = BigNat -> Word
bigNatSizeInBytes BigNat
bigNat
#if MIN_VERSION_bytestring(0,10,12)
            bounded :: BoundedPrim BigNat
bounded = forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
PI.boundedPrim (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
sizeW) (forall a. Word -> BigNat -> Ptr a -> IO (Ptr a)
dumpBigNat Word
sizeW)
#else
            bounded = PI.boudedPrim (fromIntegral sizeW) (dumpBigNat sizeW)
#endif
        in forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP Word
sizeW forall a. Semigroup a => a -> a -> a
<> forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim BigNat
bounded BigNat
bigNat

    dumpBigNat :: Word -> BigNat -> Ptr a -> IO (Ptr a)
    dumpBigNat :: forall a. Word -> BigNat -> Ptr a -> IO (Ptr a)
dumpBigNat (W# Word#
sizeW#) BigNat
bigNat ptr :: Ptr a
ptr@(Ptr Addr#
addr#) = do
        (W# Word#
written#) <- BigNat -> Addr# -> IO Word
exportBigNatToAddr BigNat
bigNat Addr#
addr#
        let !newPtr :: Ptr b
newPtr = Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int# -> Int
I# (Word# -> Int#
word2Int# Word#
written#))
            sanity :: Bool
sanity = Int# -> Bool
isTrue# (Word#
sizeW# Word# -> Word# -> Int#
`eqWord#` Word#
written#)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Bool -> a -> a
assert Bool
sanity forall {b}. Ptr b
newPtr

#else /* OPTIMIZE_GMP */

-- ---------------------- --
-- Generic implementation --
-- ---------------------- --
integerMP :: Integer -> B.Builder
integerMP n
  | n >= 0    = P.primBounded header 0xc2 <> integerToBuilder n
  | otherwise = P.primBounded header 0xc3 <> integerToBuilder (-1 - n)

integerToBuilder :: Integer -> B.Builder
integerToBuilder n = bytesMP (integerToBytes n)

integerToBytes :: Integer -> S.ByteString
integerToBytes n0
  | n0 == 0   = S.pack [0]
  | otherwise = S.pack (reverse (go n0))
  where
    go n | n == 0    = []
         | otherwise = narrow n : go (n `shiftR` 8)

    narrow :: Integer -> Word8
    narrow = fromIntegral
#endif /* OPTIMIZE_GMP */