{-# LANGUAGE CPP #-}

-- |
-- Module      : Codec.CBOR.Encoding
-- 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 encoding values, for later serialization into
-- CBOR binary format, using a 'Monoid' based interface.
--
module Codec.CBOR.Encoding
  ( -- * Encoding implementation
    Encoding(..)             -- :: *
  , Tokens(..)               -- :: *

    -- * 'Encoding' API for serialisation
  , encodeWord               -- :: Word -> Encoding
  , encodeWord8              -- :: Word8 -> Encoding
  , encodeWord16             -- :: Word16 -> Encoding
  , encodeWord32             -- :: Word32 -> Encoding
  , encodeWord64             -- :: Word64 -> Encoding
  , encodeInt                -- :: Int -> Encoding
  , encodeInt8               -- :: Int8 -> Encoding
  , encodeInt16              -- :: Int16 -> Encoding
  , encodeInt32              -- :: Int32 -> Encoding
  , encodeInt64              -- :: Int64 -> Encoding
  , encodeInteger            -- :: Integer -> Encoding
  , encodeBytes              -- :: B.ByteString -> Encoding
  , encodeBytesIndef         -- :: Encoding
  , encodeByteArray          -- :: ByteArray -> Encoding
  , encodeString             -- :: T.Text -> Encoding
  , encodeStringIndef        -- :: Encoding
  , encodeUtf8ByteArray      -- :: ByteArray -> Encoding
  , encodeListLen            -- :: Word -> Encoding
  , encodeListLenIndef       -- :: Encoding
  , encodeMapLen             -- :: Word -> Encoding
  , encodeMapLenIndef        -- :: Encoding
  , encodeBreak              -- :: Encoding
  , encodeTag                -- :: Word -> Encoding
  , encodeTag64              -- :: Word64 -> Encoding
  , encodeBool               -- :: Bool -> Encoding
  , encodeUndef              -- :: Encoding
  , encodeNull               -- :: Encoding
  , encodeSimple             -- :: Word8 -> Encoding
  , encodeFloat16            -- :: Float -> Encoding
  , encodeFloat              -- :: Float -> Encoding
  , encodeDouble             -- :: Double -> Encoding
  , encodePreEncoded         -- :: B.ByteString -> Encoding
  ) where

#include "cbor.h"

import           Data.Int
import           Data.Word
import           Data.Semigroup

import qualified Data.ByteString as B
import qualified Data.Text       as T

import           Codec.CBOR.ByteArray.Sliced (SlicedByteArray)

import           Prelude         hiding (encodeFloat)

import {-# SOURCE #-} qualified Codec.CBOR.FlatTerm as FlatTerm

-- | An intermediate form used during serialisation, specified as a
-- 'Monoid'. It supports efficient concatenation, and is equivalent
-- to a specialised 'Data.Monoid.Endo' 'Tokens' type.
--
-- It is used for the stage in serialisation where we flatten out the
-- Haskell data structure but it is independent of any specific
-- external binary or text format.
--
-- Traditionally, to build any arbitrary 'Encoding' value, you specify
-- larger structures from smaller ones and append the small ones together
-- using 'Data.Monoid.mconcat'.
--
-- @since 0.2.0.0
newtype Encoding = Encoding (Tokens -> Tokens)

instance Show Encoding where
  show :: Encoding -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> FlatTerm
FlatTerm.toFlatTerm

-- | A flattened representation of a term, which is independent
-- of any underlying binary representation, but which we later
-- serialise into CBOR format.
--
-- @since 0.2.0.0
data Tokens =

    -- Positive and negative integers (type 0,1)
      TkWord     {-# UNPACK #-} !Word         Tokens
    | TkWord64   {-# UNPACK #-} !Word64       Tokens
      -- convenience for either positive or negative
    | TkInt      {-# UNPACK #-} !Int          Tokens
    | TkInt64    {-# UNPACK #-} !Int64        Tokens

    -- Bytes and string (type 2,3)
    | TkBytes         {-# UNPACK #-} !B.ByteString    Tokens
    | TkBytesBegin                                    Tokens
    | TkByteArray     {-# UNPACK #-} !SlicedByteArray Tokens
    | TkString        {-# UNPACK #-} !T.Text          Tokens
    | TkUtf8ByteArray {-# UNPACK #-} !SlicedByteArray Tokens
    | TkStringBegin                                   Tokens

    -- Structures (type 4,5)
    | TkListLen  {-# UNPACK #-} !Word         Tokens
    | TkListBegin                             Tokens
    | TkMapLen   {-# UNPACK #-} !Word         Tokens
    | TkMapBegin                              Tokens

    -- Tagged values (type 6)
    | TkTag      {-# UNPACK #-} !Word         Tokens
    | TkTag64    {-# UNPACK #-} !Word64       Tokens
    | TkInteger                 !Integer      Tokens

    -- Simple and floats (type 7)
    | TkNull                                  Tokens
    | TkUndef                                 Tokens
    | TkBool                    !Bool         Tokens
    | TkSimple   {-# UNPACK #-} !Word8        Tokens
    | TkFloat16  {-# UNPACK #-} !Float        Tokens
    | TkFloat32  {-# UNPACK #-} !Float        Tokens
    | TkFloat64  {-# UNPACK #-} !Double       Tokens
    | TkBreak                                 Tokens

    -- Special
    | TkEncoded  {-# UNPACK #-} !B.ByteString Tokens

    | TkEnd
    deriving (Int -> Tokens -> ShowS
[Tokens] -> ShowS
Tokens -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tokens] -> ShowS
$cshowList :: [Tokens] -> ShowS
show :: Tokens -> String
$cshow :: Tokens -> String
showsPrec :: Int -> Tokens -> ShowS
$cshowsPrec :: Int -> Tokens -> ShowS
Show,Tokens -> Tokens -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tokens -> Tokens -> Bool
$c/= :: Tokens -> Tokens -> Bool
== :: Tokens -> Tokens -> Bool
$c== :: Tokens -> Tokens -> Bool
Eq)

-- | @since 0.2.0.0
instance Semigroup Encoding where
  Encoding Tokens -> Tokens
b1 <> :: Encoding -> Encoding -> Encoding
<> Encoding Tokens -> Tokens
b2 = (Tokens -> Tokens) -> Encoding
Encoding (\Tokens
ts -> Tokens -> Tokens
b1 (Tokens -> Tokens
b2 Tokens
ts))
  {-# INLINE (<>) #-}

-- | @since 0.2.0.0
instance Monoid Encoding where
  mempty :: Encoding
mempty = (Tokens -> Tokens) -> Encoding
Encoding (\Tokens
ts -> Tokens
ts)
  {-# INLINE mempty #-}

  mappend :: Encoding -> Encoding -> Encoding
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}

  mconcat :: [Encoding] -> Encoding
mconcat = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty
  {-# INLINE mconcat #-}

-- | Encode a 'Word' in a flattened format.
--
-- @since 0.2.0.0
encodeWord :: Word -> Encoding
encodeWord :: Word -> Encoding
encodeWord = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkWord

-- | Encode a 'Word8' in a flattened format.
--
-- @since 0.2.0.0
encodeWord8 :: Word8 -> Encoding
encodeWord8 :: Word8 -> Encoding
encodeWord8 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encode a 'Word16' in a flattened format.
--
-- @since 0.2.0.0
encodeWord16 :: Word16 -> Encoding
encodeWord16 :: Word16 -> Encoding
encodeWord16 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encode a 'Word32' in a flattened format.
--
-- @since 0.2.0.0
encodeWord32 :: Word32 -> Encoding
encodeWord32 :: Word32 -> Encoding
encodeWord32 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encode a 'Word64' in a flattened format.
--
-- @since 0.2.0.0
encodeWord64 :: Word64 -> Encoding
encodeWord64 :: Word64 -> Encoding
encodeWord64 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Tokens -> Tokens
TkWord64

-- | Encode an 'Int' in a flattened format.
--
-- @since 0.2.0.0
encodeInt :: Int -> Encoding
encodeInt :: Int -> Encoding
encodeInt = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tokens -> Tokens
TkInt

-- | Encode an 'Int8' in a flattened format.
--
-- @since 0.2.0.0
encodeInt8 :: Int8 -> Encoding
encodeInt8 :: Int8 -> Encoding
encodeInt8 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tokens -> Tokens
TkInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encode an 'Int16' in a flattened format.
--
-- @since 0.2.0.0
encodeInt16 :: Int16 -> Encoding
encodeInt16 :: Int16 -> Encoding
encodeInt16 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tokens -> Tokens
TkInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encode an 'Int32' in a flattened format.
--
-- @since 0.2.0.0
encodeInt32 :: Int32 -> Encoding
encodeInt32 :: Int32 -> Encoding
encodeInt32 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tokens -> Tokens
TkInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encode an @'Int64' in a flattened format.
--
-- @since 0.2.0.0
encodeInt64 :: Int64 -> Encoding
encodeInt64 :: Int64 -> Encoding
encodeInt64 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Tokens -> Tokens
TkInt64

-- | Encode an arbitrarily large @'Integer' in a
-- flattened format.
--
-- @since 0.2.0.0
encodeInteger :: Integer -> Encoding
encodeInteger :: Integer -> Encoding
encodeInteger Integer
n = (Tokens -> Tokens) -> Encoding
Encoding (Integer -> Tokens -> Tokens
TkInteger Integer
n)

-- | Encode an arbitrary strict 'B.ByteString' in
-- a flattened format.
--
-- @since 0.2.0.0
encodeBytes :: B.ByteString -> Encoding
encodeBytes :: ByteString -> Encoding
encodeBytes = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkBytes

-- | Encode a bytestring in a flattened format.
--
-- @since 0.2.0.0
encodeByteArray :: SlicedByteArray -> Encoding
encodeByteArray :: SlicedByteArray -> Encoding
encodeByteArray = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlicedByteArray -> Tokens -> Tokens
TkByteArray

-- | Encode a token specifying the beginning of a string of bytes of
-- indefinite length. In reality, this specifies a stream of many
-- occurrences of `encodeBytes`, each specifying a single chunk of the
-- overall string. After all the bytes desired have been encoded, you
-- should follow it with a break token (see 'encodeBreak').
--
-- @since 0.2.0.0
encodeBytesIndef :: Encoding
encodeBytesIndef :: Encoding
encodeBytesIndef = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkBytesBegin

-- | Encode a 'T.Text' in a flattened format.
--
-- @since 0.2.0.0
encodeString :: T.Text -> Encoding
encodeString :: Text -> Encoding
encodeString = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tokens -> Tokens
TkString

-- | Encode the beginning of an indefinite string.
--
-- @since 0.2.0.0
encodeStringIndef :: Encoding
encodeStringIndef :: Encoding
encodeStringIndef = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkStringBegin

-- | Encode a UTF-8 string in a flattened format. Note that the contents
-- is not validated to be well-formed UTF-8.
--
-- @since 0.2.0.0
encodeUtf8ByteArray :: SlicedByteArray -> Encoding
encodeUtf8ByteArray :: SlicedByteArray -> Encoding
encodeUtf8ByteArray = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlicedByteArray -> Tokens -> Tokens
TkUtf8ByteArray

-- | Encode the length of a list, used to indicate that the following
-- tokens represent the list values.
--
-- @since 0.2.0.0
encodeListLen :: Word -> Encoding
encodeListLen :: Word -> Encoding
encodeListLen = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen

-- | Encode a token specifying that this is the beginning of an
-- indefinite list of unknown size. Tokens representing the list are
-- expected afterwords, followed by a break token (see
-- 'encodeBreak') when the list has ended.
--
-- @since 0.2.0.0
encodeListLenIndef :: Encoding
encodeListLenIndef :: Encoding
encodeListLenIndef = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkListBegin

-- | Encode the length of a Map, used to indicate that
-- the following tokens represent the map values.
--
-- @since 0.2.0.0
encodeMapLen :: Word -> Encoding
encodeMapLen :: Word -> Encoding
encodeMapLen = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkMapLen

-- | Encode a token specifying that this is the beginning of an
-- indefinite map of unknown size. Tokens representing the map are
-- expected afterwords, followed by a break token (see
-- 'encodeBreak') when the map has ended.
--
-- @since 0.2.0.0
encodeMapLenIndef :: Encoding
encodeMapLenIndef :: Encoding
encodeMapLenIndef = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkMapBegin

-- | Encode a \'break\', used to specify the end of indefinite
-- length objects like maps or lists.
--
-- @since 0.2.0.0
encodeBreak :: Encoding
encodeBreak :: Encoding
encodeBreak = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkBreak

-- | Encode an arbitrary 'Word' tag.
--
-- @since 0.2.0.0
encodeTag :: Word -> Encoding
encodeTag :: Word -> Encoding
encodeTag = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkTag

-- | Encode an arbitrary 64-bit 'Word64' tag.
--
-- @since 0.2.0.0
encodeTag64 :: Word64 -> Encoding
encodeTag64 :: Word64 -> Encoding
encodeTag64 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Tokens -> Tokens
TkTag64

-- | Encode a 'Bool'.
--
-- @since 0.2.0.0
encodeBool :: Bool -> Encoding
encodeBool :: Bool -> Encoding
encodeBool Bool
b = (Tokens -> Tokens) -> Encoding
Encoding (Bool -> Tokens -> Tokens
TkBool Bool
b)

-- | Encode an @Undef@ value.
--
-- @since 0.2.0.0
encodeUndef :: Encoding
encodeUndef :: Encoding
encodeUndef = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkUndef

-- | Encode a @Null@ value.
--
-- @since 0.2.0.0
encodeNull :: Encoding
encodeNull :: Encoding
encodeNull = (Tokens -> Tokens) -> Encoding
Encoding Tokens -> Tokens
TkNull

-- | Encode a \'simple\' CBOR token that can be represented with an
-- 8-bit word. You probably don't ever need this.
--
-- @since 0.2.0.0
encodeSimple :: Word8 -> Encoding
encodeSimple :: Word8 -> Encoding
encodeSimple = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Tokens -> Tokens
TkSimple

-- | Encode a small 16-bit 'Float' in a flattened format.
--
-- @since 0.2.0.0
encodeFloat16 :: Float -> Encoding
encodeFloat16 :: Float -> Encoding
encodeFloat16 = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Tokens -> Tokens
TkFloat16

-- | Encode a full precision 'Float' in a flattened format.
--
-- @since 0.2.0.0
encodeFloat :: Float -> Encoding
encodeFloat :: Float -> Encoding
encodeFloat = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Tokens -> Tokens
TkFloat32

-- | Encode a 'Double' in a flattened format.
--
-- @since 0.2.0.0
encodeDouble :: Double -> Encoding
encodeDouble :: Double -> Encoding
encodeDouble = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Tokens -> Tokens
TkFloat64

-- | Include pre-encoded valid CBOR data into the 'Encoding'.
--
-- The data is included into the output as-is without any additional wrapper.
--
-- This should be used with care. The data /must/ be a valid CBOR encoding, but
-- this is /not/ checked.
--
-- This is useful when you have CBOR data that you know is already valid, e.g.
-- previously validated and stored on disk, and you wish to include it without
-- having to decode and re-encode it.
--
-- @since 0.2.2.0
encodePreEncoded :: B.ByteString -> Encoding
encodePreEncoded :: ByteString -> Encoding
encodePreEncoded = (Tokens -> Tokens) -> Encoding
Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkEncoded