{-# LANGUAGE CPP       #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Codec.CBOR.FlatTerm
-- Copyright   : (c) Duncan Coutts 2015-2017
-- License     : BSD3-style (see LICENSE.txt)
--
-- Maintainer  : duncan@community.haskell.org
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- A simpler form than CBOR for writing out 'Enc.Encoding' values that allows
-- easier verification and testing. While this library primarily focuses
-- on taking 'Enc.Encoding' values (independent of any underlying format)
-- and serializing them into CBOR format, this module offers an alternative
-- format called 'FlatTerm' for serializing 'Enc.Encoding' values.
--
-- The 'FlatTerm' form is very simple and internally mirrors the original
-- 'Encoding' type very carefully. The intention here is that once you
-- have 'Enc.Encoding' and 'Dec.Decoding' values for your types, you can
-- round-trip values through 'FlatTerm' to catch bugs more easily and with
-- a smaller amount of code to look through.
--
-- For that reason, this module is primarily useful for client libraries,
-- and even then, only for their test suites to offer a simpler form for
-- doing encoding tests and catching problems in an encoder and decoder.
--
module Codec.CBOR.FlatTerm
  ( -- * Types
    FlatTerm      -- :: *
  , TermToken(..) -- :: *

    -- * Functions
  , toFlatTerm    -- :: Encoding -> FlatTerm
  , fromFlatTerm  -- :: Decoder s a -> FlatTerm -> Either String a
  , validFlatTerm -- :: FlatTerm -> Bool
  , decodeTermToken -- Decoder s TermToken
  ) where

#include "cbor.h"

import           Codec.CBOR.Encoding (Encoding(..))
import qualified Codec.CBOR.Encoding as Enc
import           Codec.CBOR.Decoding as Dec
import qualified Codec.CBOR.Read     as Read
import qualified Codec.CBOR.ByteArray        as BA
import qualified Codec.CBOR.ByteArray.Sliced as BAS

import           Data.Int
#if defined(ARCH_32bit)
import           GHC.Int   (Int64(I64#))
import           GHC.Word  (Word64(W64#))
import           GHC.Exts  (Word64#, Int64#)
#endif
#if MIN_VERSION_ghc_prim(0,8,0)
import           GHC.Exts  (word8ToWord#)
#endif
import           GHC.Word  (Word(W#), Word8(W8#))
import           GHC.Exts  (Int(I#), Int#, Word#, Float#, Double#)
import           GHC.Float (Float(F#), Double(D#), float2Double)

import           Data.Word
import           Data.Text (Text)
import qualified Data.Text.Encoding as TE
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Control.Monad.ST
import qualified Control.Monad.ST.Lazy as ST.Lazy

import Prelude hiding (encodeFloat, decodeFloat)


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

-- | A \"flat\" representation of an 'Enc.Encoding' value,
-- useful for round-tripping and writing tests.
--
-- @since 0.2.0.0
type FlatTerm = [TermToken]

-- | A concrete encoding of 'Enc.Encoding' values, one
-- which mirrors the original 'Enc.Encoding' type closely.
--
-- @since 0.2.0.0
data TermToken
    = TkInt      {-# UNPACK #-} !Int
    | TkInteger                 !Integer
    | TkBytes    {-# UNPACK #-} !ByteString
    | TkBytesBegin
    | TkString   {-# UNPACK #-} !Text
    | TkStringBegin
    | TkListLen  {-# UNPACK #-} !Word
    | TkListBegin
    | TkMapLen   {-# UNPACK #-} !Word
    | TkMapBegin
    | TkBreak
    | TkTag      {-# UNPACK #-} !Word64
    | TkBool                    !Bool
    | TkNull
    | TkSimple   {-# UNPACK #-} !Word8
    | TkFloat16  {-# UNPACK #-} !Float
    | TkFloat32  {-# UNPACK #-} !Float
    | TkFloat64  {-# UNPACK #-} !Double
    deriving (TermToken -> TermToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TermToken -> TermToken -> Bool
$c/= :: TermToken -> TermToken -> Bool
== :: TermToken -> TermToken -> Bool
$c== :: TermToken -> TermToken -> Bool
Eq, Eq TermToken
TermToken -> TermToken -> Bool
TermToken -> TermToken -> Ordering
TermToken -> TermToken -> TermToken
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TermToken -> TermToken -> TermToken
$cmin :: TermToken -> TermToken -> TermToken
max :: TermToken -> TermToken -> TermToken
$cmax :: TermToken -> TermToken -> TermToken
>= :: TermToken -> TermToken -> Bool
$c>= :: TermToken -> TermToken -> Bool
> :: TermToken -> TermToken -> Bool
$c> :: TermToken -> TermToken -> Bool
<= :: TermToken -> TermToken -> Bool
$c<= :: TermToken -> TermToken -> Bool
< :: TermToken -> TermToken -> Bool
$c< :: TermToken -> TermToken -> Bool
compare :: TermToken -> TermToken -> Ordering
$ccompare :: TermToken -> TermToken -> Ordering
Ord, Int -> TermToken -> ShowS
[TermToken] -> ShowS
TermToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TermToken] -> ShowS
$cshowList :: [TermToken] -> ShowS
show :: TermToken -> String
$cshow :: TermToken -> String
showsPrec :: Int -> TermToken -> ShowS
$cshowsPrec :: Int -> TermToken -> ShowS
Show)

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

-- | Convert an arbitrary 'Enc.Encoding' into a 'FlatTerm'.
--
-- @since 0.2.0.0
toFlatTerm :: Encoding -- ^ The input 'Enc.Encoding'.
           -> FlatTerm -- ^ The resulting 'FlatTerm'.
toFlatTerm :: Encoding -> [TermToken]
toFlatTerm (Encoding Tokens -> Tokens
tb) = Tokens -> [TermToken]
convFlatTerm (Tokens -> Tokens
tb Tokens
Enc.TkEnd)

convFlatTerm :: Enc.Tokens -> FlatTerm
convFlatTerm :: Tokens -> [TermToken]
convFlatTerm (Enc.TkWord     Word
w  Tokens
ts)
  | Word
w forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                     = Int -> TermToken
TkInt     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
  | Bool
otherwise                       = Integer -> TermToken
TkInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkWord64   Word64
w  Tokens
ts)
  | Word64
w forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                     = Int -> TermToken
TkInt     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
  | Bool
otherwise                       = Integer -> TermToken
TkInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkInt      Int
n  Tokens
ts) = Int -> TermToken
TkInt       Int
n forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkInt64    Int64
n  Tokens
ts)
  | Int64
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt Bool -> Bool -> Bool
&& Int64
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt      = Int -> TermToken
TkInt     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
  | Bool
otherwise                       = Integer -> TermToken
TkInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkInteger  Integer
n  Tokens
ts)
  | Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt      = Int -> TermToken
TkInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
  | Bool
otherwise                       = Integer -> TermToken
TkInteger   Integer
n forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkBytes    ByteString
bs Tokens
ts) = ByteString -> TermToken
TkBytes    ByteString
bs forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkBytesBegin  Tokens
ts) = TermToken
TkBytesBegin  forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkByteArray SlicedByteArray
a Tokens
ts)
  = ByteString -> TermToken
TkBytes (SlicedByteArray -> ByteString
BAS.toByteString SlicedByteArray
a) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkString   Text
st Tokens
ts) = Text -> TermToken
TkString   Text
st forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkStringBegin Tokens
ts) = TermToken
TkStringBegin forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkUtf8ByteArray SlicedByteArray
a Tokens
ts)
  = Text -> TermToken
TkString (ByteString -> Text
TE.decodeUtf8 forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> ByteString
BAS.toByteString SlicedByteArray
a) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkListLen  Word
n  Tokens
ts) = Word -> TermToken
TkListLen   Word
n forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkListBegin   Tokens
ts) = TermToken
TkListBegin   forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkMapLen   Word
n  Tokens
ts) = Word -> TermToken
TkMapLen    Word
n forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkMapBegin    Tokens
ts) = TermToken
TkMapBegin    forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkTag      Word
n  Tokens
ts) = Word64 -> TermToken
TkTag (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkTag64    Word64
n  Tokens
ts) = Word64 -> TermToken
TkTag       Word64
n forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkBool     Bool
b  Tokens
ts) = Bool -> TermToken
TkBool      Bool
b forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkNull        Tokens
ts) = TermToken
TkNull        forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkUndef       Tokens
ts) = Word8 -> TermToken
TkSimple   Word8
23 forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkSimple   Word8
n  Tokens
ts) = Word8 -> TermToken
TkSimple    Word8
n forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkFloat16  Float
f  Tokens
ts) = Float -> TermToken
TkFloat16   Float
f forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkFloat32  Float
f  Tokens
ts) = Float -> TermToken
TkFloat32   Float
f forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkFloat64  Double
f  Tokens
ts) = Double -> TermToken
TkFloat64   Double
f forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkBreak       Tokens
ts) = TermToken
TkBreak       forall a. a -> [a] -> [a]
: Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm (Enc.TkEncoded  ByteString
bs Tokens
ts) = ByteString -> [TermToken]
decodePreEncoded ByteString
bs
                                                   forall a. [a] -> [a] -> [a]
