import "StandardLibrary"
import "Data/Writer"
import "JavaBuiltin" as Java

importJava "com.fasterxml.jackson.core.JsonGenerator" where
    data JsonGenerator

@private
importJava "com.fasterxml.jackson.core.JsonGenerator" where
    writeNull :: JsonGenerator -> <Proc> ()
    
    writeStartArray :: JsonGenerator -> <Proc> ()
    @JavaName writeStartArray
    writeStartArrayN :: JsonGenerator -> Integer -> <Proc> ()
    writeEndArray :: JsonGenerator -> <Proc> ()
    
    writeStartObject :: JsonGenerator -> <Proc> ()
    writeFieldName :: JsonGenerator -> String -> <Proc> ()
    writeEndObject :: JsonGenerator -> <Proc> ()

    writeBoolean :: JsonGenerator -> Boolean -> <Proc> ()
    
    writeString :: JsonGenerator -> String -> <Proc> ()
    
    @JavaName writeNumber
    writeNumberDouble :: JsonGenerator -> Double -> <Proc> ()
    @JavaName writeNumber
    writeNumberInteger :: JsonGenerator -> Integer -> <Proc> ()
    @JavaName writeNumber
    writeNumberLong :: JsonGenerator -> Long -> <Proc> ()
    @JavaName writeNumber
    writeNumberShort :: JsonGenerator -> Short -> <Proc> ()
    @JavaName writeNumber
    writeNumberFloat :: JsonGenerator -> Float -> <Proc> ()
    
    @JavaName close
    closeGenerator :: JsonGenerator -> <Proc> ()

@private
importJava "com.fasterxml.jackson.core.JsonToken" where
    data JsonToken
    END_ARRAY :: JsonToken
    END_OBJECT :: JsonToken
    FIELD_NAME :: JsonToken
    NOT_AVAILABLE :: JsonToken
    START_ARRAY :: JsonToken
    START_OBJECT :: JsonToken
    VALUE_EMBEDDED_OBJECT :: JsonToken
    VALUE_FALSE :: JsonToken
    VALUE_NULL :: JsonToken
    VALUE_NUMBER_FLOAT :: JsonToken
    VALUE_NUMBER_INT :: JsonToken
    VALUE_STRING :: JsonToken
    VALUE_TRUE :: JsonToken

importJava "com.fasterxml.jackson.core.JsonParser" where
    data JsonParser

@private
importJava "com.fasterxml.jackson.core.JsonParser" where
    nextToken :: JsonParser -> <Proc> JsonToken
    currentToken :: JsonParser -> <Proc> JsonToken
    getDoubleValue :: JsonParser -> <Proc> Double
    getIntValue :: JsonParser -> <Proc> Integer
    getText :: JsonParser -> <Proc> String
    getShortValue :: JsonParser -> <Proc> Short
    getFloatValue :: JsonParser -> <Proc> Float
    getLongValue :: JsonParser -> <Proc> Long
    nextFieldName :: JsonParser -> <Proc> Maybe String

@private
importJava "com.fasterxml.jackson.core.JsonFactory" where
    data JsonFactory
    
    @JavaName "<init>"
    createJsonFactory :: <Proc> JsonFactory
    
    @JavaName createGenerator
    createWriterGenerator :: JsonFactory -> Writer -> <Proc> JsonGenerator
    
    @JavaName createParser
    createStringParser :: JsonFactory -> String -> <Proc> JsonParser
    
@private
defaultFactory = createJsonFactory

@private
@inline
assertStartArray :: JsonParser -> <Proc> ()
assertStartArray p = if currentToken p == START_ARRAY
                     then ()
                     else fail "Expected START_ARRAY token."

@private
@inline
assertEndArray :: JsonParser -> <Proc> ()
assertEndArray p = if nextToken p == END_ARRAY
                   then ()
                   else fail "Expected END_ARRAY token."

// *** Json type class ********************************************************

class Json a where
    writeJson :: JsonGenerator -> a -> <Proc> ()
    readJson :: JsonParser -> <Proc> a
    toJson :: a -> Json
    fromJson :: Json -> a
    
    writeJson g v = writeJson g (toJson v)
    readJson p = fromJson (readJson p) 

@private
readNextJson :: Json a => JsonParser -> <Proc> a
readNextJson p = do
    nextToken p
    readJson p

