{-# 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 (Builder -> ByteString)
-> (Encoding -> Builder) -> Encoding -> ByteString
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 (ByteString -> ByteString)
-> (Encoding -> ByteString) -> Encoding -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (Encoding -> Builder) -> Encoding -> ByteString
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 (Tokens
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
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 :: 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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bound Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope0 = case Tokens
vs of
          TkWord     Word
x Tokens
vs' -> BoundedPrim Word -> Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
wordMP     Word
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Word64 -> Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
word64MP   Word64
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int
intMP      Int
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Int64 -> Int64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int64
int64MP    Int64
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                    (ByteString -> Builder
bytesMP  ByteString
x) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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' -> Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                    (SlicedByteArray -> Builder
byteArrayMP SlicedByteArray
x) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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' -> Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                     (SlicedByteArray -> Builder
utf8ByteArrayMP SlicedByteArray
x) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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' -> Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                     (Text -> Builder
stringMP Text
x) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
bytesBeginMP  () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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'-> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
stringBeginMP () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Word -> Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
arrayLenMP     Word
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
arrayBeginMP  () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Word -> Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
mapLenMP       Word
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
mapBeginMP    () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Word -> Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
tagMP          Word
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Word64 -> Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
tag64MP        Word64
x Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' ->
               BoundedPrim Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int
intMP (Int# -> Int
I# Int#
i) Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) ->
                BoundedPrim Word64 -> Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
word64MP (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer) Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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 Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                    (BigNat -> Builder
bigNatMP BigNat
bigNat) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) ->
                BoundedPrim Word64 -> Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
negInt64MP (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
integer)) Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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 Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                     (BigNat -> Builder
negBigNatMP BigNat
bigNat) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
falseMP   () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
trueMP    () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
nullMP    () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
undefMP   () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word8
simpleMP   Word8
w Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Float -> Float -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Float
halfMP     Float
f Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Float -> Float -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Float
floatMP    Float
f Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim Double -> Double -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Double
doubleMP   Double
f Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> BoundedPrim () -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
breakMP   () Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
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' -> Builder
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
                                (ByteString -> Builder
B.byteString ByteString
x) (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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 = BuildSignal a -> IO (BuildSignal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int
-> Ptr Word8
-> (BufferRange -> IO (BuildSignal a))
-> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
BI.bufferFull Int
bound Ptr Word8
op (Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
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 = FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded FixedPrim Word8
P.word8

constHeader :: Word8 -> P.BoundedPrim ()
constHeader :: Word8 -> BoundedPrim ()
constHeader Word8
h = FixedPrim () -> BoundedPrim ()
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (Word8 -> () -> Word8
forall a b. a -> b -> a
const Word8
h (() -> Word8) -> FixedPrim Word8 -> FixedPrim ()
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 :: FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim a
p = FixedPrim (Word8, a) -> BoundedPrim (Word8, a)
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim Word8
P.word8 FixedPrim Word8 -> FixedPrim a -> FixedPrim (Word8, a)
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 :: Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
h FixedPrim a
p = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded ((,) Word8
h (a -> (Word8, a)) -> FixedPrim (Word8, a) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Word8
P.word8 FixedPrim Word8 -> FixedPrim a -> FixedPrim (Word8, a)
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 =
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
24 FixedPrim Word8
P.word8) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
25 FixedPrim Word16
P.word16BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
26 FixedPrim Word32
P.word32BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
                          (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
24 FixedPrim Word8
P.word8) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
25 FixedPrim Word16
P.word16BE) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
26 FixedPrim Word32
P.word32BE) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
                          (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> (Word64 -> Word64) -> Word64 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
0x20 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+) (Word64 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x38 FixedPrim Word8
P.word8) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x39 FixedPrim Word16
P.word16BE) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x3a FixedPrim Word32
P.word32BE) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
                          (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 (Int -> (Word8, Word))
-> BoundedPrim (Word8, Word) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (
      ((Word8, Word) -> Bool)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Bool) -> ((Word8, Word) -> Word) -> (Word8, Word) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word) -> Word
forall a b. (a, b) -> b
snd) ((Word8, Word) -> Word8
encIntSmall ((Word8, Word) -> Word8)
-> BoundedPrim Word8 -> BoundedPrim (Word8, Word)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim (Word8, Word) -> BoundedPrim (Word8, Word))
-> BoundedPrim (Word8, Word) -> BoundedPrim (Word8, Word)
forall a b. (a -> b) -> a -> b
$
      ((Word8, Word) -> Bool)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Bool) -> ((Word8, Word) -> Word) -> (Word8, Word) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word) -> Word
