    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE EmptyDataDecls #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}

    module Data.Aeson.Encoding.Internal
        (
        -- * Encoding
          Encoding' (..)
        , Encoding
        , encodingToLazyByteString
        , unsafeToEncoding
        , retagEncoding
        , Series (..)
        , pairs
        , pair
        , pairStr
        , pair'
        -- * Predicates
        , nullEncoding
        -- * Encoding constructors
        , emptyArray_
        , emptyObject_
        , wrapObject
        , wrapArray
        , null_
        , bool
        , text
        , lazyText
        , string
        , list
        , dict
        , tuple
        , (>*<)
        , InArray
        , empty
        , (><)
        , econcat
        -- ** Decimal numbers
        , int8, int16, int32, int64, int
        , word8, word16, word32, word64, word
        , integer, float, double, scientific
        -- ** Decimal numbers as Text
        , int8Text, int16Text, int32Text, int64Text, intText
        , word8Text, word16Text, word32Text, word64Text, wordText
        , integerText, floatText, doubleText, scientificText
        -- ** Time
        , day
        , localTime
        , utcTime
        , timeOfDay
        , zonedTime
        -- ** value
        , value
        -- ** JSON tokens
        , comma, colon, openBracket, closeBracket, openCurly, closeCurly
        ) where

    import Prelude.Compat

    import Data.Aeson.Types.Internal (Value)
    import Data.ByteString.Builder (Builder, char7, toLazyByteString)
    import Data.Int
    import Data.Scientific (Scientific)
    import Data.Semigroup (Semigroup ((<>)))
    import Data.Text (Text)
    import Data.Time (Day, LocalTime, TimeOfDay, UTCTime, ZonedTime)
    import Data.Typeable (Typeable)
    import Data.Word
    import qualified Data.Aeson.Encoding.Builder as EB
    import qualified Data.ByteString.Builder as B
    import qualified Data.ByteString.Lazy as BSL
    import qualified Data.Text.Lazy as LT

    -- | An encoding of a JSON value.
    --
    -- @tag@ represents which kind of JSON the Encoding is encoding to,
    -- we reuse 'Text' and 'Value' as tags here.
    newtype Encoding' tag = Encoding {
          fromEncoding :: Builder
          -- ^ Acquire the underlying bytestring builder.
        } deriving (Typeable)

    -- | Often used synonym for 'Encoding''.
    type Encoding = Encoding' Value

    -- | Make Encoding from Builder.
    --
    -- Use with care! You have to make sure that the passed Builder
    -- is a valid JSON Encoding!
    unsafeToEncoding :: Builder -> Encoding' a
    unsafeToEncoding = Encoding

    encodingToLazyByteString :: Encoding' a -> BSL.ByteString
    encodingToLazyByteString = toLazyByteString . fromEncoding
    {-# INLINE encodingToLazyByteString #-}

    retagEncoding :: Encoding' a -> Encoding' b
    retagEncoding = Encoding . fromEncoding

    -------------------------------------------------------------------------------
    -- Encoding instances
    -------------------------------------------------------------------------------

    instance Show (Encoding' a) where
        show (Encoding e) = show (toLazyByteString e)

    instance Eq (Encoding' a) where
        Encoding a == Encoding b = toLazyByteString a == toLazyByteString b

    instance Ord (Encoding' a) where
        compare (Encoding a) (Encoding b) =
          compare (toLazyByteString a) (toLazyByteString b)

    -- | A series of values that, when encoded, should be separated by
    -- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
    -- either @(Text, Value)@ or 'Series'. You can use Series when
    -- encoding directly to a bytestring builder as in the following
    -- example:
    --
    -- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
    data Series = Empty
                | Value (Encoding' Series)
                deriving (Typeable)

    pair :: Text -> Encoding -> Series
    pair name val = pair' (text name) val
    {-# INLINE pair #-}

    pairStr :: String -> Encoding -> Series
    pairStr name val = pair' (string name) val
    {-# INLINE pairStr #-}

    pair' :: Encoding' Text -> Encoding -> Series
    pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val

    instance Semigroup Series where
        Empty   <> a       = a
        a       <> Empty   = a
        Value a <> Value b = Value (a >< comma >< b)

    instance Monoid Series where
        mempty  = Empty
        mappend = (<>)

    nullEncoding :: Encoding' a -> Bool
    nullEncoding = BSL.null . toLazyByteString . fromEncoding

    emptyArray_ :: Encoding
    emptyArray_ = Encoding EB.emptyArray_

    emptyObject_ :: Encoding
    emptyObject_ = Encoding EB.emptyObject_

    wrapArray :: Encoding' a -> Encoding
    wrapArray e = retagEncoding $ openBracket >< e >< closeBracket

    wrapObject :: Encoding' a -> Encoding
    wrapObject e = retagEncoding $ openCurly >< e >< closeCurly

    null_ :: Encoding
    null_ = Encoding EB.null_

    bool :: Bool -> Encoding
    bool True = Encoding "true"
    bool False = Encoding "false"

    -- | Encode a series of key/value pairs, separated by commas.
    pairs :: Series -> Encoding
    pairs (Value v) = openCurly >< retagEncoding v >< closeCurly
    pairs Empty     = emptyObject_
    {-# INLINE pairs #-}

    list :: (a -> Encoding) -> [a] -> Encoding
    list _  []     = emptyArray_
    list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket
      where
        commas = foldr (\v vs -> comma >< to' v >< vs) empty
    {-# INLINE list #-}

    -- | Encode as JSON object
    dict
        :: (k -> Encoding' Text)                     -- ^ key encoding
        -> (v -> Encoding)                                -- ^ value encoding
        -> (forall a. (k -> v -> a -> a) -> a -> m -> a)  -- ^ @foldrWithKey@ - indexed fold
        -> m                                              -- ^ container
        -> Encoding
    dict encodeKey encodeVal foldrWithKey = pairs . foldrWithKey go mempty
      where
        go k v c = Value (encodeKV k v) <> c
        encodeKV k v = retagEncoding (encodeKey k) >< colon >< retagEncoding (encodeVal v)
    {-# INLINE dict #-}

    -- | Type tag for tuples contents, see 'tuple'.
    data InArray

    infixr 6 >*<
    -- | See 'tuple'.
    (>*<) :: Encoding' a -> Encoding' b -> Encoding' InArray
    a >*< b = retagEncoding a >< comma >< retagEncoding b
    {-# INLINE (>*<) #-}

    empty :: Encoding' a
    empty = Encoding mempty

    econcat :: [Encoding' a] -> Encoding' a
    econcat = foldr (><) empty

    infixr 6 ><
    (><) :: Encoding' a -> Encoding' a -> Encoding' a
    Encoding a >< Encoding b = Encoding (a <> b)
    {-# INLINE (><) #-}

    -- | Encode as a tuple.
    --
    -- @
    -- toEncoding (X a b c) = tuple $
    --     toEncoding a >*<
    --     toEncoding b >*<
    --     toEncoding c
    tuple :: Encoding' InArray -> Encoding
    tuple b = retagEncoding $ openBracket >< b >< closeBracket
    {-# INLINE tuple #-}

    text :: Text -> Encoding' a
    text = Encoding . EB.text

    lazyText :: LT.Text -> Encoding' a
    lazyText t = Encoding $
        B.char7 '"' <>
        LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t

    string :: String -> Encoding' a
    string = Encoding . EB.string

    -------------------------------------------------------------------------------
    -- chars
    -------------------------------------------------------------------------------

    comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding' a
    comma        = Encoding $ char7 ','
    colon        = Encoding $ char7 ':'
    openBracket  = Encoding $ char7 '['
    closeBracket = Encoding $ char7 ']'
    openCurly    = Encoding $ char7 '{'
    closeCurly   = Encoding $ char7 '}'

    -------------------------------------------------------------------------------
    -- Decimal numbers
    -------------------------------------------------------------------------------

    int8 :: Int8 -> Encoding
    int8 = Encoding . B.int8Dec

    int16 :: Int16 -> Encoding
    int16 = Encoding . B.int16Dec

    int32 :: Int32 -> Encoding
    int32 = Encoding . B.int32Dec

    int64 :: Int64 -> Encoding
    int64 = Encoding . B.int64Dec

    int :: Int -> Encoding
    int = Encoding . B.intDec

    word8 :: Word8 -> Encoding
    word8 = Encoding . B.word8Dec

    word16 :: Word16 -> Encoding
    word16 = Encoding . B.word16Dec

    word32 :: Word32 -> Encoding
    word32 = Encoding . B.word32Dec

    word64 :: Word64 -> Encoding
    word64 = Encoding . B.word64Dec

    word :: Word -> Encoding
    word = Encoding . B.wordDec

    integer :: Integer -> Encoding
    integer = Encoding . B.integerDec

    float :: Float -> Encoding
    float = realFloatToEncoding $ Encoding . B.floatDec

    double :: Double -> Encoding
    double = realFloatToEncoding $ Encoding . B.doubleDec

    scientific :: Scientific -> Encoding
    scientific = Encoding . EB.scientific

    realFloatToEncoding :: RealFloat a => (a -> Encoding) -> a -> Encoding
    realFloatToEncoding e d
        | isNaN d || isInfinite d = null_
        | otherwise               = e d
    {-# INLINE realFloatToEncoding #-}

    -------------------------------------------------------------------------------
    -- Decimal numbers as Text
    -------------------------------------------------------------------------------

    int8Text :: Int8 -> Encoding' a
    int8Text = Encoding . EB.quote . B.int8Dec

    int16Text :: Int16 -> Encoding' a
    int16Text = Encoding . EB.quote . B.int16Dec

    int32Text :: Int32 -> Encoding' a
    int32Text = Encoding . EB.quote . B.int32Dec

    int64Text :: Int64 -> Encoding' a
    int64Text = Encoding . EB.quote . B.int64Dec

    intText :: Int -> Encoding' a
    intText = Encoding . EB.quote . B.intDec

    word8Text :: Word8 -> Encoding' a
    word8Text = Encoding . EB.quote . B.word8Dec

    word16Text :: Word16 -> Encoding' a
    word16Text = Encoding . EB.quote . B.word16Dec

    word32Text :: Word32 -> Encoding' a
    word32Text = Encoding . EB.quote . B.word32Dec

    word64Text :: Word64 -> Encoding' a
    word64Text = Encoding . EB.quote . B.word64Dec

    wordText :: Word -> Encoding' a
    wordText = Encoding . EB.quote . B.wordDec

    integerText :: Integer -> Encoding' a
    integerText = Encoding . EB.quote . B.integerDec

    floatText :: Float -> Encoding' a
    floatText = Encoding . EB.quote . B.floatDec

    doubleText :: Double -> Encoding' a
    doubleText = Encoding . EB.quote . B.doubleDec

    scientificText :: Scientific -> Encoding' a
    scientificText = Encoding . EB.quote . EB.scientific

    -------------------------------------------------------------------------------
    -- time
    -------------------------------------------------------------------------------

    day :: Day -> Encoding' a
    day = Encoding . EB.quote . EB.day

    localTime :: LocalTime -> Encoding' a
    localTime = Encoding . EB.quote . EB.localTime

    utcTime :: UTCTime -> Encoding' a
    utcTime = Encoding . EB.quote . EB.utcTime

    timeOfDay :: TimeOfDay -> Encoding' a
    timeOfDay = Encoding . EB.quote . EB.timeOfDay

    zonedTime :: ZonedTime -> Encoding' a
    zonedTime = Encoding . EB.quote . EB.zonedTime

    -------------------------------------------------------------------------------
    -- Value
    -------------------------------------------------------------------------------

    value :: Value -> Encoding
    value = Encoding . EB.encodeToBuilder