++ Tokens -> [TermToken]
convFlatTerm Tokens
ts
convFlatTerm  Tokens
Enc.TkEnd             = []

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

decodePreEncoded :: BS.ByteString -> FlatTerm
decodePreEncoded :: ByteString -> [TermToken]
decodePreEncoded ByteString
bs0 =
    forall a. (forall s. ST s a) -> a
ST.Lazy.runST (forall s. ByteString -> ST s [TermToken]
provideInput ByteString
bs0)
  where
    provideInput :: BS.ByteString -> ST.Lazy.ST s FlatTerm
    provideInput :: forall s. ByteString -> ST s [TermToken]
provideInput ByteString
bs
      | ByteString -> Bool
BS.null ByteString
bs = forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Bool
otherwise  = do
          IDecode s TermToken
next <- forall s a. ST s a -> ST s a
ST.Lazy.strictToLazyST forall a b. (a -> b) -> a -> b
$ do
              -- This will always be a 'Partial' here because decodeTermToken
              -- always starts by requesting initial input. Only decoders that
              -- fail or return a value without looking at their input can give
              -- a different initial result.
              IDecode s TermToken
result <- forall s a. Decoder s a -> ST s (IDecode s a)
Read.deserialiseIncremental forall s. Decoder s TermToken
decodeTermToken
              let
                k :: Maybe ByteString -> ST s (IDecode s TermToken)
k =
                  case IDecode s TermToken
result of
                    Read.Partial Maybe ByteString -> ST s (IDecode s TermToken)
a -> Maybe ByteString -> ST s (IDecode s TermToken)
a
                    IDecode s TermToken
_ -> forall a. HasCallStack => String -> a
error String
"Failed to get a Partial"
              Maybe ByteString -> ST s (IDecode s TermToken)
k (forall a. a -> Maybe a
Just ByteString
bs)
          forall s. IDecode s TermToken -> ST s [TermToken]
collectOutput IDecode s TermToken
next

    collectOutput :: Read.IDecode s TermToken -> ST.Lazy.ST s FlatTerm
    collectOutput :: forall s. IDecode s TermToken -> ST s [TermToken]
collectOutput (Read.Fail ByteString
_ Int64
_ DeserialiseFailure
err) =
#if MIN_VERSION_base(4,17,0)
                                        error
#else
                                        forall (m :: * -> *) a. MonadFail m => String -> m a
fail
#endif

                                             forall a b. (a -> b) -> a -> b
$ String
"toFlatTerm: encodePreEncoded "
                                            forall a. [a] -> [a] -> [a]
++ String
"used with invalid CBOR: "
                                            forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DeserialiseFailure
err
    collectOutput (Read.Partial    Maybe ByteString -> ST s (IDecode s TermToken)
k) = forall s a. ST s a -> ST s a
ST.Lazy.strictToLazyST (Maybe ByteString -> ST s (IDecode s TermToken)
k forall a. Maybe a
Nothing)
                                        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. IDecode s TermToken -> ST s [TermToken]
collectOutput
    collectOutput (Read.Done ByteString
bs' Int64
_ TermToken
x) = do [TermToken]
xs <- forall s. ByteString -> ST s [TermToken]
provideInput ByteString
bs'
                                           forall (m :: * -> *) a. Monad m => a -> m a
return (TermToken
x forall a. a -> [a] -> [a]
: [TermToken]
xs)

decodeTermToken :: Decoder s TermToken
decodeTermToken :: forall s. Decoder s TermToken
decodeTermToken = do
    TokenType
tkty <- forall s. Decoder s TokenType
peekTokenType
    case TokenType
tkty of
      TokenType
TypeUInt   -> do Word
w <- forall s. Decoder s Word
decodeWord
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word -> TermToken
fromWord Word
w
                    where
                      fromWord :: Word -> TermToken
                      fromWord :: Word -> TermToken
fromWord Word
w
                        | Word
w forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
                                    = Int -> TermToken
TkInt     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
                        | Bool
otherwise = Integer -> TermToken
TkInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)

      TokenType
TypeUInt64 -> do Word64
w <- forall s. Decoder s Word64
decodeWord64
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {a}. Integral a => a -> TermToken
fromWord64 Word64
w
                    where
                      fromWord64 :: a -> TermToken
fromWord64 a
w
                        | a
w forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
                                    = Int -> TermToken
TkInt     (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)
                        | Bool
