{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, PackageImports #-}

{-|

Module      : Json.Encode
Description : Encode JSON.
License     : BSD 3
Maintainer  : terezasokol@gmail.com
Stability   : experimental
Portability : POSIX

-}

module Json.Encode
  ( -- * Encoding
    Value, toBuilder
    -- * Primitives
  , string, chars, int, float, bool, null
    -- * Arrays
  , list
    -- * Objects
  , object, dict
  )
  where

-- TODO: add INLINE to all the functions that produce a Value and
-- see the impact in production code. I suspect it will be valuable.
-- I think using the composition operator in their implementations
-- is better for this, but I am not 100% sure.

import qualified Data.ByteString.Builder.Prim as P
import Data.ByteString.Builder.Prim ((>$<), (>*<))
import qualified Data.ByteString.Builder as B
import qualified Data.Char as Char
import qualified "text-utf8" Data.Text.Encoding as TE
import Data.Monoid ((<>))
import Prelude hiding (String, Float, null)
import Data.Word (Word8)
import Basics (Float)
import qualified Dict
import qualified List
import qualified String
import String (String)


-- ENCODER


{-| Representation of a JSON value that can be turned into a string, written
to a file, or turned into a `Data.ByteString.Builder` value.
-}
newtype Value =
  Value { _toBuilder :: B.Builder }



-- TO BUILDER


{-| Convert a `Value` into a bytestring.

 > import Json.Encode as Encode
 >
 > tom : Encode.Value
 > tom =
 >   Encode.object
 >     [ ( "name", Encode.string "Tom" )
 >     , ( "age", Encode.int 42 )
 >     ]
 >
 > compact =
 >   Encode.toBuilder tom
 >   -- {"name":"Tom","age":42}
-}
toBuilder :: Value -> B.Builder
toBuilder (Value builder) =
  builder



-- STRING


{-| Turn a `String` into a JSON string.

 > import Json.Encode exposing (encode, string)
 >
 > -- encode 0 (string "")      == "\"\""
 > -- encode 0 (string "abc")   == "\"abc\""
 > -- encode 0 (string "hello") == "\"hello\""
-}
string :: String -> Value
string str =
  Value $ B.char7 '"' <> escapeString str <> B.char7 '"'


escapeString :: String -> B.Builder
escapeString str =
  TE.encodeUtf8BuilderEscaped escapeWord8 (String.toTextUtf8 str)


{-# INLINE escapeWord8 #-}
escapeWord8 :: P.BoundedPrim Word8
escapeWord8 =
  P.condB (>  0x5C {-\-} ) (P.liftFixedToBounded P.word8) $
  P.condB (== 0x5C {-\-} ) (P.liftFixedToBounded (const ('\\','\\') >$< P.char7 >*< P.char7)) $
  P.condB (== 0x22 {-"-} ) (P.liftFixedToBounded (const ('\\','\"') >$< P.char7 >*< P.char7)) $
  P.condB (== 0x2F {-/-} ) (P.liftFixedToBounded (const ('\\','/') >$< P.char7 >*< P.char7)) $
  P.condB (>= 0x20 {- -} ) (P.liftFixedToBounded P.word8) $
  P.condB (== 0x08 {-\b-}) (P.liftFixedToBounded (const ('\\','b') >$< P.char7 >*< P.char7)) $
  P.condB (== 0x09 {-\t-}) (P.liftFixedToBounded (const ('\\','t') >$< P.char7 >*< P.char7)) $
  P.condB (== 0x0A {-\n-}) (P.liftFixedToBounded (const ('\\','n') >$< P.char7 >*< P.char7)) $
  P.condB (== 0x0C {-\f-}) (P.liftFixedToBounded (const ('\\','f') >$< P.char7 >*< P.char7)) $
  P.condB (== 0x0D {-\r-}) (P.liftFixedToBounded (const ('\\','r') >$< P.char7 >*< P.char7)) $
  P.liftFixedToBounded (toLowCode >$< P.word8 >*< P.word8 >*< P.word8 >*< P.word8 >*< P.word8 >*< P.word8)


{-# INLINE toLowCode #-}
toLowCode :: Word8 -> (Word8,(Word8,(Word8,(Word8,(Word8,Word8)))))
toLowCode code =
  let
    (tens, ones) = divMod code 16
  in
  (0x5C {-\-}, (0x75 {-u-}, (0x30 {-0-}, (0x30 {-0-}, (tens, ones)))))



-- CHARS


chars :: [Char] -> Value
chars chrs =
  Value $ B.char7 '"' <> P.primMapListBounded escapeChar chrs <> B.char7 '"'


{-# INLINE escapeChar #-}
escapeChar :: P.BoundedPrim Char
escapeChar =
  P.condB (> '\\') P.charUtf8 (fromIntegral . Char.ord >$< escapeWord8)



-- BOOL


{-| Turn a `Bool` into a JSON boolean.

 > import Json.Encode exposing (encode, bool)
 >
 > -- encode 0 (bool True)  == "true"
 > -- encode 0 (bool False) == "false"
-}
bool :: Bool -> Value
bool b =
  if b
  then Value "true"
  else Value "false"



-- INT


{-| Turn an `Int` into a JSON number.

 > import Json.Encode exposing (encode, int)
 >
 > -- encode 0 (int 42) == "42"
 > -- encode 0 (int -7) == "-7"
 > -- encode 0 (int 0)  == "0"
-}
int :: Int -> Value
int =
  Value . B.intDec



-- FLOAT


{-| Turn a `Float` into a JSON number.

 > import Json.Encode exposing (encode, float)
 >
 > -- encode 0 (float 3.14)     == "3.14"
 > -- encode 0 (float 1.618)    == "1.618"
 > -- encode 0 (float -42)      == "-42"
 > -- encode 0 (float NaN)      == "null"
 > -- encode 0 (float Infinity) == "null"

**Note:** Floating point numbers are defined in the [IEEE 754 standard](https://en.wikipedia.org/wiki/IEEE_754)
which is hardcoded into almost all CPUs. This standard allows `Infinity` and
`NaN`. [The JSON spec](https://www.json.org/) does not include these values, so we encode them
both as `null`.
-}
float :: Float -> Value
float =
  Value . B.doubleDec



-- NULL


{-| Create a JSON `null` value.

 > import Json.Encode exposing (encode, null)
 >
 > -- encode 0 null == "null"
-}
null :: Value
null =
  Value "null"



-- ARRAYS


{-| Turn a `List` into a JSON array.

 > import Json.Encode as Encode exposing (bool, encode, int, list, string)
 >
 > -- encode 0 (list int [1,3,4])       == "[1,3,4]"
 > -- encode 0 (list bool [True,False]) == "[true,false]"
 > -- encode 0 (list string ["a","b"])  == """["a","b"]"""
-}
list :: (a -> Value) -> [a] -> Value
list encodeEntry entries =
  case entries of
    []   -> Value (B.string7 "[]")
    x:xs -> Value (encodeSequence arrayOpen arrayClose (_toBuilder . encodeEntry) x xs)


arrayOpen :: B.Builder
arrayOpen =
  B.string7 "["


arrayClose :: B.Builder
arrayClose =
  B.char7 ']'



-- OBJECTS


{-| Create a JSON object.

 > import Json.Encode as Encode
 >
 > tom : Encode.Value
 > tom =
 >   Encode.object
 >     [ ( "name", Encode.string "Tom" )
 >     , ( "age", Encode.int 42 )
 >     ]
 >
 > -- Encode.encode 0 tom == """{"name":"Tom","age":42}"""

-}
object :: [(String, Value)] -> Value
object fields =
  case fields of
    []   -> Value (B.string7 "{}")
    f:fs -> Value (encodeSequence objectOpen objectClose encodeField f fs)


encodeField :: (String, Value) -> B.Builder
encodeField (key, Value builder) =
  B.char7 '"' <> escapeString key <> B.string7 "\":" <> builder


objectOpen :: B.Builder
objectOpen =
  B.string7 "{"


objectClose :: B.Builder
objectClose =
  B.char7 '}'



{-| Turn a `Dict` into a JSON object.

 > import Dict exposing (Dict)
 > import Json.Encode as Encode
 >
 > people : Dict String Int
 > people =
 >   Dict.fromList [ ("Tom",42), ("Sue", 38) ]
 >
 > -- Encode.encode 0 (Encode.dict identity Encode.int people)
 > --   == """{"Tom":42,"Sue":38}"""
-}
dict :: (k -> String) -> (v -> Value) -> Dict.Dict k v -> Value
dict encodeKey encodeValue pairs =
  let
    toPair (key, value) =
      (encodeKey key, encodeValue value)
  in
  object $ List.map toPair (Dict.toList pairs)



-- ENCODE SEQUENCE


encodeSequence :: B.Builder -> B.Builder -> (a -> B.Builder) -> a -> [a] -> B.Builder
encodeSequence open close encodeEntry x xs =
  let
    addEntry entry builder =
      comma
      <> encodeEntry entry
      <> builder
  in
  open
  <> encodeEntry x
  <> foldr addEntry close xs


comma :: B.Builder
comma =
  B.string7 ","