forall a b. (a, b) -> b
snd) ((Word8, Word) -> (Word8, Word8)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt8  ((Word8, Word) -> (Word8, Word8))
-> BoundedPrim (Word8, Word8) -> BoundedPrim (Word8, Word)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8 -> BoundedPrim (Word8, Word8)
forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word8
P.word8) (BoundedPrim (Word8, Word) -> BoundedPrim (Word8, Word))
-> BoundedPrim (Word8, Word) -> BoundedPrim (Word8, Word)
forall a b. (a -> b) -> a -> b
$
      ((Word8, Word) -> Bool)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Bool) -> ((Word8, Word) -> Word) -> (Word8, Word) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word) -> Word
forall a b. (a, b) -> b
snd) ((Word8, Word) -> (Word8, Word16)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt16 ((Word8, Word) -> (Word8, Word16))
-> BoundedPrim (Word8, Word16) -> BoundedPrim (Word8, Word)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16 -> BoundedPrim (Word8, Word16)
forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word16
P.word16BE) (BoundedPrim (Word8, Word) -> BoundedPrim (Word8, Word))
-> BoundedPrim (Word8, Word) -> BoundedPrim (Word8, Word)
forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
      ((Word8, Word) -> Bool)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
-> BoundedPrim (Word8, Word)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Bool) -> ((Word8, Word) -> Word) -> (Word8, Word) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word) -> Word
forall a b. (a, b) -> b
snd) ((Word8, Word) -> (Word8, Word32)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt32 ((Word8, Word) -> (Word8, Word32))
-> BoundedPrim (Word8, Word32) -> BoundedPrim (Word8, Word)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32 -> BoundedPrim (Word8, Word32)
forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word32
P.word32BE)
                                    ((Word8, Word) -> (Word8, Word64)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt64 ((Word8, Word) -> (Word8, Word64))
-> BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64 -> BoundedPrim (Word8, Word64)
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 = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
intBits)
#if MIN_VERSION_base(4,7,0)
        intBits :: Int
intBits = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. HasCallStack => a
undefined :: Int) Int -> Int -> 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   = Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
sign Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x20)

        ui   :: Word     -- complement negatives
        ui :: Word
ui   = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Word -> Word -> Word
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 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ui
    encInt8 :: (a, a) -> (a, b)
encInt8     (a
mt, a
ui) = (a
mt a -> a -> a
forall a. Num a => a -> a -> a
+ a
24, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt16 :: (a, a) -> (a, b)
encInt16    (a
mt, a
ui) = (a
mt a -> a -> a
forall a. Num a => a -> a -> a
+ a
25, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt32 :: (a, a) -> (a, b)
encInt32    (a
mt, a
ui) = (a
mt a -> a -> a
forall a. Num a => a -> a -> a
+ a
26, a -> b
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
27, a -> b
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 (Int64 -> (Word8, Word64))
-> BoundedPrim (Word8, Word64) -> BoundedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (
      ((Word8, Word64) -> Bool)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (Word64 -> Bool)
-> ((Word8, Word64) -> Word64) -> (Word8, Word64) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word64) -> Word64
forall a b. (a, b) -> b
snd) ((Word8, Word64) -> Word8
forall a a. (Integral a, Num a) => (a, a) -> a
encIntSmall ((Word8, Word64) -> Word8)
-> BoundedPrim Word8 -> BoundedPrim (Word8, Word64)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64))
-> BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64)
forall a b. (a -> b) -> a -> b
$
      ((Word8, Word64) -> Bool)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (Word64 -> Bool)
-> ((Word8, Word64) -> Word64) -> (Word8, Word64) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word64) -> Word64
forall a b. (a, b) -> b
snd) ((Word8, Word64) -> (Word8, Word8)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt8  ((Word8, Word64) -> (Word8, Word8))
-> BoundedPrim (Word8, Word8) -> BoundedPrim (Word8, Word64)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8 -> BoundedPrim (Word8, Word8)
forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word8
P.word8) (BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64))
-> BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64)
forall a b. (a -> b) -> a -> b
$
      ((Word8, Word64) -> Bool)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (Word64 -> Bool)
-> ((Word8, Word64) -> Word64) -> (Word8, Word64) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word64) -> Word64
forall a b. (a, b) -> b
snd) ((Word8, Word64) -> (Word8, Word16)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt16 ((Word8, Word64) -> (Word8, Word16))
-> BoundedPrim (Word8, Word16) -> BoundedPrim (Word8, Word64)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16 -> BoundedPrim (Word8, Word16)
forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word16
P.word16BE) (BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64))
-> BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64)
forall a b. (a -> b) -> a -> b
$
      ((Word8, Word64) -> Bool)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