otherwise = Integer -> TermToken
TkInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)

      TokenType
TypeNInt   -> do Word
w <- forall s. Decoder s Word
decodeNegWord
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {a}. Integral a => a -> TermToken
fromNegWord Word
w
                    where
                      fromNegWord :: a -> TermToken
fromNegWord a
w
                        | a
w forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
                                    = Int -> TermToken
TkInt     (-Int
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)
                        | Bool
otherwise = Integer -> TermToken
TkInteger (-Integer
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)

      TokenType
TypeNInt64 -> do Word64
w <- forall s. Decoder s Word64
decodeNegWord64
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {a}. Integral a => a -> TermToken
fromNegWord64 Word64
w
                    where
                      fromNegWord64 :: a -> TermToken
fromNegWord64 a
w
                        | a
w forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
                                    = Int -> TermToken
TkInt     (-Int
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)
                        | Bool
otherwise = Integer -> TermToken
TkInteger (-Integer
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)

      TokenType
TypeInteger -> do !Integer
x <- forall s. Decoder s Integer
decodeInteger
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> TermToken
TkInteger Integer
x)
      TokenType
TypeFloat16 -> do !Float
x <- forall s. Decoder s Float
decodeFloat
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> TermToken
TkFloat16 Float
x)
      TokenType
TypeFloat32 -> do !Float
x <- forall s. Decoder s Float
decodeFloat
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> TermToken
TkFloat32 Float
x)
      TokenType
TypeFloat64 -> do !Double
x <- forall s. Decoder s Double
decodeDouble
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> TermToken
TkFloat64 Double
x)

      TokenType
TypeBytes        -> do !ByteString
x <- forall s. Decoder s ByteString
decodeBytes
                             forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> TermToken
TkBytes ByteString
x)
      TokenType
TypeBytesIndef   -> do forall s. Decoder s ()
decodeBytesIndef
                             forall (m :: * -> *) a. Monad m => a -> m a
return TermToken
TkBytesBegin
      TokenType
TypeString       -> do !Text
x <- forall s. Decoder s Text
decodeString
                             forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TermToken
TkString Text
x)
      TokenType
TypeStringIndef  -> do forall s. Decoder s ()
decodeStringIndef
                             forall (m :: * -> *) a. Monad m => a -> m a
return TermToken
TkStringBegin

      TokenType
TypeListLen      -> do !Int
x <- forall s. Decoder s Int
decodeListLen
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word -> TermToken
TkListLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
      TokenType
TypeListLen64    -> do !Int
x <- forall s. Decoder s Int
decodeListLen
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word -> TermToken
TkListLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
      TokenType
TypeListLenIndef -> do forall s. Decoder s ()
decodeListLenIndef
                             forall (m :: * -> *) a. Monad m => a -> m a
return TermToken
TkListBegin
      TokenType
TypeMapLen       -> do !Int
x <- forall s. Decoder s Int
decodeMapLen
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word -> TermToken
TkMapLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
      TokenType
TypeMapLen64     -> do !Int
x <- forall s. Decoder s Int
decodeMapLen
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word -> TermToken
TkMapLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
      TokenType
TypeMapLenIndef  -> do forall s. Decoder s ()
decodeMapLenIndef
                             forall (m :: * -> *) a. Monad m => a -> m a
return TermToken
TkMapBegin

      TokenType
TypeTag          -> do !Word
x <- forall s. Decoder s Word
decodeTag
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word64 -> TermToken
TkTag (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)
      TokenType
TypeTag64        -> do !Word64
x <- forall s. Decoder s Word64
decodeTag64
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word64 -> TermToken
TkTag (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)

      TokenType
TypeBool    -> do !Bool
x <- forall s. Decoder s Bool
decodeBool
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> TermToken
TkBool Bool
x)
      TokenType
TypeNull    -> do forall s. Decoder s ()
decodeNull
                        forall (m :: * -> *) a. Monad m => a -> m a
return TermToken
TkNull
      TokenType
TypeSimple  -> do !Word8
x <- forall s. Decoder s Word8
decodeSimple
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> TermToken
TkSimple Word8
x)
      TokenType
TypeBreak   -> do Bool
_ <- forall s. Decoder s Bool
decodeBreakOr
                        forall (m :: * -> *) a. Monad m => a -> m a
return TermToken
TkBreak
      TokenType
TypeInvalid -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid token encoding"


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

-- | Given a 'Dec.Decoder', decode a 'FlatTerm' back into
-- an ordinary value, or return an error.
--
-- @since 0.2.0.0
fromFlatTerm :: (forall s. Decoder s a)
                                -- ^ A 'Dec.Decoder' for a serialised value.
             -> FlatTerm        -- ^ The serialised 'FlatTerm'.
             -> Either String a -- ^ The deserialised value, or an error.
fromFlatTerm :: forall a. (forall s. Decoder s a) -> [TermToken] -> Either String a
fromFlatTerm forall s. Decoder s a
decoder [TermToken]
ft =
    forall a. (forall s. ST s a) -> a
runST (forall s a. Decoder s a -> ST s (DecodeAction s a)
getDecodeAction forall s. Decoder s a
decoder forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ft)
  where
    go :: FlatTerm -> DecodeAction s a -> ST s (Either String a)
    go :: forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord8 Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord8            = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord8 Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord8            = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord16 Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord16           = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord16 Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord16           = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord32 Word# -> ST s (DecodeAction s a)
k)
        -- NOTE: we have to be very careful about this branch
        -- on 32 bit machines, because maxBound :: Int < maxBound :: Word32
        | Int -> Bool
intIsValidWord32 Int
n                 = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord32 Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord32           = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeNegWord Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
<  Int
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
1forall a. Num a => a -> a -> a
-Int
n))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeNegWord Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
<  Integer
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Integer
1forall a. Num a => a -> a -> a
-Integer
n))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt Int# -> ST s (DecodeAction s a)
k)     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                        = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt8 Int# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt8 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt8       = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt8 Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt8 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt8       = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt16 Int# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt16 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt16     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt16 Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt16 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt16     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt32 Int# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt32 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt32     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt32 Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt32 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt32     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInteger Integer -> ST s (DecodeAction s a)
k) = Integer -> ST s (DecodeAction s a)
k (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInteger Integer -> ST s (DecodeAction s a)
k) = Integer -> ST s (DecodeAction s a)
k Integer
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkListLen Word
n : [TermToken]
ts) (ConsumeListLen Int# -> ST s (DecodeAction s a)
k)
        | Word
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                        = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkMapLen  Word
n : [TermToken]
ts) (ConsumeMapLen  Int# -> ST s (DecodeAction s a)
k)
        | Word
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                        = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkTag     Word64
n : [TermToken]
ts) (ConsumeTag     Word# -> ST s (DecodeAction s a)
k)
        | Word64
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord                       = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts

    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWordCanonical Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWordCanonical Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord8Canonical Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord8            = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord8Canonical Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord8            = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord16Canonical Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord16           = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord16Canonical Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord16           = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeWord32Canonical Word# -> ST s (DecodeAction s a)
