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

-- |
-- Module      : Codec.CBOR.Decoding
-- Copyright   : (c) Duncan Coutts 2015-2017
-- License     : BSD3-style (see LICENSE.txt)
--
-- Maintainer  : duncan@community.haskell.org
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- High level API for decoding values that were encoded with the
-- "Codec.CBOR.Encoding" module, using a 'Monad'
-- based interface.
--
module Codec.CBOR.Decoding
  ( -- * Decode primitive operations
    Decoder
  , DecodeAction(..)
  , liftST
  , getDecodeAction

  -- ** Read input tokens
  , decodeWord          -- :: Decoder s Word
  , decodeWord8         -- :: Decoder s Word8
  , decodeWord16        -- :: Decoder s Word16
  , decodeWord32        -- :: Decoder s Word32
  , decodeWord64        -- :: Decoder s Word64
  , decodeNegWord       -- :: Decoder s Word
  , decodeNegWord64     -- :: Decoder s Word64
  , decodeInt           -- :: Decoder s Int
  , decodeInt8          -- :: Decoder s Int8
  , decodeInt16         -- :: Decoder s Int16
  , decodeInt32         -- :: Decoder s Int32
  , decodeInt64         -- :: Decoder s Int64
  , decodeInteger       -- :: Decoder s Integer
  , decodeFloat         -- :: Decoder s Float
  , decodeDouble        -- :: Decoder s Double
  , decodeBytes         -- :: Decoder s ByteString
  , decodeBytesIndef    -- :: Decoder s ()
  , decodeByteArray     -- :: Decoder s ByteArray
  , decodeString        -- :: Decoder s Text
  , decodeStringIndef   -- :: Decoder s ()
  , decodeUtf8ByteArray -- :: Decoder s ByteArray
  , decodeListLen       -- :: Decoder s Int
  , decodeListLenIndef  -- :: Decoder s ()
  , decodeMapLen        -- :: Decoder s Int
  , decodeMapLenIndef   -- :: Decoder s ()
  , decodeTag           -- :: Decoder s Word
  , decodeTag64         -- :: Decoder s Word64
  , decodeBool          -- :: Decoder s Bool
  , decodeNull          -- :: Decoder s ()
  , decodeSimple        -- :: Decoder s Word8

  -- ** Specialised Read input token operations
  , decodeWordOf        -- :: Word -> Decoder s ()
  , decodeListLenOf     -- :: Int  -> Decoder s ()

  -- ** Branching operations
--, decodeBytesOrIndef
--, decodeStringOrIndef
  , decodeListLenOrIndef -- :: Decoder s (Maybe Int)
  , decodeMapLenOrIndef  -- :: Decoder s (Maybe Int)
  , decodeBreakOr        -- :: Decoder s Bool

  -- ** Inspecting the token type
  , peekTokenType        -- :: Decoder s TokenType
  , TokenType(..)

  -- ** Special operations
  , peekAvailable        -- :: Decoder s Int
  , ByteOffset
  , peekByteOffset       -- :: Decoder s ByteOffset
  , decodeWithByteSpan

  -- ** Canonical CBOR
  -- $canonical
  , decodeWordCanonical      -- :: Decoder s Word
  , decodeWord8Canonical     -- :: Decoder s Word8
  , decodeWord16Canonical    -- :: Decoder s Word16
  , decodeWord32Canonical    -- :: Decoder s Word32
  , decodeWord64Canonical    -- :: Decoder s Word64
  , decodeNegWordCanonical   -- :: Decoder s Word
  , decodeNegWord64Canonical -- :: Decoder s Word64
  , decodeIntCanonical       -- :: Decoder s Int
  , decodeInt8Canonical      -- :: Decoder s Int8
  , decodeInt16Canonical     -- :: Decoder s Int16
  , decodeInt32Canonical     -- :: Decoder s Int32
  , decodeInt64Canonical     -- :: Decoder s Int64
  , decodeBytesCanonical -- :: Decoder s ByteString
  , decodeByteArrayCanonical -- :: Decoder s ByteArray
  , decodeStringCanonical -- :: Decoder s Text
  , decodeUtf8ByteArrayCanonical -- :: Decoder s ByteArray
  , decodeListLenCanonical -- :: Decoder s Int
  , decodeMapLenCanonical -- :: Decoder s Int
  , decodeTagCanonical   -- :: Decoder s Word
  , decodeTag64Canonical -- :: Decoder s Word64
  , decodeIntegerCanonical -- :: Decoder s Integer
  , decodeFloat16Canonical -- :: Decoder s Float
  , decodeFloatCanonical   -- :: Decoder s Float
  , decodeDoubleCanonical  -- :: Decoder s Double
  , decodeSimpleCanonical  -- :: Decoder s Word8
  , decodeWordCanonicalOf    -- :: Word -> Decoder s ()
  , decodeListLenCanonicalOf -- :: Int  -> Decoder s ()

  -- * Sequence operations
  , decodeSequenceLenIndef -- :: ...
  , decodeSequenceLenN     -- :: ...
  ) where

#include "cbor.h"

import           GHC.Exts
import           GHC.Word
import           GHC.Int
import           Data.Text (Text)
import           Data.ByteString (ByteString)
import           Control.Applicative
import           Control.Monad.ST
import qualified Control.Monad.Fail as Fail