-> BoundedPrim (Word8, Word64)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (Word64 -> Bool)
-> ((Word8, Word64) -> Word64) -> (Word8, Word64) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word64) -> Word64
forall a b. (a, b) -> b
snd) ((Word8, Word64) -> (Word8, Word32)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt32 ((Word8, Word64) -> (Word8, Word32))
-> BoundedPrim (Word8, Word32) -> BoundedPrim (Word8, Word64)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32 -> BoundedPrim (Word8, Word32)
forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word32
P.word32BE)
                                    ((Word8, Word64) -> (Word8, Word64)
forall a a b. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt64 ((Word8, Word64) -> (Word8, Word64))
-> BoundedPrim (Word8, Word64) -> BoundedPrim (Word8, Word64)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64 -> BoundedPrim (Word8, Word64)
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 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
n Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
intBits)
#if MIN_VERSION_base(4,7,0)
        intBits :: Int
intBits = Int64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int64
forall a. HasCallStack => a
undefined :: Int64) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
#else
        intBits = bitSize (undefined :: Int64) - 1
#endif

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

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

    encIntSmall :: (a, a) -> a
encIntSmall (a
mt, a
ui) =  a
mt a -> a -> a
forall a. Num a => a -> 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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
24, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt16 :: (a, a) -> (a, b)
encInt16    (a
mt, a
ui) = (a
mt a -> a -> a
forall a. Num a => a -> a -> a
+ a
25, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt32 :: (a, a) -> (a, b)
encInt32    (a
mt, a
ui) = (a
mt a -> a -> a
forall a. Num a => a -> a -> a
+ a
26, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
    encInt64 :: (a, a) -> (a, b)
encInt64    (a
mt, a
ui) = (a
mt a -> a -> a
forall a. Num a => a -> a -> a
+ a
27, a -> b
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 =
    BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs

bytesLenMP :: P.BoundedPrim Word
bytesLenMP :: BoundedPrim Word
bytesLenMP =
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> (Word -> Word) -> Word -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x40 Word -> Word -> Word
forall a. Num a => a -> a -> a
+) (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x58 FixedPrim Word8
P.word8) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x59 FixedPrim Word16
P.word16BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x5a FixedPrim Word32
P.word32BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
                          (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP Word
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SlicedByteArray -> Builder
BAS.toBuilder SlicedByteArray
ba
  where n :: Word
n = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
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
    BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
stringLenMP (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs) Builder -> Builder -> Builder
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 =
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> (Word -> Word) -> Word -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x60 Word -> Word -> Word
forall a. Num a => a -> a -> a
+) (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x78 FixedPrim Word8
P.word8) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x79 FixedPrim Word16
P.word16BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x7a FixedPrim Word32
P.word32BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
                          (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
stringLenMP Word
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SlicedByteArray -> Builder
BAS.toBuilder SlicedByteArray
t
  where
    n :: Word
n = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
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 =
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> (Word -> Word) -> Word -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x80 Word -> Word -> Word
forall a. Num a => a -> a -> a
+) (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x98 FixedPrim Word8
P.word8) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x99 FixedPrim Word16
P.word16BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x9a FixedPrim Word32
P.word32BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
                          (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> (Word -> Word) -> Word -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0xa0 Word -> Word -> Word
forall a. Num a => a -> a -> a
+) (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xb8 FixedPrim Word8
P.word8) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xb9 FixedPrim Word16
P.word16BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xba FixedPrim Word32
P.word32BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
                          (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x17)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> (Word -> Word) -> Word -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0xc0 Word -> Word -> Word
forall a. Num a => a -> a -> a
+) (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xff)       (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd8 FixedPrim Word8
P.word8) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff)     (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd9 FixedPrim Word16
P.word16BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
    (Word -> Bool)
-> BoundedPrim Word -> BoundedPrim Word -> BoundedPrim Word
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xda FixedPrim Word32
P.word32BE) (BoundedPrim Word -> BoundedPrim Word)
-> BoundedPrim Word -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$
                          (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x17)       (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> (Word64 -> Word64) -> Word64 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
0xc0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+) (Word64 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xff)       (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word8 -> BoundedPrim Word8
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd8 FixedPrim Word8
P.word8) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffff)     (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16) -> BoundedPrim Word16 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd9 FixedPrim Word16
P.word16BE) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Bool)
-> BoundedPrim Word64 -> BoundedPrim Word64 -> BoundedPrim Word64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> BoundedPrim Word32 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word32 -> BoundedPrim Word32
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xda FixedPrim Word32
P.word32BE) (BoundedPrim Word64 -> BoundedPrim Word64)
-> BoundedPrim Word64 -> BoundedPrim Word64
forall a b. (a -> b) -> a -> b
$
                          (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> BoundedPrim Word64 -> BoundedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word64 -> BoundedPrim Word64
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 =
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x17) ((Word8
0xe0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> BoundedPrim Word8 -> BoundedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
                    (Word8 -> FixedPrim Word8 -> BoundedPrim Word8
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 :: BoundedPrim a
canonicalNaN = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Word8, (Word8, Word8)) -> a -> (Word8, (Word8, Word8))
forall a b. a -> b -> a
const (Word8
0xf9, (Word8
0x7e, Word8
0x00))
                                   (a -> (Word8, (Word8, Word8)))
-> FixedPrim (Word8, (Word8, Word8)) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
P.word8 FixedPrim Word8
-> FixedPrim (Word8, Word8) -> FixedPrim (Word8, (Word8, Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
P.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, 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 = (Float -> Bool)
-> BoundedPrim Float -> BoundedPrim Float -> BoundedPrim Float
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN BoundedPrim Float
forall a. BoundedPrim a
canonicalNaN
                     (Float -> Word16
floatToWord16 (Float -> Word16) -> BoundedPrim Word16 -> BoundedPrim Float
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< Word8 -> FixedPrim Word16 -> BoundedPrim Word16
forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xf9 FixedPrim Word16
P.word16BE)

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

doubleMP :: P.BoundedPrim Double
doubleMP :: BoundedPrim Double
doubleMP = (Double -> Bool)
-> BoundedPrim Double -> BoundedPrim Double -> BoundedPrim Double
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN BoundedPrim Double
forall a. BoundedPrim a
canonicalNaN
                       (Word8 -> FixedPrim Double -> BoundedPrim Double
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 SmallInt  n = GHC.Num.Integer.IS n

pattern PosBigInt, NegBigInt :: GHC.Num.BigNat.BigNat# -> Integer
pattern PosBigInt n = GHC.Num.Integer.IP n
pattern NegBigInt n = GHC.Num.Integer.IN n

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

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

negBigNatMP :: GHC.Num.BigNat.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 (GHC.Num.BigNat.BN# n))
  where
    subtractOneBigNat (GHC.Num.BigNat.BN# nat) =
      case GHC.Num.BigNat.bigNatSubWord# nat 1## of
        (#       | r #) -> GHC.Num.BigNat.BN# r
        (# (# #) | #)   -> error "subtractOneBigNat: impossible"

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

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

pattern PosBigInt :: BigNat -> Integer
pattern NegBigInt :: BigNat -> Integer
pattern $bPosBigInt :: BigNat -> Integer
$mPosBigInt :: forall r. Integer -> (BigNat -> r) -> (Void# -> r) -> r
PosBigInt n = Gmp.Jp# n
pattern $bNegBigInt :: BigNat -> Integer
$mNegBigInt :: forall r. Integer -> (BigNat -> r) -> (Void# -> r) -> r
NegBigInt n = Gmp.Jn# n

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

bigNatMP :: BigNat -> B.Builder
bigNatMP :: BigNat -> Builder
bigNatMP BigNat
n = BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
header Word8
0xc2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BigNat -> Builder
bigNatToBuilder BigNat
n

negBigNatMP :: 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.
     BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
header Word8
0xc3
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BigNat -> Builder
bigNatToBuilder (BigNat -> BigNat
subtractOneBigNat BigNat
n)
  where
    subtractOneBigNat :: BigNat -> BigNat
subtractOneBigNat BigNat
m = BigNat -> Word# -> BigNat
Gmp.minusBigNatWord BigNat
m (Int# -> Word#
int2Word# Int#
1#)

exportBigNatToAddr :: BigNat -> Addr# -> IO Word
exportBigNatToAddr BigNat
bigNat Addr#
addr# =
  -- The last parameter (`1#`) makes the export function use big endian encoding.
  BigNat -> Addr# -> Int# -> IO Word
Gmp.exportBigNatToAddr BigNat
bigNat Addr#
addr# Int#
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 = PI.boundedPrim (fromIntegral sizeW) (dumpBigNat sizeW)
#else
            bounded :: BoundedPrim BigNat
bounded = Int
-> (BigNat -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim BigNat
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
PI.boudedPrim (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
sizeW) (Word -> BigNat -> Ptr Word8 -> IO (Ptr Word8)
forall a. Word -> BigNat -> Ptr a -> IO (Ptr a)
dumpBigNat Word
sizeW)
#endif
        in BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP Word
sizeW Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedPrim BigNat -> BigNat -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim BigNat
bounded BigNat
bigNat

    dumpBigNat :: Word -> BigNat -> Ptr a -> IO (Ptr a)
    dumpBigNat :: 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 Ptr a -> Int -> Ptr b
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#)
        Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> IO (Ptr a)) -> Ptr a -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ Bool -> Ptr a -> Ptr a
forall a. HasCallStack => Bool -> a -> a
assert Bool
sanity Ptr a
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 */