k)
        -- NOTE: we have to be very careful about this branch
        -- on 32 bit machines, because maxBound :: Int < maxBound :: Word32
        | Int -> Bool
intIsValidWord32 Int
n                 = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeWord32Canonical Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord32           = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeNegWordCanonical Word# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
<  Int
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
1forall a. Num a => a -> a -> a
-Int
n))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeNegWordCanonical Word# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
<  Integer
0                             = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Integer
1forall a. Num a => a -> a -> a
-Integer
n))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeIntCanonical Int# -> ST s (DecodeAction s a)
k)     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                        = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt8Canonical Int# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt8 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt8       = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt8Canonical Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt8 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt8       = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt16Canonical Int# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt16 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt16     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt16Canonical Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt16 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt16     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeInt32Canonical Int# -> ST s (DecodeAction s a)
k)
        | Int
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt32 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt32     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeInt32Canonical Int# -> ST s (DecodeAction s a)
k)
        | Integer
n forall a. Ord a => a -> a -> Bool
>= forall n. Num n => n
minInt32 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt32     = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInt     Int
n : [TermToken]
ts) (ConsumeIntegerCanonical Integer -> ST s (DecodeAction s a)
k) = Integer -> ST s (DecodeAction s a)
k (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkInteger Integer
n : [TermToken]
ts) (ConsumeIntegerCanonical Integer -> ST s (DecodeAction s a)
k) = Integer -> ST s (DecodeAction s a)
k Integer
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkListLen Word
n : [TermToken]
ts) (ConsumeListLenCanonical Int# -> ST s (DecodeAction s a)
k)
        | Word
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                        = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkMapLen  Word
n : [TermToken]
ts) (ConsumeMapLenCanonical  Int# -> ST s (DecodeAction s a)
k)
        | Word
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                        = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkTag     Word64
n : [TermToken]
ts) (ConsumeTagCanonical     Word# -> ST s (DecodeAction s a)
k)
        | Word64
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord                       = Word# -> ST s (DecodeAction s a)
k (Word -> Word#
unW# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts

#if defined(ARCH_32bit)
    -- 64bit variants for 32bit machines
    go (TkInt       n : ts) (ConsumeWord64    k)
      | n >= 0                                   = k (unW64# (fromIntegral n)) >>= go ts
    go (TkInteger   n : ts) (ConsumeWord64    k)
      | n >= 0                                   = k (unW64# (fromIntegral n)) >>= go ts
    go (TkInt       n : ts) (ConsumeNegWord64 k)
      | n < 0                                    = k (unW64# (fromIntegral (-1-n))) >>= go ts
    go (TkInteger   n : ts) (ConsumeNegWord64 k)
      | n < 0                                    = k (unW64# (fromIntegral (-1-n))) >>= go ts

    go (TkInt       n : ts) (ConsumeInt64     k) = k (unI64# (fromIntegral n)) >>= go ts
    go (TkInteger   n : ts) (ConsumeInt64     k) = k (unI64# (fromIntegral n)) >>= go ts

    go (TkTag       n : ts) (ConsumeTag64     k) = k (unW64# n) >>= go ts

    go (TkInt       n : ts) (ConsumeWord64Canonical    k)
      | n >= 0                                   = k (unW64# (fromIntegral n)) >>= go ts
    go (TkInteger   n : ts) (ConsumeWord64Canonical    k)
      | n >= 0                                   = k (unW64# (fromIntegral n)) >>= go ts
    go (TkInt       n : ts) (ConsumeNegWord64Canonical k)
      | n < 0                                    = k (unW64# (fromIntegral (-1-n))) >>= go ts
    go (TkInteger   n : ts) (ConsumeNegWord64Canonical k)
      | n < 0                                    = k (unW64# (fromIntegral (-1-n))) >>= go ts

    go (TkInt       n : ts) (ConsumeInt64Canonical     k) = k (unI64# (fromIntegral n)) >>= go ts
    go (TkInteger   n : ts) (ConsumeInt64Canonical     k) = k (unI64# (fromIntegral n)) >>= go ts

    go (TkTag       n : ts) (ConsumeTag64Canonical     k) = k (unW64# n) >>= go ts


    -- TODO FIXME (aseipp/dcoutts): are these going to be utilized?
    -- see fallthrough case below if/when fixed.
    go ts (ConsumeListLen64 _)          = unexpected "decodeListLen64" ts
    go ts (ConsumeMapLen64  _)          = unexpected "decodeMapLen64"  ts
    go ts (ConsumeListLen64Canonical _) = unexpected "decodeListLen64Canonical" ts
    go ts (ConsumeMapLen64Canonical  _) = unexpected "decodeMapLen64Canonical"  ts
#endif

    go (TkFloat16 Float
f : [TermToken]
ts) (ConsumeFloat  Float# -> ST s (DecodeAction s a)
k)        = Float# -> ST s (DecodeAction s a)
k (Float -> Float#
unF# Float
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkFloat32 Float
f : [TermToken]
ts) (ConsumeFloat  Float# -> ST s (DecodeAction s a)
k)        = Float# -> ST s (DecodeAction s a)
k (Float -> Float#
unF# Float
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkFloat16 Float
f : [TermToken]
ts) (ConsumeDouble Double# -> ST s (DecodeAction s a)
k)        = Double# -> ST s (DecodeAction s a)
k (Double -> Double#
unD# (Float -> Double
float2Double Float
f)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkFloat32 Float
f : [TermToken]
ts) (ConsumeDouble Double# -> ST s (DecodeAction s a)
k)        = Double# -> ST s (DecodeAction s a)
k (Double -> Double#
unD# (Float -> Double
float2Double Float
f)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkFloat64 Double
f : [TermToken]
ts) (ConsumeDouble Double# -> ST s (DecodeAction s a)
k)        = Double# -> ST s (DecodeAction s a)
k (Double -> Double#
unD# Double
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkBytes  ByteString
bs : [TermToken]
ts) (ConsumeBytes  ByteString -> ST s (DecodeAction s a)
k)        = ByteString -> ST s (DecodeAction s a)
k ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkBytes  ByteString
bs : [TermToken]
ts) (ConsumeByteArray ByteArray -> ST s (DecodeAction s a)
k)     = ByteArray -> ST s (DecodeAction s a)
k (ByteString -> ByteArray
BA.fromByteString ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkString Text
st : [TermToken]
ts) (ConsumeString Text -> ST s (DecodeAction s a)
k)        = Text -> ST s (DecodeAction s a)
k Text
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkString Text
st : [TermToken]
ts) (ConsumeUtf8ByteArray ByteArray -> ST s (DecodeAction s a)
k) = ByteArray -> ST s (DecodeAction s a)
k (ByteString -> ByteArray
BA.fromByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
st)
                                                     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkBool    Bool
b : [TermToken]
ts) (ConsumeBool   Bool -> ST s (DecodeAction s a)
k)        = Bool -> ST s (DecodeAction s a)
k Bool
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkSimple  Word8
n : [TermToken]
ts) (ConsumeSimple Word# -> ST s (DecodeAction s a)
k)        = Word# -> ST s (DecodeAction s a)
k (Word8 -> Word#
unW8# Word8
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts

    go (TkFloat16 Float
f : [TermToken]
ts) (ConsumeFloat16Canonical Float# -> ST s (DecodeAction s a)
k)       = Float# -> ST s (DecodeAction s a)
k (Float -> Float#
unF# Float
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkFloat32 Float
f : [TermToken]
ts) (ConsumeFloatCanonical   Float# -> ST s (DecodeAction s a)
k)       = Float# -> ST s (DecodeAction s a)
k (Float -> Float#
unF# Float
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkFloat64 Double
f : [TermToken]
ts) (ConsumeDoubleCanonical  Double# -> ST s (DecodeAction s a)
k)       = Double# -> ST s (DecodeAction s a)
k (Double -> Double#
unD# Double
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkBytes  ByteString
bs : [TermToken]
ts) (ConsumeBytesCanonical  ByteString -> ST s (DecodeAction s a)
k)        = ByteString -> ST s (DecodeAction s a)
k ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkBytes  ByteString
bs : [TermToken]
ts) (ConsumeByteArrayCanonical ByteArray -> ST s (DecodeAction s a)
k)     = ByteArray -> ST s (DecodeAction s a)
k (ByteString -> ByteArray
BA.fromByteString ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkString Text
st : [TermToken]
ts) (ConsumeStringCanonical Text -> ST s (DecodeAction s a)
k)        = Text -> ST s (DecodeAction s a)
k Text
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkString Text
st : [TermToken]
ts) (ConsumeUtf8ByteArrayCanonical ByteArray -> ST s (DecodeAction s a)
k) = ByteArray -> ST s (DecodeAction s a)
k (ByteString -> ByteArray
BA.fromByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
st)
                                                              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkSimple  Word8
n : [TermToken]
ts) (ConsumeSimpleCanonical  Word# -> ST s (DecodeAction s a)
k)       = Word# -> ST s (DecodeAction s a)
k (Word8 -> Word#
unW8# Word8
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts

    go (TermToken
TkBytesBegin  : [TermToken]
ts) (ConsumeBytesIndef   ST s (DecodeAction s a)
da) = ST s (DecodeAction s a)
da forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkStringBegin : [TermToken]
ts) (ConsumeStringIndef  ST s (DecodeAction s a)
da) = ST s (DecodeAction s a)
da forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkListBegin   : [TermToken]
ts) (ConsumeListLenIndef ST s (DecodeAction s a)
da) = ST s (DecodeAction s a)
da forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkMapBegin    : [TermToken]
ts) (ConsumeMapLenIndef  ST s (DecodeAction s a)
da) = ST s (DecodeAction s a)
da forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkNull        : [TermToken]
ts) (ConsumeNull         ST s (DecodeAction s a)
da) = ST s (DecodeAction s a)
da forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts

    go (TkListLen Word
n : [TermToken]
ts) (ConsumeListLenOrIndef Int# -> ST s (DecodeAction s a)
k)
        | Word
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                               = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkListBegin : [TermToken]
ts) (ConsumeListLenOrIndef Int# -> ST s (DecodeAction s a)
k) = Int# -> ST s (DecodeAction s a)
k (Int#
-1#) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TkMapLen  Word
n : [TermToken]
ts) (ConsumeMapLenOrIndef  Int# -> ST s (DecodeAction s a)
k)
        | Word
n forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                               = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkMapBegin  : [TermToken]
ts) (ConsumeMapLenOrIndef  Int# -> ST s (DecodeAction s a)
k) = Int# -> ST s (DecodeAction s a)
k (Int#
-1#) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go (TermToken
TkBreak     : [TermToken]
ts) (ConsumeBreakOr        Bool -> ST s (DecodeAction s a)
k) = Bool -> ST s (DecodeAction s a)
k Bool
True forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go ts :: [TermToken]
ts@(TermToken
_        : [TermToken]
_ ) (ConsumeBreakOr        Bool -> ST s (DecodeAction s a)
k) = Bool -> ST s (DecodeAction s a)
k Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts

    go ts :: [TermToken]
ts@(TermToken
tk:[TermToken]
_) (PeekTokenType TokenType -> ST s (DecodeAction s a)
k) = TokenType -> ST s (DecodeAction s a)
k (TermToken -> TokenType
tokenTypeOf TermToken
tk) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
    go [TermToken]
ts        (PeekTokenType TokenType -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"peekTokenType" [TermToken]
ts

    -- We don't have real bytes so we have to give these two operations
    -- different interpretations: remaining tokens and just 0 for offsets.
    go [TermToken]
ts        (PeekAvailable Int# -> ST s (DecodeAction s a)
k) = Int# -> ST s (DecodeAction s a)
k (Int -> Int#
unI# (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TermToken]
ts)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
#if defined(ARCH_32bit)
    go ts        (PeekByteOffset k)= k (unI64# 0) >>= go ts
#else
    go [TermToken]
ts        (PeekByteOffset Int# -> ST s (DecodeAction s a)
k)= Int# -> ST s (DecodeAction s a)
k Int#
0# forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a.
[TermToken] -> DecodeAction s a -> ST s (Either String a)
go [TermToken]
ts
#endif

    go [TermToken]
_  (Fail String
msg) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
msg
    go [] (Done a
x)   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
x
    go [TermToken]
ts (Done a
_)   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"trailing tokens: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Int -> [a] -> [a]
take Int
5 [TermToken]
ts))

    ----------------------------------------------------------------------------
    -- Fallthrough cases: unhandled token/DecodeAction combinations

    go [TermToken]
ts (ConsumeWord    Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord"    [TermToken]
ts
    go [TermToken]
ts (ConsumeWord8   Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord8"   [TermToken]
ts
    go [TermToken]
ts (ConsumeWord16  Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord16"  [TermToken]
ts
    go [TermToken]
ts (ConsumeWord32  Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord32"  [TermToken]
ts
    go [TermToken]
ts (ConsumeNegWord Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeNegWord" [TermToken]
ts
    go [TermToken]
ts (ConsumeInt     Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt"     [TermToken]
ts
    go [TermToken]
ts (ConsumeInt8    Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt8"    [TermToken]
ts
    go [TermToken]
ts (ConsumeInt16   Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt16"   [TermToken]
ts
    go [TermToken]
ts (ConsumeInt32   Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt32"   [TermToken]
ts
    go [TermToken]
ts (ConsumeInteger Integer -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInteger" [TermToken]
ts

    go [TermToken]
ts (ConsumeListLen Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeListLen" [TermToken]
ts
    go [TermToken]
ts (ConsumeMapLen  Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeMapLen"  [TermToken]
ts
    go [TermToken]
ts (ConsumeTag     Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeTag"     [TermToken]
ts

    go [TermToken]
ts (ConsumeWordCanonical    Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWordCanonical"    [TermToken]
ts
    go [TermToken]
ts (ConsumeWord8Canonical   Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord8Canonical"   [TermToken]
ts
    go [TermToken]
ts (ConsumeWord16Canonical  Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord16Canonical"  [TermToken]
ts
    go [TermToken]
ts (ConsumeWord32Canonical  Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeWord32Canonical"  [TermToken]
ts
    go [TermToken]
ts (ConsumeNegWordCanonical Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeNegWordCanonical" [TermToken]
ts
    go [TermToken]
ts (ConsumeIntCanonical     Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeIntCanonical"     [TermToken]
ts
    go [TermToken]
ts (ConsumeInt8Canonical    Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt8Canonical"    [TermToken]
ts
    go [TermToken]
ts (ConsumeInt16Canonical   Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt16Canonical"   [TermToken]
ts
    go [TermToken]
ts (ConsumeInt32Canonical   Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeInt32Canonical"   [TermToken]
ts
    go [TermToken]
ts (ConsumeIntegerCanonical Integer -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeIntegerCanonical" [TermToken]
ts

    go [TermToken]
ts (ConsumeListLenCanonical Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeListLenCanonical" [TermToken]
ts
    go [TermToken]
ts (ConsumeMapLenCanonical  Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeMapLenCanonical"  [TermToken]
ts
    go [TermToken]
ts (ConsumeTagCanonical     Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeTagCanonical"     [TermToken]
ts

    go [TermToken]
ts (ConsumeFloat  Float# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeFloat"  [TermToken]
ts
    go [TermToken]
ts (ConsumeDouble Double# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeDouble" [TermToken]
ts
    go [TermToken]
ts (ConsumeBytes  ByteString -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeBytes"  [TermToken]
ts
    go [TermToken]
ts (ConsumeByteArray     ByteArray -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeByteArray"     [TermToken]
ts
    go [TermToken]
ts (ConsumeString Text -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeString" [TermToken]
ts
    go [TermToken]
ts (ConsumeUtf8ByteArray ByteArray -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeUtf8ByteArray" [TermToken]
ts
    go [TermToken]
ts (ConsumeBool   Bool -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeBool"   [TermToken]
ts
    go [TermToken]
ts (ConsumeSimple Word# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeSimple" [TermToken]
ts

    go [TermToken]
ts (ConsumeFloat16Canonical Float# -> ST s (DecodeAction s a)
_)       = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeFloat16Canonical"       [TermToken]
ts
    go [TermToken]
ts (ConsumeFloatCanonical   Float# -> ST s (DecodeAction s a)
_)       = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeFloatCanonical"         [TermToken]
ts
    go [TermToken]
ts (ConsumeDoubleCanonical  Double# -> ST s (DecodeAction s a)
_)       = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeDoubleCanonical"        [TermToken]
ts
    go [TermToken]
ts (ConsumeBytesCanonical  ByteString -> ST s (DecodeAction s a)
_)        = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeBytesCanonical"         [TermToken]
ts
    go [TermToken]
ts (ConsumeByteArrayCanonical ByteArray -> ST s (DecodeAction s a)
_)     = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeByteArrayCanonical"     [TermToken]
ts
    go [TermToken]
ts (ConsumeStringCanonical Text -> ST s (DecodeAction s a)
_)        = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeStringCanonical"        [TermToken]
ts
    go [TermToken]
ts (ConsumeUtf8ByteArrayCanonical ByteArray -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeUtf8ByteArrayCanonical" [TermToken]
ts
    go [TermToken]
ts (ConsumeSimpleCanonical  Word# -> ST s (DecodeAction s a)
_)       = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeSimpleCanonical"        [TermToken]
ts

#if defined(ARCH_32bit)
    -- 64bit variants for 32bit machines
    go ts (ConsumeWord64    _) = unexpected "decodeWord64"    ts
    go ts (ConsumeNegWord64 _) = unexpected "decodeNegWord64" ts
    go ts (ConsumeInt64     _) = unexpected "decodeInt64"     ts
    go ts (ConsumeTag64     _) = unexpected "decodeTag64"     ts
  --go ts (ConsumeListLen64 _) = unexpected "decodeListLen64" ts
  --go ts (ConsumeMapLen64  _) = unexpected "decodeMapLen64"  ts

    go ts (ConsumeWord64Canonical    _) = unexpected "decodeWord64Canonical"    ts
    go ts (ConsumeNegWord64Canonical _) = unexpected "decodeNegWord64Canonical" ts
    go ts (ConsumeInt64Canonical     _) = unexpected "decodeInt64Canonical"     ts
    go ts (ConsumeTag64Canonical     _) = unexpected "decodeTag64Canonical"     ts
  --go ts (ConsumeListLen64Canonical _) = unexpected "decodeListLen64Canonical" ts
  --go ts (ConsumeMapLen64Canonical  _) = unexpected "decodeMapLen64Canonical"  ts
#endif

    go [TermToken]
ts (ConsumeBytesIndef   ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeBytesIndef"   [TermToken]
ts
    go [TermToken]
ts (ConsumeStringIndef  ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeStringIndef"  [TermToken]
ts
    go [TermToken]
ts (ConsumeListLenIndef ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeListLenIndef" [TermToken]
ts
    go [TermToken]
ts (ConsumeMapLenIndef  ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeMapLenIndef"  [TermToken]
ts
    go [TermToken]
ts (ConsumeNull         ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeNull"         [TermToken]
ts

    go [TermToken]
ts (ConsumeListLenOrIndef Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeListLenOrIndef" [TermToken]
ts
    go [TermToken]
ts (ConsumeMapLenOrIndef  Int# -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeMapLenOrIndef"  [TermToken]
ts
    go [TermToken]
ts (ConsumeBreakOr        Bool -> ST s (DecodeAction s a)
_) = forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
String -> [a] -> m (Either String b)
unexpected String
"decodeBreakOr"        [TermToken]
ts

    unexpected :: String -> [a] -> m (Either String b)
unexpected String
name []      = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
name forall a. [a] -> [a] -> [a]
++ String
": unexpected end of input"
    unexpected String
name (a
tok:[a]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
name forall a. [a] -> [a] -> [a]
++ String
": unexpected token " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
tok

-- | Map a 'TermToken' to the underlying CBOR 'TokenType'
tokenTypeOf :: TermToken -> TokenType
tokenTypeOf :: TermToken -> TokenType
tokenTypeOf (TkInt Int
n)
    | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0                          = TokenType
TypeUInt
    | Bool
otherwise                       = TokenType
TypeNInt
tokenTypeOf (TkInteger Integer
n)   -- See https://github.com/well-typed/cborg/issues/324
  | Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
n Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
0xffffffffffffffff = TokenType
TypeUInt64 -- 0xffffffffffffffff == 2^64 - 1
  | -Integer
0xffffffffffffffff forall a. Ord a => a -> a -> Bool
<= Integer
n Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = TokenType
TypeNInt64
  | Bool
otherwise                         = TokenType
TypeInteger
tokenTypeOf TkBytes{}                 = TokenType
TypeBytes
tokenTypeOf TkBytesBegin{}            = TokenType
TypeBytesIndef
tokenTypeOf TkString{}                = TokenType
TypeString
tokenTypeOf TkStringBegin{}           = TokenType
TypeStringIndef
tokenTypeOf TkListLen{}               = TokenType
TypeListLen
tokenTypeOf TkListBegin{}             = TokenType
TypeListLenIndef
tokenTypeOf TkMapLen{}                = TokenType
TypeMapLen
tokenTypeOf TkMapBegin{}              = TokenType
TypeMapLenIndef
tokenTypeOf TkTag{}                   = TokenType
TypeTag
tokenTypeOf TkBool{}                  = TokenType
TypeBool
tokenTypeOf TermToken
TkNull                    = TokenType
TypeNull
tokenTypeOf TermToken
TkBreak                   = TokenType
TypeBreak
tokenTypeOf TkSimple{}                = TokenType
TypeSimple
tokenTypeOf TkFloat16{}               = TokenType
TypeFloat16
tokenTypeOf TkFloat32{}               = TokenType
TypeFloat32
tokenTypeOf TkFloat64{}               = TokenType
TypeFloat64

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

-- | Ensure a 'FlatTerm' is internally consistent and was created in a valid
-- manner.
--
-- @since 0.2.0.0
validFlatTerm :: FlatTerm -- ^ The input 'FlatTerm'
              -> Bool     -- ^ 'True' if valid, 'False' otherwise.
validFlatTerm :: [TermToken] -> Bool
validFlatTerm [TermToken]
ts =
   forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True) forall a b. (a -> b) -> a -> b
$ do
     [TermToken]
ts' <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm Loc
TopLevelSingle [TermToken]
ts
     case [TermToken]
ts' of
       [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       [TermToken]
_  -> forall a b. a -> Either a b
Left String
"trailing data"

-- | A data type used for tracking the position we're at
-- as we traverse a 'FlatTerm' and make sure it's valid.
data Loc = TopLevelSingle
         | TopLevelSequence
         | InString   Int     Loc
         | InBytes    Int     Loc
         | InListN    Int Int Loc
         | InList     Int     Loc
         | InMapNKey  Int Int Loc
         | InMapNVal  Int Int Loc
         | InMapKey   Int     Loc
         | InMapVal   Int     Loc
         | InTagged   Word64  Loc
  deriving Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> String
$cshow :: Loc -> String
showsPrec :: Int -> Loc -> ShowS
$cshowsPrec :: Int -> Loc -> ShowS
Show

-- | Validate an arbitrary 'FlatTerm' at an arbitrary location.
validateTerm :: Loc -> FlatTerm -> Either String FlatTerm
validateTerm :: Loc -> [TermToken] -> Either String [TermToken]
validateTerm Loc
_loc (TkInt       Int
_   : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm Loc
_loc (TkInteger   Integer
_   : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm Loc
_loc (TkBytes     ByteString
_   : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm  Loc
loc (TermToken
TkBytesBegin    : [TermToken]
ts) = Loc -> Int -> [TermToken] -> Either String [TermToken]
validateBytes Loc
loc Int
0 [TermToken]
ts
validateTerm Loc
_loc (TkString    Text
_   : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm  Loc
loc (TermToken
TkStringBegin   : [TermToken]
ts) = Loc -> Int -> [TermToken] -> Either String [TermToken]
validateString Loc
loc Int
0 [TermToken]
ts
validateTerm  Loc
loc (TkListLen   Word
len : [TermToken]
ts)
    | Word
len forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                      = Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateListN Loc
loc Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
len) [TermToken]
ts
    | Bool
otherwise                          = forall a b. a -> Either a b
Left String
"list len too long (> max int)"
validateTerm  Loc
loc (TermToken
TkListBegin     : [TermToken]
ts) = Loc -> Int -> [TermToken] -> Either String [TermToken]
validateList  Loc
loc Int
0     [TermToken]
ts
validateTerm  Loc
loc (TkMapLen    Word
len : [TermToken]
ts)
    | Word
len forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxInt                      = Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateMapN  Loc
loc Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
len) [TermToken]
ts
    | Bool
otherwise                          = forall a b. a -> Either a b
Left String
"map len too long (> max int)"
validateTerm  Loc
loc (TermToken
TkMapBegin      : [TermToken]
ts) = Loc -> Int -> [TermToken] -> Either String [TermToken]
validateMap   Loc
loc Int
0     [TermToken]
ts
validateTerm  Loc
loc (TkTag       Word64
w   : [TermToken]
ts) = Loc -> [TermToken] -> Either String [TermToken]
validateTerm  (Word64 -> Loc -> Loc
InTagged Word64
w Loc
loc) [TermToken]
ts
validateTerm Loc
_loc (TkBool      Bool
_   : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm Loc
_loc (TermToken
TkNull          : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm  Loc
loc (TermToken
TkBreak         : [TermToken]
_)  = forall a. TermToken -> Loc -> Either String a
unexpectedToken TermToken
TkBreak Loc
loc
validateTerm Loc
_loc (TkSimple  Word8
_     : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm Loc
_loc (TkFloat16 Float
_     : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm Loc
_loc (TkFloat32 Float
_     : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm Loc
_loc (TkFloat64 Double
_     : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateTerm  Loc
loc                    []  = forall a. Loc -> Either String a
unexpectedEof Loc
loc

unexpectedToken :: TermToken -> Loc -> Either String a
unexpectedToken :: forall a. TermToken -> Loc -> Either String a
unexpectedToken TermToken
tok Loc
loc = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"unexpected token " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TermToken
tok
                              forall a. [a] -> [a] -> [a]
++ String
", in context " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Loc
loc

unexpectedEof :: Loc -> Either String a
unexpectedEof :: forall a. Loc -> Either String a
unexpectedEof Loc
loc = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"unexpected end of input in context " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Loc
loc

validateBytes :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateBytes :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateBytes Loc
_    Int
_ (TermToken
TkBreak   : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateBytes Loc
ploc Int
i (TkBytes ByteString
_ : [TermToken]
ts) = Loc -> Int -> [TermToken] -> Either String [TermToken]
validateBytes Loc
ploc (Int
iforall a. Num a => a -> a -> a
+Int
1) [TermToken]
ts
validateBytes Loc
ploc Int
i (TermToken
tok       : [TermToken]
_)  = forall a. TermToken -> Loc -> Either String a
unexpectedToken TermToken
tok (Int -> Loc -> Loc
InBytes Int
i Loc
ploc)
validateBytes Loc
ploc Int
i []               = forall a. Loc -> Either String a
unexpectedEof       (Int -> Loc -> Loc
InBytes Int
i Loc
ploc)

validateString :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateString :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateString Loc
_    Int
_ (TermToken
TkBreak    : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateString Loc
ploc Int
i (TkString Text
_ : [TermToken]
ts) = Loc -> Int -> [TermToken] -> Either String [TermToken]
validateString Loc
ploc (Int
iforall a. Num a => a -> a -> a
+Int
1) [TermToken]
ts
validateString Loc
ploc Int
i (TermToken
tok        : [TermToken]
_)  = forall a. TermToken -> Loc -> Either String a
unexpectedToken TermToken
tok (Int -> Loc -> Loc
InString Int
i Loc
ploc)
validateString Loc
ploc Int
i []                = forall a. Loc -> Either String a
unexpectedEof       (Int -> Loc -> Loc
InString Int
i Loc
ploc)

validateListN :: Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateListN :: Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateListN    Loc
_ Int
i Int
len [TermToken]
ts | Int
i forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateListN Loc
ploc Int
i Int
len [TermToken]
ts = do
    [TermToken]
ts' <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm (Int -> Int -> Loc -> Loc
InListN Int
i Int
len Loc
ploc) [TermToken]
ts
    Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateListN Loc
ploc (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
len [TermToken]
ts'

validateList :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateList :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateList Loc
_    Int
_ (TermToken
TkBreak : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateList Loc
ploc Int
i [TermToken]
ts = do
    [TermToken]
ts' <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm (Int -> Loc -> Loc
InList Int
i Loc
ploc) [TermToken]
ts
    Loc -> Int -> [TermToken] -> Either String [TermToken]
validateList Loc
ploc (Int
iforall a. Num a => a -> a -> a
+Int
1) [TermToken]
ts'

validateMapN :: Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateMapN :: Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateMapN    Loc
_ Int
i Int
len [TermToken]
ts  | Int
i forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateMapN Loc
ploc Int
i Int
len [TermToken]
ts  = do
    [TermToken]
ts'  <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm (Int -> Int -> Loc -> Loc
InMapNKey Int
i Int
len Loc
ploc) [TermToken]
ts
    [TermToken]
ts'' <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm (Int -> Int -> Loc -> Loc
InMapNVal Int
i Int
len Loc
ploc) [TermToken]
ts'
    Loc -> Int -> Int -> [TermToken] -> Either String [TermToken]
validateMapN Loc
ploc (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
len [TermToken]
ts''

validateMap :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateMap :: Loc -> Int -> [TermToken] -> Either String [TermToken]
validateMap Loc
_    Int
_ (TermToken
TkBreak : [TermToken]
ts) = forall (m :: * -> *) a. Monad m => a -> m a
return [TermToken]
ts
validateMap Loc
ploc Int
i [TermToken]
ts = do
    [TermToken]
ts'  <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm (Int -> Loc -> Loc
InMapKey Int
i Loc
ploc) [TermToken]
ts
    [TermToken]
ts'' <- Loc -> [TermToken] -> Either String [TermToken]
validateTerm (Int -> Loc -> Loc
InMapVal Int
i Loc
ploc) [TermToken]
ts'
    Loc -> Int -> [TermToken] -> Either String [TermToken]
validateMap Loc
ploc (Int
iforall a. Num a => a -> a -> a
+Int
1) [TermToken]
ts''

--------------------------------------------------------------------------------
-- Utilities

maxInt, minInt, maxWord :: Num n => n
maxInt :: forall n. Num n => n
maxInt    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
minInt :: forall n. Num n => n
minInt    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int)
maxWord :: forall n. Num n => n
maxWord   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word)

maxInt8, minInt8, maxWord8 :: Num n => n
maxInt8 :: forall n. Num n => n
maxInt8    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int8)
minInt8 :: forall n. Num n => n
minInt8    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int8)
maxWord8 :: forall n. Num n => n
maxWord8   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word8)

maxInt16, minInt16, maxWord16 :: Num n => n
maxInt16 :: forall n. Num n => n
maxInt16    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)
minInt16 :: forall n. Num n => n
minInt16    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int16)
maxWord16 :: forall n. Num n => n
maxWord16   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word16)

maxInt32, minInt32, maxWord32 :: Num n => n
maxInt32 :: forall n. Num n => n
maxInt32    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int32)
minInt32 :: forall n. Num n => n
minInt32    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int32)
maxWord32 :: forall n. Num n => n
maxWord32   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32)

-- | Do a careful check to ensure an 'Int' is in the
-- range of a 'Word32'.
intIsValidWord32 :: Int -> Bool
intIsValidWord32 :: Int -> Bool
intIsValidWord32 Int
n = Bool
b1 Bool -> Bool -> Bool
&& Bool
b2
  where
    -- NOTE: this first comparison must use Int for
    -- the check, not Word32, in case a negative value
    -- is given. Otherwise this check would fail due to
    -- overflow.
    b1 :: Bool
b1 = Int
n forall a. Ord a => a -> a -> Bool
>= Int
0
    -- NOTE: we must convert n to Word32, otherwise,
    -- maxWord32 is inferred as Int, and because
    -- the maxBound of Word32 is greater than Int,
    -- it overflows and this check fails.
    b2 :: Bool
b2 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word32) forall a. Ord a => a -> a -> Bool
<= forall n. Num n => n
maxWord32

unI# :: Int -> Int#
unI# :: Int -> Int#
unI#   (I#   Int#
i#) = Int#
i#

unW# :: Word -> Word#
unW# :: Word -> Word#
unW#   (W#  Word#
w#) = Word#
w#

unW8# :: Word8 -> Word#
#if MIN_VERSION_ghc_prim(0,8,0)
unW8# :: Word8 -> Word#
unW8#  (W8# Word8#
w#) = Word8# -> Word#
word8ToWord# Word8#
w#
#else
unW8#  (W8# w#) = w#
#endif

unF# :: Float -> Float#
unF# :: Float -> Float#
unF#   (F#   Float#
f#) = Float#
f#

unD# :: Double -> Double#
unD# :: Double -> Double#
unD#   (D#   Double#
f#) = Double#
f#

#if defined(ARCH_32bit)
unW64# :: Word64 -> Word64#
unW64# (W64# w#) = w#

unI64# :: Int64 -> Int64#
unI64# (I64# i#) = i#
#endif