import           Codec.CBOR.ByteArray (ByteArray)

import           Prelude hiding (decodeFloat)


-- | A continuation-based decoder, used for decoding values that were
-- previously encoded using the "Codec.CBOR.Encoding"
-- module. As 'Decoder' has a 'Monad' instance, you can easily
-- write 'Decoder's monadically for building your deserialisation
-- logic.
--
-- @since 0.2.0.0
newtype Decoder s a = Decoder {
       runDecoder :: forall r. (a -> ST s (DecodeAction s r)) -> ST s (DecodeAction s r)
     }

-- | An action, representing a step for a decoder to taken and a
-- continuation to invoke with the expected value.
--
-- @since 0.2.0.0
data DecodeAction s a
    = ConsumeWord    (Word# -> ST s (DecodeAction s a))
    | ConsumeWord8   (Word# -> ST s (DecodeAction s a))
    | ConsumeWord16  (Word# -> ST s (DecodeAction s a))
    | ConsumeWord32  (Word# -> ST s (DecodeAction s a))
    | ConsumeNegWord (Word# -> ST s (DecodeAction s a))
    | ConsumeInt     (Int#  -> ST s (DecodeAction s a))
    | ConsumeInt8    (Int#  -> ST s (DecodeAction s a))
    | ConsumeInt16   (Int#  -> ST s (DecodeAction s a))
    | ConsumeInt32   (Int#  -> ST s (DecodeAction s a))
    | ConsumeListLen (Int#  -> ST s (DecodeAction s a))
    | ConsumeMapLen  (Int#  -> ST s (DecodeAction s a))
    | ConsumeTag     (Word# -> ST s (DecodeAction s a))

-- 64bit variants for 32bit machines
#if defined(ARCH_32bit)
    | ConsumeWord64    (Word64# -> ST s (DecodeAction s a))
    | ConsumeNegWord64 (Word64# -> ST s (DecodeAction s a))
    | ConsumeInt64     (Int64#  -> ST s (DecodeAction s a))
    | ConsumeListLen64 (Int64#  -> ST s (DecodeAction s a))
    | ConsumeMapLen64  (Int64#  -> ST s (DecodeAction s a))
    | ConsumeTag64     (Word64# -> ST s (DecodeAction s a))
#endif

    | ConsumeInteger       (Integer   -> ST s (DecodeAction s a))
    | ConsumeFloat         (Float#    -> ST s (DecodeAction s a))
    | ConsumeDouble        (Double#   -> ST s (DecodeAction s a))
    | ConsumeBytes         (ByteString-> ST s (DecodeAction s a))
    | ConsumeByteArray     (ByteArray -> ST s (DecodeAction s a))
    | ConsumeString        (Text      -> ST s (DecodeAction s a))
    | ConsumeUtf8ByteArray (ByteArray -> ST s (DecodeAction s a))
    | ConsumeBool          (Bool      -> ST s (DecodeAction s a))
    | ConsumeSimple        (Word#     -> ST s (DecodeAction s a))

    | ConsumeBytesIndef   (ST s (DecodeAction s a))
    | ConsumeStringIndef  (ST s (DecodeAction s a))
    | ConsumeListLenIndef (ST s (DecodeAction s a))
    | ConsumeMapLenIndef  (ST s (DecodeAction s a))
    | ConsumeNull         (ST s (DecodeAction s a))

    | ConsumeListLenOrIndef (Int# -> ST s (DecodeAction s a))
    | ConsumeMapLenOrIndef  (Int# -> ST s (DecodeAction s a))
    | ConsumeBreakOr        (Bool -> ST s (DecodeAction s a))

    | PeekTokenType  (TokenType -> ST s (DecodeAction s a))
    | PeekAvailable  (Int#      -> ST s (DecodeAction s a))
#if defined(ARCH_32bit)
    | PeekByteOffset (Int64#    -> ST s (DecodeAction s a))
#else
    | PeekByteOffset (Int#      -> ST s (DecodeAction s a))
#endif

      -- All the canonical variants
    | ConsumeWordCanonical    (Word# -> ST s (DecodeAction s a))
    | ConsumeWord8Canonical   (Word# -> ST s (DecodeAction s a))
    | ConsumeWord16Canonical  (Word# -> ST s (DecodeAction s a))
    | ConsumeWord32Canonical  (Word# -> ST s (DecodeAction s a))
    | ConsumeNegWordCanonical (Word# -> ST s (DecodeAction s a))
    | ConsumeIntCanonical     (Int#  -> ST s (DecodeAction s a))
    | ConsumeInt8Canonical    (Int#  -> ST s (DecodeAction s a))
    | ConsumeInt16Canonical   (Int#  -> ST s (DecodeAction s a))
    | ConsumeInt32Canonical   (Int#  -> ST s (DecodeAction s a))
    | ConsumeListLenCanonical (Int#  -> ST s (DecodeAction s a))
    | ConsumeMapLenCanonical  (Int#  -> ST s (DecodeAction s a))
    | ConsumeTagCanonical     (Word# -> ST s (DecodeAction s a))

#if defined(ARCH_32bit)
    | ConsumeWord64Canonical    (Word64# -> ST s (DecodeAction s a))
    | ConsumeNegWord64Canonical (Word64# -> ST s (DecodeAction s a))
    | ConsumeInt64Canonical     (Int64#  -> ST s (DecodeAction s a))
    | ConsumeListLen64Canonical (Int64#  -> ST s (DecodeAction s a))
    | ConsumeMapLen64Canonical  (Int64#  -> ST s (DecodeAction s a))
    | ConsumeTag64Canonical     (Word64# -> ST s (DecodeAction s a))
#endif

    | ConsumeIntegerCanonical       (Integer -> ST s (DecodeAction s a))
    | ConsumeFloat16Canonical       (Float#  -> ST s (DecodeAction s a))
    | ConsumeFloatCanonical         (Float#  -> ST s (DecodeAction s a))
    | ConsumeDoubleCanonical        (Double# -> ST s (DecodeAction s a))
    | ConsumeBytesCanonical         (ByteString-> ST s (DecodeAction s a))
    | ConsumeByteArrayCanonical     (ByteArray -> ST s (DecodeAction s a))
    | ConsumeStringCanonical        (Text      -> ST s (DecodeAction s a))
    | ConsumeUtf8ByteArrayCanonical (ByteArray -> ST s (DecodeAction s a))
    | ConsumeSimpleCanonical        (Word#   -> ST s (DecodeAction s a))

    | Fail String
    | Done a

-- | The type of a token, which a decoder can ask for at
-- an arbitrary time.
--
-- @since 0.2.0.0
data TokenType
  = TypeUInt
  | TypeUInt64
  | TypeNInt
  | TypeNInt64
  | TypeInteger
  | TypeFloat16
  | TypeFloat32
  | TypeFloat64
  | TypeBytes
  | TypeBytesIndef
  | TypeString
  | TypeStringIndef
  | TypeListLen
  | TypeListLen64
  | TypeListLenIndef
  | TypeMapLen
  | TypeMapLen64
  | TypeMapLenIndef
  | TypeTag
  | TypeTag64
  | TypeBool
  | TypeNull
  | TypeSimple
  | TypeBreak
  | TypeInvalid
  deriving (Eq, Ord, Enum, Bounded, Show)

-- | @since 0.2.0.0
instance Functor (Decoder s) where
    {-# INLINE fmap #-}
    fmap f = \d -> Decoder $ \k -> runDecoder d (k . f)

-- | @since 0.2.0.0
instance Applicative (Decoder s) where
    {-# INLINE pure #-}
    pure = \x -> Decoder $ \k -> k x

    {-# INLINE (<*>) #-}
    (<*>) = \df dx -> Decoder $ \k ->
                        runDecoder df (\f -> runDecoder dx (\x -> k (f x)))

    {-# INLINE (*>) #-}
    (*>) = \dm dn -> Decoder $ \k -> runDecoder dm (\_ -> runDecoder dn k)

-- | @since 0.2.0.0
instance Monad (Decoder s) where
    return = pure

    {-# INLINE (>>=) #-}
    (>>=) = \dm f -> Decoder $ \k -> runDecoder dm (\m -> runDecoder (f m) k)

    {-# INLINE (>>) #-}
    (>>) = (*>)

#if !MIN_VERSION_base(4,13,0)
    fail = Fail.fail
#endif

-- | @since 0.2.0.0
instance Fail.MonadFail (Decoder s) where
    fail msg = Decoder $ \_ -> return (Fail msg)

-- | Lift an @ST@ action into a @Decoder@. Useful for, e.g., leveraging
-- in-place mutation to efficiently build a deserialised value.
--
-- @since 0.2.0.0
liftST :: ST s a -> Decoder s a
liftST m = Decoder $ \k -> m >>= k

-- | Given a 'Decoder', give us the 'DecodeAction'
--
-- @since 0.2.0.0
getDecodeAction :: Decoder s a -> ST s (DecodeAction s a)
getDecodeAction (Decoder k) = k (\x -> return (Done x))


-- Compatibility Shims
toInt8   :: Int# -> Int8
toInt16  :: Int# -> Int16
toInt32  :: Int# -> Int32
toInt64  :: Int# -> Int64
toWord8  :: Word# -> Word8
toWord16 :: Word# -> Word16
toWord32 :: Word# -> Word32
toWord64 :: Word# -> Word64
#if MIN_VERSION_ghc_prim(0,8,0)
toInt8   n = I8#  (intToInt8# n)
toInt16  n = I16# (intToInt16# n)
toInt32  n = I32# (intToInt32# n)
toWord8  n = W8#  (wordToWord8# n)
toWord16 n = W16# (wordToWord16# n)
toWord32 n = W32# (wordToWord32# n)
#if WORD_SIZE_IN_BITS == 64
#if MIN_VERSION_base(4,17,0)
toInt64  n = I64# (intToInt64# n)
toWord64 n = W64# (wordToWord64# n)
#else
toInt64  n = I64# n
toWord64 n = W64# n
#endif
#else
toInt64  n = I64# (intToInt64# n)
toWord64 n = W64# (wordToWord64# n)
#endif
#else
toInt8   n = I8#  n
toInt16  n = I16# n
toInt32  n = I32# n
toInt64  n = I64# n
toWord8  n = W8#  n
toWord16 n = W16# n
toWord32 n = W32# n
toWord64 n = W64# n
#endif

-- $canonical
--
-- <https://tools.ietf.org/html/rfc7049#section-3.9>
--
-- In general in CBOR there can be multiple representations for the same value,
-- for example the integer @0@ can be represented in 8, 16, 32 or 64 bits. This
-- library always encoded values in the shortest representation but on
-- decoding allows any valid encoding. For some applications it is useful or
-- important to only decode the canonical encoding. The decoder primitives here
-- are to allow applications to implement canonical decoding.
--
-- It is important to note that achieving a canonical representation is /not/
-- simply about using these primitives. For example consider a typical CBOR
-- encoding of a Haskell @Set@ data type. This will be encoded as a CBOR list
-- of the set elements. A typical implementation might be:
--
-- > encodeSet = encodeList . Set.toList
-- > decodeSet = fmap Set.fromList . decodeList
--
-- This /does not/ enforce a canonical encoding. The decoder above will allow
-- set elements in any order. The use of @Set.fromList@ forgets the order.
-- To enforce that the decoder only accepts the canonical encoding it will
-- have to check that the elements in the list are /strictly/ increasing.
-- Similar issues arise in many other data types, wherever there is redundancy
-- in the external representation.
--
-- The decoder primitives in this section are not much more expensive than
-- their normal counterparts. If checking the canonical encoding property is
-- critical then a technique that is more expensive but easier to implement and
-- test is to decode normally, re-encode and check the serialised bytes are the
-- same.

---------------------------------------
-- Read input tokens of various types
--

-- | Decode a 'Word'.
--
-- @since 0.2.0.0
decodeWord :: Decoder s Word
decodeWord = Decoder (\k -> return (ConsumeWord (\w# -> k (W# w#))))
{-# INLINE decodeWord #-}

-- | Decode a 'Word8'.
--
-- @since 0.2.0.0
decodeWord8 :: Decoder s Word8
decodeWord8 = Decoder (\k -> return (ConsumeWord8 (\w# -> k (toWord8 w#))))
{-# INLINE decodeWord8 #-}

-- | Decode a 'Word16'.
--
-- @since 0.2.0.0
decodeWord16 :: Decoder s Word16
decodeWord16 = Decoder (\k -> return (ConsumeWord16 (\w# -> k (toWord16 w#))))
{-# INLINE decodeWord16 #-}

-- | Decode a 'Word32'.
--
-- @since 0.2.0.0
decodeWord32 :: Decoder s Word32
decodeWord32 = Decoder (\k -> return (ConsumeWord32 (\w# -> k (toWord32 w#))))
{-# INLINE decodeWord32 #-}

-- | Decode a 'Word64'.
--
-- @since 0.2.0.0
decodeWord64 :: Decoder s Word64
{-# INLINE decodeWord64 #-}
decodeWord64 =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeWord (\w# -> k (toWord64 w#))))
#else
  Decoder (\k -> return (ConsumeWord64 (\w64# -> k (toWord64 w64#))))
#endif

-- | Decode a negative 'Word'.
--
-- @since 0.2.0.0
decodeNegWord :: Decoder s Word
decodeNegWord = Decoder (\k -> return (ConsumeNegWord (\w# -> k (W# w#))))
{-# INLINE decodeNegWord #-}

-- | Decode a negative 'Word64'.
--
-- @since 0.2.0.0
decodeNegWord64 :: Decoder s Word64
{-# INLINE decodeNegWord64 #-}
decodeNegWord64 =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeNegWord (\w# -> k (toWord64 w#))))
#else
  Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (toWord64 w64#))))
#endif

-- | Decode an 'Int'.
--
-- @since 0.2.0.0
decodeInt :: Decoder s Int
decodeInt = Decoder (\k -> return (ConsumeInt (\n# -> k (I# n#))))
{-# INLINE decodeInt #-}

-- | Decode an 'Int8'.
--
-- @since 0.2.0.0
decodeInt8 :: Decoder s Int8
decodeInt8 = Decoder (\k -> return (ConsumeInt8 (\w# -> k (toInt8 w#))))
{-# INLINE decodeInt8 #-}

-- | Decode an 'Int16'.
--
-- @since 0.2.0.0
decodeInt16 :: Decoder s Int16
decodeInt16 = Decoder (\k -> return (ConsumeInt16 (\w# -> k (toInt16 w#))))
{-# INLINE decodeInt16 #-}

-- | Decode an 'Int32'.
--
-- @since 0.2.0.0
decodeInt32 :: Decoder s Int32
decodeInt32 = Decoder (\k -> return (ConsumeInt32 (\w# -> k (toInt32 w#))))
{-# INLINE decodeInt32 #-}

-- | Decode an 'Int64'.
--
-- @since 0.2.0.0
decodeInt64 :: Decoder s Int64
{-# INLINE decodeInt64 #-}
decodeInt64 =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeInt (\n# -> k (toInt64 n#))))
#else
  Decoder (\k -> return (ConsumeInt64 (\n64# -> k (toInt64 n64#))))
#endif

-- | Decode canonical representation of a 'Word'.
--
-- @since 0.2.0.0
decodeWordCanonical :: Decoder s Word
decodeWordCanonical = Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (W# w#))))
{-# INLINE decodeWordCanonical #-}

-- | Decode canonical representation of a 'Word8'.
--
-- @since 0.2.0.0
decodeWord8Canonical :: Decoder s Word8
decodeWord8Canonical = Decoder (\k -> return (ConsumeWord8Canonical (\w# -> k (toWord8 w#))))
{-# INLINE decodeWord8Canonical #-}

-- | Decode canonical representation of a 'Word16'.
--
-- @since 0.2.0.0
decodeWord16Canonical :: Decoder s Word16
decodeWord16Canonical = Decoder (\k -> return (ConsumeWord16Canonical (\w# -> k (toWord16 w#))))
{-# INLINE decodeWord16Canonical #-}

-- | Decode canonical representation of a 'Word32'.
--
-- @since 0.2.0.0
decodeWord32Canonical :: Decoder s Word32
decodeWord32Canonical = Decoder (\k -> return (ConsumeWord32Canonical (\w# -> k (toWord32 w#))))
{-# INLINE decodeWord32Canonical #-}

-- | Decode canonical representation of a 'Word64'.
--
-- @since 0.2.0.0
decodeWord64Canonical :: Decoder s Word64
{-# INLINE decodeWord64Canonical #-}
decodeWord64Canonical =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (toWord64 w#))))
#else
  Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (toWord64 w64#))))
#endif

-- | Decode canonical representation of a negative 'Word'.
--
-- @since 0.2.0.0
decodeNegWordCanonical :: Decoder s Word
decodeNegWordCanonical = Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (W# w#))))
{-# INLINE decodeNegWordCanonical #-}

-- | Decode canonical representation of a negative 'Word64'.
--
-- @since 0.2.0.0
decodeNegWord64Canonical :: Decoder s Word64
{-# INLINE decodeNegWord64Canonical #-}
decodeNegWord64Canonical =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (toWord64 w#))))
#else
  Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (toWord64 w64#))))
#endif

-- | Decode canonical representation of an 'Int'.
--
-- @since 0.2.0.0
decodeIntCanonical :: Decoder s Int
decodeIntCanonical = Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (I# n#))))
{-# INLINE decodeIntCanonical #-}

-- | Decode canonical representation of an 'Int8'.
--
-- @since 0.2.0.0
decodeInt8Canonical :: Decoder s Int8
decodeInt8Canonical = Decoder (\k -> return (ConsumeInt8Canonical (\w# -> k (toInt8 w#))))
{-# INLINE decodeInt8Canonical #-}

-- | Decode canonical representation of an 'Int16'.
--
-- @since 0.2.0.0
decodeInt16Canonical :: Decoder s Int16
decodeInt16Canonical = Decoder (\k -> return (ConsumeInt16Canonical (\w# -> k (toInt16 w#))))
{-# INLINE decodeInt16Canonical #-}

-- | Decode canonical representation of an 'Int32'.
--
-- @since 0.2.0.0
decodeInt32Canonical :: Decoder s Int32
decodeInt32Canonical = Decoder (\k -> return (ConsumeInt32Canonical (\w# -> k (toInt32 w#))))
{-# INLINE decodeInt32Canonical #-}

-- | Decode canonical representation of an 'Int64'.
--
-- @since 0.2.0.0
decodeInt64Canonical :: Decoder s Int64
{-# INLINE decodeInt64Canonical #-}
decodeInt64Canonical =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (toInt64 n#))))
#else
  Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (toInt64 n64#))))
#endif

-- | Decode an 'Integer'.
--
-- @since 0.2.0.0
decodeInteger :: Decoder s Integer
decodeInteger = Decoder (\k -> return (ConsumeInteger (\n -> k n)))
{-# INLINE decodeInteger #-}

-- | Decode a 'Float'.
--
-- @since 0.2.0.0
decodeFloat :: Decoder s Float
decodeFloat = Decoder (\k -> return (ConsumeFloat (\f# -> k (F# f#))))
{-# INLINE decodeFloat #-}

-- | Decode a 'Double'.
--
-- @since 0.2.0.0
decodeDouble :: Decoder s Double
decodeDouble = Decoder (\k -> return (ConsumeDouble (\f# -> k (D# f#))))
{-# INLINE decodeDouble #-}

-- | Decode a string of bytes as a 'ByteString'.
--
-- @since 0.2.0.0
decodeBytes :: Decoder s ByteString
decodeBytes = Decoder (\k -> return (ConsumeBytes (\bs -> k bs)))
{-# INLINE decodeBytes #-}

-- | Decode canonical representation of a string of bytes as a 'ByteString'.
--
-- @since 0.2.1.0
decodeBytesCanonical :: Decoder s ByteString
decodeBytesCanonical = Decoder (\k -> return (ConsumeBytesCanonical (\bs -> k bs)))
{-# INLINE decodeBytesCanonical #-}

-- | Decode a token marking the beginning of an indefinite length
-- set of bytes.
--
-- @since 0.2.0.0
decodeBytesIndef :: Decoder s ()
decodeBytesIndef = Decoder (\k -> return (ConsumeBytesIndef (k ())))
{-# INLINE decodeBytesIndef #-}

-- | Decode a string of bytes as a 'ByteArray'.
--
-- Also note that this will eagerly copy the content out of the input
-- to ensure that the input does not leak in the event that the 'ByteArray' is
-- live but not forced.
--
-- @since 0.2.0.0
decodeByteArray :: Decoder s ByteArray
decodeByteArray = Decoder (\k -> return (ConsumeByteArray k))
{-# INLINE decodeByteArray #-}

-- | Decode canonical representation of a string of bytes as a 'ByteArray'.
--
-- Also note that this will eagerly copy the content out of the input
-- to ensure that the input does not leak in the event that the 'ByteArray' is
-- live but not forced.
--
-- @since 0.2.1.0
decodeByteArrayCanonical :: Decoder s ByteArray
decodeByteArrayCanonical = Decoder (\k -> return (ConsumeByteArrayCanonical k))
{-# INLINE decodeByteArrayCanonical #-}

-- | Decode a textual string as a piece of 'Text'.
--
-- @since 0.2.0.0
decodeString :: Decoder s Text
decodeString = Decoder (\k -> return (ConsumeString (\str -> k str)))
{-# INLINE decodeString #-}

-- | Decode canonical representation of a textual string as a piece of 'Text'.
--
-- @since 0.2.1.0
decodeStringCanonical :: Decoder s Text
decodeStringCanonical = Decoder (\k -> return (ConsumeStringCanonical (\str -> k str)))
{-# INLINE decodeStringCanonical #-}

-- | Decode a token marking the beginning of an indefinite length
-- string.
--
-- @since 0.2.0.0
decodeStringIndef :: Decoder s ()
decodeStringIndef = Decoder (\k -> return (ConsumeStringIndef (k ())))
{-# INLINE decodeStringIndef #-}

-- | Decode a textual string as UTF-8 encoded 'ByteArray'. Note that
-- the result is not validated to be well-formed UTF-8.
--
-- Also note that this will eagerly copy the content out of the input
-- to ensure that the input does not leak in the event that the 'ByteArray' is
-- live but not forced.
--
-- @since 0.2.0.0
decodeUtf8ByteArray :: Decoder s ByteArray
decodeUtf8ByteArray = Decoder (\k -> return (ConsumeUtf8ByteArray k))
{-# INLINE decodeUtf8ByteArray #-}

-- | Decode canonical representation of a textual string as UTF-8 encoded
-- 'ByteArray'. Note that the result is not validated to be well-formed UTF-8.
--
-- Also note that this will eagerly copy the content out of the input
-- to ensure that the input does not leak in the event that the 'ByteArray' is
-- live but not forced.
--
-- @since 0.2.1.0
decodeUtf8ByteArrayCanonical :: Decoder s ByteArray
decodeUtf8ByteArrayCanonical = Decoder (\k -> return (ConsumeUtf8ByteArrayCanonical k))
{-# INLINE decodeUtf8ByteArrayCanonical #-}

-- | Decode the length of a list.
--
-- @since 0.2.0.0
decodeListLen :: Decoder s Int
decodeListLen = Decoder (\k -> return (ConsumeListLen (\n# -> k (I# n#))))
{-# INLINE decodeListLen #-}

-- | Decode canonical representation of the length of a list.
--
-- @since 0.2.0.0
decodeListLenCanonical :: Decoder s Int
decodeListLenCanonical = Decoder (\k -> return (ConsumeListLenCanonical (\n# -> k (I# n#))))
{-# INLINE decodeListLenCanonical #-}

-- | Decode a token marking the beginning of a list of indefinite
-- length.
--
-- @since 0.2.0.0
decodeListLenIndef :: Decoder s ()
decodeListLenIndef = Decoder (\k -> return (ConsumeListLenIndef (k ())))
{-# INLINE decodeListLenIndef #-}

-- | Decode the length of a map.
--
-- @since 0.2.0.0
decodeMapLen :: Decoder s Int
decodeMapLen = Decoder (\k -> return (ConsumeMapLen (\n# -> k (I# n#))))
{-# INLINE decodeMapLen #-}

-- | Decode canonical representation of the length of a map.
--
-- @since 0.2.0.0
decodeMapLenCanonical :: Decoder s Int
decodeMapLenCanonical = Decoder (\k -> return (ConsumeMapLenCanonical (\n# -> k (I# n#))))
{-# INLINE decodeMapLenCanonical #-}

-- | Decode a token marking the beginning of a map of indefinite
-- length.
--
-- @since 0.2.0.0
decodeMapLenIndef :: Decoder s ()
decodeMapLenIndef = Decoder (\k -> return (ConsumeMapLenIndef (k ())))
{-# INLINE decodeMapLenIndef #-}

-- | Decode an arbitrary tag and return it as a 'Word'.
--
-- @since 0.2.0.0
decodeTag :: Decoder s Word
decodeTag = Decoder (\k -> return (ConsumeTag (\w# -> k (W# w#))))
{-# INLINE decodeTag #-}

-- | Decode an arbitrary 64-bit tag and return it as a 'Word64'.
--
-- @since 0.2.0.0
decodeTag64 :: Decoder s Word64
{-# INLINE decodeTag64 #-}
decodeTag64 =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeTag (\w# -> k (W64#
#if MIN_VERSION_base(4,17,0)
    (wordToWord64# w#)
#else
    w#
#endif
  ))))
#else
  Decoder (\k -> return (ConsumeTag64 (\w64# -> k (W64# w64#))))
#endif

-- | Decode canonical representation of an arbitrary tag and return it as a
-- 'Word'.
--
-- @since 0.2.0.0
decodeTagCanonical :: Decoder s Word
decodeTagCanonical = Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W# w#))))
{-# INLINE decodeTagCanonical #-}

-- | Decode canonical representation of an arbitrary 64-bit tag and return it as
-- a 'Word64'.
--
-- @since 0.2.0.0
decodeTag64Canonical :: Decoder s Word64
{-# INLINE decodeTag64Canonical #-}
decodeTag64Canonical =
#if defined(ARCH_64bit)
  Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W64#
#if MIN_VERSION_base(4,17,0)
    (wordToWord64# w#)
#else
    w#
#endif
  ))))
#else
  Decoder (\k -> return (ConsumeTag64Canonical (\w64# -> k (W64# w64#))))
#endif

-- | Decode a bool.
--
-- @since 0.2.0.0
decodeBool :: Decoder s Bool
decodeBool = Decoder (\k -> return (ConsumeBool (\b -> k b)))
{-# INLINE decodeBool #-}

-- | Decode a nullary value, and return a unit value.
--
-- @since 0.2.0.0
decodeNull :: Decoder s ()
decodeNull = Decoder (\k -> return (ConsumeNull (k ())))
{-# INLINE decodeNull #-}

-- | Decode a 'simple' CBOR value and give back a 'Word8'. You
-- probably don't ever need to use this.
--
-- @since 0.2.0.0
decodeSimple :: Decoder s Word8
decodeSimple = Decoder (\k -> return (ConsumeSimple (\w# -> k (toWord8 w#))))
{-# INLINE decodeSimple #-}

-- | Decode canonical representation of an 'Integer'.
--
-- @since 0.2.0.0
decodeIntegerCanonical :: Decoder s Integer
decodeIntegerCanonical = Decoder (\k -> return (ConsumeIntegerCanonical (\n -> k n)))
{-# INLINE decodeIntegerCanonical #-}

-- | Decode canonical representation of a half-precision 'Float'.
--
-- @since 0.2.0.0
decodeFloat16Canonical :: Decoder s Float
decodeFloat16Canonical = Decoder (\k -> return (ConsumeFloat16Canonical (\f# -> k (F# f#))))
{-# INLINE decodeFloat16Canonical #-}

-- | Decode canonical representation of a 'Float'.
--
-- @since 0.2.0.0
decodeFloatCanonical :: Decoder s Float
decodeFloatCanonical = Decoder (\k -> return (ConsumeFloatCanonical (\f# -> k (F# f#))))
{-# INLINE decodeFloatCanonical #-}

-- | Decode canonical representation of a 'Double'.
--
-- @since 0.2.0.0
decodeDoubleCanonical :: Decoder s Double
decodeDoubleCanonical = Decoder (\k -> return (ConsumeDoubleCanonical (\f# -> k (D# f#))))
{-# INLINE decodeDoubleCanonical #-}

-- | Decode canonical representation of a 'simple' CBOR value and give back a
-- 'Word8'. You probably don't ever need to use this.
--
-- @since 0.2.0.0
decodeSimpleCanonical :: Decoder s Word8
decodeSimpleCanonical = Decoder (\k -> return (ConsumeSimpleCanonical (\w# -> k (toWord8 w#))))
{-# INLINE decodeSimpleCanonical #-}

--------------------------------------------------------------
-- Specialised read operations: expect a token with a specific value
--

-- | Attempt to decode a word with 'decodeWord', and ensure the word
-- is exactly as expected, or fail.
--
-- @since 0.2.0.0
decodeWordOf :: Word -- ^ Expected value of the decoded word
             -> Decoder s ()
decodeWordOf = decodeWordOfHelper decodeWord
{-# INLINE decodeWordOf #-}

-- | Attempt to decode a list length using 'decodeListLen', and
-- ensure it is exactly the specified length, or fail.
--
-- @since 0.2.0.0
decodeListLenOf :: Int -> Decoder s ()
decodeListLenOf = decodeListLenOfHelper decodeListLen
{-# INLINE decodeListLenOf #-}

-- | Attempt to decode canonical representation of a word with 'decodeWordCanonical',
-- and ensure the word is exactly as expected, or fail.
--
-- @since 0.2.0.0
decodeWordCanonicalOf :: Word -- ^ Expected value of the decoded word
                      -> Decoder s ()
decodeWordCanonicalOf = decodeWordOfHelper decodeWordCanonical
{-# INLINE decodeWordCanonicalOf #-}

-- | Attempt to decode canonical representation of a list length using
-- 'decodeListLenCanonical', and ensure it is exactly the specified length, or
-- fail.
--
-- @since 0.2.0.0
decodeListLenCanonicalOf :: Int -> Decoder s ()
decodeListLenCanonicalOf = decodeListLenOfHelper decodeListLenCanonical
{-# INLINE decodeListLenCanonicalOf #-}

decodeListLenOfHelper :: (Show a, Eq a, Fail.MonadFail m) => m a -> a -> m ()
decodeListLenOfHelper decodeFun = \len -> do
  len' <- decodeFun
  if len == len' then return ()
                 else fail $ "expected list of length " ++ show len
{-# INLINE decodeListLenOfHelper #-}

decodeWordOfHelper :: (Show a, Eq a, Fail.MonadFail m) => m a -> a -> m ()
decodeWordOfHelper decodeFun = \n -> do
  n' <- decodeFun
  if n == n' then return ()
             else fail $ "expected word " ++ show n
{-# INLINE decodeWordOfHelper #-}

--------------------------------------------------------------
-- Branching operations

-- | Attempt to decode a token for the length of a finite, known list,
-- or an indefinite list. If 'Nothing' is returned, then an
-- indefinite length list occurs afterwords. If @'Just' x@ is
-- returned, then a list of length @x@ is encoded.
--
-- @since 0.2.0.0
decodeListLenOrIndef :: Decoder s (Maybe Int)
decodeListLenOrIndef =
    Decoder (\k -> return (ConsumeListLenOrIndef (\n# ->
                     if I# n# >= 0
                       then k (Just (I# n#))
                       else k Nothing)))
{-# INLINE decodeListLenOrIndef #-}

-- | Attempt to decode a token for the length of a finite, known map,
-- or an indefinite map. If 'Nothing' is returned, then an
-- indefinite length map occurs afterwords. If @'Just' x@ is returned,
-- then a map of length @x@ is encoded.
--
-- @since 0.2.0.0
decodeMapLenOrIndef :: Decoder s (Maybe Int)
decodeMapLenOrIndef =
    Decoder (\k -> return (ConsumeMapLenOrIndef (\n# ->
                     if I# n# >= 0
                       then k (Just (I# n#))
                       else k Nothing)))
{-# INLINE decodeMapLenOrIndef #-}

-- | Attempt to decode a @Break@ token, and if that was
-- successful, return 'True'. If the token was of any
-- other type, return 'False'.
--
-- @since 0.2.0.0
decodeBreakOr :: Decoder s Bool
decodeBreakOr = Decoder (\k -> return (ConsumeBreakOr (\b -> k b)))
{-# INLINE decodeBreakOr #-}

--------------------------------------------------------------
-- Special operations

-- | Peek at the current token we're about to decode, and return a
-- 'TokenType' specifying what it is.
--
-- @since 0.2.0.0
peekTokenType :: Decoder s TokenType
peekTokenType = Decoder (\k -> return (PeekTokenType (\tk -> k tk)))
{-# INLINE peekTokenType #-}

-- | Peek and return the length of the current buffer that we're
-- running our decoder on.
--
-- @since 0.2.0.0
peekAvailable :: Decoder s Int
peekAvailable = Decoder (\k -> return (PeekAvailable (\len# -> k (I# len#))))
{-# INLINE peekAvailable #-}


-- | A 0-based offset within the overall byte sequence that makes up the
-- input to the 'Decoder'.
--
-- This is an 'Int64' since 'Decoder' is incremental and can decode more data
-- than fits in memory at once. This is also compatible with the result type
-- of 'Data.ByteString.Lazy.length'.
--
type ByteOffset = Int64

-- | Get the current 'ByteOffset' in the input byte sequence of the 'Decoder'.
--
-- The 'Decoder' does not provide any facility to get at the input data
-- directly (since that is tricky with an incremental decoder). The next best
-- is this primitive which can be used to keep track of the offset within the
-- input bytes that makes up the encoded form of a term.
--
-- By keeping track of the byte offsets before and after decoding a subterm
-- (a pattern captured by 'decodeWithByteSpan') and if the overall input data
-- is retained then this is enables later retrieving the span of bytes for the
-- subterm.
--
-- @since 0.2.2.0
peekByteOffset :: Decoder s ByteOffset
peekByteOffset = Decoder (\k -> return (PeekByteOffset (\off# -> k (I64#
#if MIN_VERSION_base(4,17,0)
        (intToInt64# off#)
#else
        off#
#endif
    ))))
{-# INLINE peekByteOffset #-}

-- | This captures the pattern of getting the byte offsets before and after
-- decoding a subterm.
--
-- > !before <- peekByteOffset
-- > x <- decode
-- > !after  <- peekByteOffset
--
decodeWithByteSpan :: Decoder s a -> Decoder s (a, ByteOffset, ByteOffset)
decodeWithByteSpan da = do
    !before <- peekByteOffset
    x <- da
    !after  <- peekByteOffset
    return (x, before, after)

{-
expectExactly :: Word -> Decoder (Word :#: s) s
expectExactly n = expectExactly_ n done

expectAtLeast :: Word -> Decoder (Word :#: s) (Word :#: s)
expectAtLeast n = expectAtLeast_ n done

ignoreTrailingTerms :: Decoder (a :*: Word :#: s) (a :*: s)
ignoreTrailingTerms = IgnoreTerms done
-}

------------------------------------------------------------------------------
-- Special combinations for sequences
--

-- | Decode an indefinite sequence length.
--
-- @since 0.2.0.0
decodeSequenceLenIndef :: (r -> a -> r)
                       -> r
                       -> (r -> r')
                       -> Decoder s a
                       -> Decoder s r'
decodeSequenceLenIndef f z g get =
    go z
  where
    go !acc = do
      stop <- decodeBreakOr
      if stop then return $! g acc
              else do !x <- get; go (f acc x)
{-# INLINE decodeSequenceLenIndef #-}

-- | Decode a sequence length.
--
-- @since 0.2.0.0
decodeSequenceLenN :: (r -> a -> r)
                   -> r
                   -> (r -> r')
                   -> Int
                   -> Decoder s a
                   -> Decoder s r'
decodeSequenceLenN f z g c get =
    go z c
  where
    go !acc 0 = return $! g acc
    go !acc n = do !x <- get; go (f acc x) (n-1)
{-# INLINE decodeSequenceLenN #-}
