    {-# LANGUAGE CPP          #-}
    {-# LANGUAGE BangPatterns #-}

    -- |
    -- Module      : Codec.CBOR.Term
    -- Copyright   : (c) Duncan Coutts 2015-2017
    -- License     : BSD3-style (see LICENSE.txt)
    --
    -- Maintainer  : duncan@community.haskell.org
    -- Stability   : experimental
    -- Portability : non-portable (GHC extensions)
    --
    -- This module provides an interface for decoding and encoding arbitrary
    -- CBOR values (ones that, for example, may not have been generated by this
    -- library).
    --
    -- Using @'decodeTerm'@, you can decode an arbitrary CBOR value given to you
    -- into a @'Term'@, which represents a CBOR value as an AST.
    --
    -- Similarly, if you wanted to encode some value into a CBOR value directly,
    -- you can wrap it in a @'Term'@ constructor and use @'encodeTerm'@. This
    -- would be useful, as an example, if you needed to serialise some value into
    -- a CBOR term that is not compatible with that types @'Serialise'@ instance.
    --
    -- Because this interface gives you the ability to decode or encode any
    -- arbitrary CBOR term, it can also be seen as an alternative interface to the
    -- @'Codec.CBOR.Encoding'@ and
    -- @'Codec.CBOR.Decoding'@ modules.
    --
    module Codec.CBOR.Term
      ( Term(..)    -- :: *
      , encodeTerm  -- :: Term -> Encoding
      , decodeTerm  -- :: Decoder Term
      ) where

    #include "cbor.h"

    import           Codec.CBOR.Encoding hiding (Tokens(..))
    import           Codec.CBOR.Decoding

    import           Data.Word
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as LT
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Lazy as LBS
    import           Data.Monoid
    import           Control.Applicative

    import Prelude hiding (encodeFloat, decodeFloat)

    --------------------------------------------------------------------------------
    -- Types

    -- | A general CBOR term, which can be used to serialise or deserialise
    -- arbitrary CBOR terms for interoperability or debugging. This type is
    -- essentially a direct reflection of the CBOR abstract syntax tree as a
    -- Haskell data type.
    --
    -- The @'Term'@ type also comes with a @'Serialise'@ instance, so you can
    -- easily use @'decode' :: 'Decoder' 'Term'@ to directly decode any arbitrary
    -- CBOR value into Haskell with ease, and likewise with @'encode'@.
    --
    -- @since 0.2.0.0
    data Term
      = TInt     {-# UNPACK #-} !Int
      | TInteger                !Integer
      | TBytes                  !BS.ByteString
      | TBytesI                 !LBS.ByteString
      | TString                 !T.Text
      | TStringI                !LT.Text
      | TList                   ![Term]
      | TListI                  ![Term]
      | TMap                    ![(Term, Term)]
      | TMapI                   ![(Term, Term)]
      | TTagged  {-# UNPACK #-} !Word64 !Term
      | TBool                   !Bool
      | TNull
      | TSimple  {-# UNPACK #-} !Word8
      | THalf    {-# UNPACK #-} !Float
      | TFloat   {-# UNPACK #-} !Float
      | TDouble  {-# UNPACK #-} !Double
      deriving (Eq, Ord, Show, Read)

    --------------------------------------------------------------------------------
    -- Main API

    -- | Encode an arbitrary @'Term'@ into an @'Encoding'@ for later serialization.
    --
    -- @since 0.2.0.0
    encodeTerm :: Term -> Encoding
    encodeTerm (TInt      n)  = encodeInt n
    encodeTerm (TInteger  n)  = encodeInteger n
    encodeTerm (TBytes   bs)  = encodeBytes bs
    encodeTerm (TString  st)  = encodeString st
    encodeTerm (TBytesI bss)  = encodeBytesIndef
                                <> mconcat [ encodeBytes bs
                                           | bs <- LBS.toChunks bss ]
                                <> encodeBreak
    encodeTerm (TStringI sts) = encodeStringIndef
                                <> mconcat [ encodeString str
                                           | str <- LT.toChunks sts ]
                                <> encodeBreak
    encodeTerm (TList    ts)  = encodeListLen (fromIntegral $ length ts)
                                <> mconcat [ encodeTerm t | t <- ts ]
    encodeTerm (TListI   ts)  = encodeListLenIndef
                                <> mconcat [ encodeTerm t | t <- ts ]
                                <> encodeBreak
    encodeTerm (TMap     ts)  = encodeMapLen (fromIntegral $ length ts)
                                <> mconcat [ encodeTerm t <> encodeTerm t'
                                           | (t, t') <- ts ]
    encodeTerm (TMapI ts)     = encodeMapLenIndef
                                <> mconcat [ encodeTerm t <> encodeTerm t'
                                           | (t, t') <- ts ]
                                <> encodeBreak
    encodeTerm (TTagged w t)  = encodeTag64 w <> encodeTerm t
    encodeTerm (TBool     b)  = encodeBool b
    encodeTerm  TNull         = encodeNull
    encodeTerm (TSimple   w)  = encodeSimple w
    encodeTerm (THalf     f)  = encodeFloat16 f
    encodeTerm (TFloat    f)  = encodeFloat   f
    encodeTerm (TDouble   f)  = encodeDouble  f

    -- | Decode some arbitrary CBOR value into a @'Term'@.
    --
    -- @since 0.2.0.0
    decodeTerm :: Decoder s Term
    decodeTerm = do
        tkty <- peekTokenType
        case tkty of
          TypeUInt   -> do w <- decodeWord
                           return $! fromWord w
                        where
                          fromWord :: Word -> Term
                          fromWord w
                            | w <= fromIntegral (maxBound :: Int)
                                        = TInt     (fromIntegral w)
                            | otherwise = TInteger (fromIntegral w)

          TypeUInt64 -> do w <- decodeWord64
                           return $! fromWord64 w
                        where
                          fromWord64 w
                            | w <= fromIntegral (maxBound :: Int)
                                        = TInt     (fromIntegral w)
                            | otherwise = TInteger (fromIntegral w)

          TypeNInt   -> do w <- decodeNegWord
                           return $! fromNegWord w
                        where
                          fromNegWord w
                            | w <= fromIntegral (maxBound :: Int)
                                        = TInt     (-1 - fromIntegral w)
                            | otherwise = TInteger (-1 - fromIntegral w)

          TypeNInt64 -> do w <- decodeNegWord64
                           return $! fromNegWord64 w
                        where
                          fromNegWord64 w
                            | w <= fromIntegral (maxBound :: Int)
                                        = TInt     (-1 - fromIntegral w)
                            | otherwise = TInteger (-1 - fromIntegral w)

          TypeInteger -> do !x <- decodeInteger
                            return (TInteger x)
          TypeFloat16 -> do !x <- decodeFloat
                            return (THalf x)
          TypeFloat32 -> do !x <- decodeFloat
                            return (TFloat x)
          TypeFloat64 -> do !x <- decodeDouble
                            return (TDouble x)

          TypeBytes        -> do !x <- decodeBytes
                                 return (TBytes x)
          TypeBytesIndef   -> decodeBytesIndef >> decodeBytesIndefLen []
          TypeString       -> do !x <- decodeString
                                 return (TString x)
          TypeStringIndef  -> decodeStringIndef >> decodeStringIndefLen []

          TypeListLen      -> decodeListLen      >>= flip decodeListN []
          TypeListLen64    -> decodeListLen      >>= flip decodeListN []
          TypeListLenIndef -> decodeListLenIndef >>  decodeListIndefLen []
          TypeMapLen       -> decodeMapLen       >>= flip decodeMapN []
          TypeMapLen64     -> decodeMapLen       >>= flip decodeMapN []
          TypeMapLenIndef  -> decodeMapLenIndef  >>  decodeMapIndefLen []
          TypeTag          -> do !x <- decodeTag64
                                 !y <- decodeTerm
                                 return (TTagged x y)
          TypeTag64        -> do !x <- decodeTag64
                                 !y <- decodeTerm
                                 return (TTagged x y)

          TypeBool    -> do !x <- decodeBool
                            return (TBool x)
          TypeNull    -> TNull   <$  decodeNull
          TypeSimple  -> do !x <- decodeSimple
                            return (TSimple x)
          TypeBreak   -> fail "unexpected break"
          TypeInvalid -> fail "invalid token encoding"

    --------------------------------------------------------------------------------
    -- Internal utilities

    decodeBytesIndefLen :: [BS.ByteString] -> Decoder s Term
    decodeBytesIndefLen acc = do
        stop <- decodeBreakOr
        if stop then return $! TBytesI (LBS.fromChunks (reverse acc))
                else do !bs <- decodeBytes
                        decodeBytesIndefLen (bs : acc)

    decodeStringIndefLen :: [T.Text] -> Decoder s Term
    decodeStringIndefLen acc = do
        stop <- decodeBreakOr
        if stop then return $! TStringI (LT.fromChunks (reverse acc))
                else do !str <- decodeString
                        decodeStringIndefLen (str : acc)

    decodeListN :: Int -> [Term] -> Decoder s Term
    decodeListN !n acc =
        case n of
          0 -> return $! TList (reverse acc)
          _ -> do !t <- decodeTerm
                  decodeListN (n-1) (t : acc)

    decodeListIndefLen :: [Term] -> Decoder s Term
    decodeListIndefLen acc = do
        stop <- decodeBreakOr
        if stop then return $! TListI (reverse acc)
                else do !tm <- decodeTerm
                        decodeListIndefLen (tm : acc)

    decodeMapN :: Int -> [(Term, Term)] -> Decoder s Term
    decodeMapN !n acc =
        case n of
          0 -> return $! TMap (reverse acc)
          _ -> do !tm   <- decodeTerm
                  !tm'  <- decodeTerm
                  decodeMapN (n-1) ((tm, tm') : acc)

    decodeMapIndefLen :: [(Term, Term)] -> Decoder s Term
    decodeMapIndefLen acc = do
        stop <- decodeBreakOr
        if stop then return $! TMapI (reverse acc)
                else do !tm  <- decodeTerm
                        !tm' <- decodeTerm
                        decodeMapIndefLen ((tm, tm') : acc)