"""
Converts the value to a string encoded with JSON
"""
toJsonString :: Json a => a -> String
toJsonString v = runProc do
    writer = createStringWriter
    generator = createWriterGenerator defaultFactory (toWriter writer)
    writeJson generator v
    closeGenerator generator
    resultOfStringWriter writer

"""
Parses a JSON encoded string into a value
"""
fromJsonString :: Json a => String -> a
fromJsonString str = runProc do
    parser = createStringParser defaultFactory str
    readNextJson parser

instance Json String where
    writeJson = writeString
    readJson = getText
    toJson = JsonString
    fromJson (JsonString value) = value

instance Json Boolean where
    writeJson = writeBoolean
    readJson p =
        if currentToken p == VALUE_TRUE
        then True
        else False
    toJson = JsonBoolean
    fromJson (JsonBoolean value) = value
    
instance Json Double where
    writeJson = writeNumberDouble
    readJson = getDoubleValue
    toJson = JsonDouble
    fromJson (JsonDouble value) = value

instance Json Float where
    writeJson = writeNumberFloat
    readJson = getFloatValue
    toJson = JsonDouble . toDouble
    fromJson (JsonDouble value) = fromDouble value

instance Json Integer where
    writeJson = writeNumberInteger
    readJson = getIntValue
    toJson = JsonLong . fromInteger
    fromJson (JsonLong value) = Java.l2i value

instance Json Long where
    writeJson = writeNumberLong
    readJson = getLongValue
    toJson = JsonLong
    fromJson (JsonLong value) = value

instance Json Short where
    writeJson = writeNumberShort
    readJson = getShortValue
    toJson = JsonLong . Java.i2l . Java.s2i
    fromJson (JsonLong value) = Java.i2s (Java.l2i value) 
    
instance (Json a) => Json (Maybe a) where
    writeJson g (Just v) =  writeJson g v
    writeJson g Nothing = writeNull g
    readJson p = 
        if currentToken p == VALUE_NULL
        then Nothing
        else Just (readJson p)
    toJson (Just value) = toJson value
    toJson Nothing = JsonNull
    fromJson JsonNull = Nothing
    fromJson json = Just (fromJson json)

instance (Json a) => Json [a] where
    writeJson g l = do
        writeStartArray g
        iter (writeJson g) l
        writeEndArray g
    readJson p = MList.freeze result
      where
        result = MList.create ()
        assertStartArray p
        while (nextToken p != END_ARRAY)
            (MList.add result $ readJson p)
    toJson l = JsonArray (map toJson l)
    fromJson (JsonArray l) = map fromJson l

instance Json () where
    writeJson g _ = do
        writeStartArray g
        writeEndArray g
    readJson p = do
        assertStartArray p
        assertEndArray p
        ()
    toJson _ = JsonArray []
    fromJson (JsonArray []) = ()

instance (Json a, Json b) => Json (a, b) where
    writeJson g (a, b) = do
        writeStartArray g
        writeJson g a
        writeJson g b
        writeEndArray g
    readJson p = (a, b)
      where
        assertStartArray p
        a = readNextJson p
        b = readNextJson p
        assertEndArray p
    toJson (a, b) = JsonArray [toJson a, toJson b]
    fromJson (JsonArray [a, b]) = (fromJson a, fromJson b)        

instance (Json a, Json b, Json c) => Json (a, b, c) where
    writeJson g (a, b, c) = do
        writeStartArray g
        writeJson g a
        writeJson g b
        writeJson g c
        writeEndArray g
    readJson p = (a, b, c)
      where
        assertStartArray p
        a = readNextJson p
        b = readNextJson p
        c = readNextJson p
        assertEndArray p
    toJson (a, b, c) = JsonArray [toJson a, toJson b, toJson c]
    fromJson (JsonArray [a, b, c]) = (fromJson a, fromJson b, fromJson c)        

instance (Json a, Json b, Json c, Json d) => Json (a, b, c, d) where
    writeJson g (a, b, c, d) = do
        writeStartArray g
        writeJson g a
        writeJson g b
        writeJson g c
        writeJson g d
        writeEndArray g
    readJson p = (a, b, c, d)
      where
        assertStartArray p
        a = readNextJson p
        b = readNextJson p
        c = readNextJson p
        d = readNextJson p
        assertEndArray p
    toJson (a, b, c, d) = JsonArray [toJson a, toJson b, toJson c, toJson d]
    fromJson (JsonArray [a, b, c, d]) = (fromJson a, fromJson b, fromJson c, fromJson d)        

instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where
    writeJson g (a, b, c, d, e) = do
        writeStartArray g
        writeJson g a
        writeJson g b
        writeJson g c
        writeJson g d
        writeJson g e
        writeEndArray g
    readJson p = (a, b, c, d, e)
      where
        assertStartArray p
        a = readNextJson p
        b = readNextJson p
        c = readNextJson p
        d = readNextJson p
        e = readNextJson p
        assertEndArray p
    toJson (a, b, c, d, e) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e]
    fromJson (JsonArray [a, b, c, d, e]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e)        

data Json =
    JsonString String
  | JsonDouble Double
  | JsonLong Long
  | JsonArray [Json]
  | JsonBoolean Boolean
  | JsonNull
  | JsonObject [JsonField]
data JsonField = JsonField String Json
  
deriving instance Show Json
deriving instance Show JsonField

instance Json Json where
    writeJson g (JsonString value) = writeString g value
    writeJson g (JsonDouble value) = writeNumberDouble g value
    writeJson g (JsonLong value) = writeNumberLong g value
    writeJson g (JsonBoolean value) = writeBoolean g value
    writeJson g JsonNull = writeNull g
    writeJson g (JsonArray values) = do
        writeStartArray g
        iter (writeJson g) values
        writeEndArray g
    writeJson g (JsonObject fields) = do
        writeStartObject g
        iter (\(JsonField name value) -> do
            writeFieldName g name
            writeJson g value) fields
        writeEndObject g
        
    readJson p = do
        token = currentToken p
        if token == VALUE_STRING
        then JsonString (getText p)
        else if token == VALUE_NUMBER_FLOAT
        then JsonDouble (getDoubleValue p)
        else if token == VALUE_NUMBER_INT
        then JsonLong (getLongValue p)
        else if token == VALUE_TRUE
        then JsonBoolean True
        else if token == VALUE_FALSE
        then JsonBoolean False
        else if token == VALUE_NULL
        then JsonNull
        else if token == START_ARRAY
        then do
            result = MList.create ()
            while (nextToken p != END_ARRAY)
                (MList.add result $ readJson p)
            JsonArray (MList.freeze result)
        else if token == START_OBJECT
        then do
            result = MList.create ()
            readJsonObjectContents result p
            JsonObject (MList.freeze result)
        else fail "Unsupported token type." 
    toJson = id
    fromJson = id

@private
readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()
readJsonObjectContents result p =
    match nextFieldName p with
        Just name -> do
            MList.add result $ JsonField name (readNextJson p)
            readJsonObjectContents result p
        Nothing -> ()

/*
@private
makeTypeEqual :: a -> a -> ()
makeTypeEqual _ _ = ()

@private
testValue :: Json a => Show a => a -> <Proc> ()
testValue v1 = do
    v2 = toJsonString v1
    v3 = fromJsonString v2
    makeTypeEqual v1 v3
    print "\(v1) -> \(v2) -> \(v3)"
    if v1 != v3
    then fail "Values differ"
    else ()

testGenericJson :: String -> <Proc> ()
testGenericJson v1 = do
    v2 = fromJsonString v1 :: Json
    v3 = toJsonString v2
    print "\(v1) -> \(v2) -> \(v3)"
    if v1 != v3
    then fail "Values differ"
    else ()

testIt :: <Proc> ()
testIt = do
    testValue "asd"
    testValue True
    testValue False
    testValue (123 :: Short)
    testValue (123 :: Integer)    
    testValue (123 :: Long)
    testValue (123 :: Double)
    testValue (123 :: Float)
    testValue (Nothing :: Maybe String)
    testValue (Just "asd") 
    testValue ["a", "b", "c"] 
    testValue [[],["a"],["b","c"]]
    testValue ()
    testValue ("a", "b")
    testValue ("a", "b", "c")
    testValue ("a", "b", "c", "d")
    testValue [Just "a", Nothing]
    testValue [("a", "b"), ("c", "d")]
    testValue (("a", "b"), ("c", "d"))
     
    testGenericJson "\"asd\""
    testGenericJson "123"
    testGenericJson "123.0"
    testGenericJson "true"
    testGenericJson "false"
    testGenericJson "null"
    testGenericJson "[1,2,3]"
    testGenericJson "[[1],[2,3],[]]"
    testGenericJson "{}"
    testGenericJson "{\"a\":123,\"b\":[]}"
    testGenericJson "{\"a\":{}}"
*/