+++ /dev/null
-import "StandardLibrary"\r
-import "Data/Writer"\r
-import "JavaBuiltin" as Java\r
-\r
-importJava "com.fasterxml.jackson.core.JsonGenerator" where\r
- data JsonGenerator\r
-\r
-@private\r
-importJava "com.fasterxml.jackson.core.JsonGenerator" where\r
- writeNull :: JsonGenerator -> <Proc> ()\r
- \r
- writeStartArray :: JsonGenerator -> <Proc> ()\r
- @JavaName writeStartArray\r
- writeStartArrayN :: JsonGenerator -> Integer -> <Proc> ()\r
- writeEndArray :: JsonGenerator -> <Proc> ()\r
- \r
- writeStartObject :: JsonGenerator -> <Proc> ()\r
- writeFieldName :: JsonGenerator -> String -> <Proc> ()\r
- writeEndObject :: JsonGenerator -> <Proc> ()\r
-\r
- writeBoolean :: JsonGenerator -> Boolean -> <Proc> ()\r
- \r
- writeString :: JsonGenerator -> String -> <Proc> ()\r
- \r
- @JavaName writeNumber\r
- writeNumberDouble :: JsonGenerator -> Double -> <Proc> ()\r
- @JavaName writeNumber\r
- writeNumberInteger :: JsonGenerator -> Integer -> <Proc> ()\r
- @JavaName writeNumber\r
- writeNumberLong :: JsonGenerator -> Long -> <Proc> ()\r
- @JavaName writeNumber\r
- writeNumberShort :: JsonGenerator -> Short -> <Proc> ()\r
- @JavaName writeNumber\r
- writeNumberFloat :: JsonGenerator -> Float -> <Proc> ()\r
- \r
- @JavaName close\r
- closeGenerator :: JsonGenerator -> <Proc> ()\r
-\r
-@private\r
-importJava "com.fasterxml.jackson.core.JsonToken" where\r
- data JsonToken\r
- END_ARRAY :: JsonToken\r
- END_OBJECT :: JsonToken\r
- FIELD_NAME :: JsonToken\r
- NOT_AVAILABLE :: JsonToken\r
- START_ARRAY :: JsonToken\r
- START_OBJECT :: JsonToken\r
- VALUE_EMBEDDED_OBJECT :: JsonToken\r
- VALUE_FALSE :: JsonToken\r
- VALUE_NULL :: JsonToken\r
- VALUE_NUMBER_FLOAT :: JsonToken\r
- VALUE_NUMBER_INT :: JsonToken\r
- VALUE_STRING :: JsonToken\r
- VALUE_TRUE :: JsonToken\r
-instance Eq JsonToken where\r
- (==) = Java.equals\r
-\r
-importJava "com.fasterxml.jackson.core.JsonParser" where\r
- data JsonParser\r
-\r
-@private\r
-importJava "com.fasterxml.jackson.core.JsonParser" where\r
- nextToken :: JsonParser -> <Proc> JsonToken\r
- currentToken :: JsonParser -> <Proc> JsonToken\r
- getDoubleValue :: JsonParser -> <Proc> Double\r
- getIntValue :: JsonParser -> <Proc> Integer\r
- getText :: JsonParser -> <Proc> String\r
- getShortValue :: JsonParser -> <Proc> Short\r
- getFloatValue :: JsonParser -> <Proc> Float\r
- getLongValue :: JsonParser -> <Proc> Long\r
- nextFieldName :: JsonParser -> <Proc> Maybe String\r
-\r
-@private\r
-importJava "com.fasterxml.jackson.core.JsonFactory" where\r
- data JsonFactory\r
- \r
- @JavaName "<init>"\r
- createJsonFactory :: <Proc> JsonFactory\r
- \r
- @JavaName createGenerator\r
- createWriterGenerator :: JsonFactory -> Writer -> <Proc> JsonGenerator\r
- \r
- @JavaName createParser\r
- createStringParser :: JsonFactory -> String -> <Proc> JsonParser\r
- \r
-@private\r
-defaultFactory = createJsonFactory\r
-\r
-@private\r
-@inline\r
-assertStartArray :: JsonParser -> <Proc> ()\r
-assertStartArray p = if currentToken p == START_ARRAY\r
- then ()\r
- else fail "Expected START_ARRAY token."\r
-\r
-@private\r
-@inline\r
-assertEndArray :: JsonParser -> <Proc> ()\r
-assertEndArray p = if nextToken p == END_ARRAY\r
- then ()\r
- else fail "Expected END_ARRAY token."\r
-\r
-// *** Json type class ********************************************************\r
-\r
-class Json a where\r
- writeJson :: JsonGenerator -> a -> <Proc> ()\r
- readJson :: JsonParser -> <Proc> a\r
- toJson :: a -> Json\r
- fromJson :: Json -> a\r
- \r
- writeJson g v = writeJson g (toJson v)\r
- readJson p = fromJson (readJson p) \r
-\r
-@private\r
-readNextJson :: Json a => JsonParser -> <Proc> a\r
-readNextJson p = do\r
- nextToken p\r
- readJson p\r
-\r
-"""\r
-Converts the value to a string encoded with JSON\r
-"""\r
-toJsonString :: Json a => a -> String\r
-toJsonString v = runProc do\r
- writer = createStringWriter\r
- generator = createWriterGenerator defaultFactory (toWriter writer)\r
- writeJson generator v\r
- closeGenerator generator\r
- resultOfStringWriter writer\r
-\r
-"""\r
-Parses a JSON encoded string into a value\r
-"""\r
-fromJsonString :: Json a => String -> a\r
-fromJsonString str = runProc do\r
- parser = createStringParser defaultFactory str\r
- readNextJson parser\r
-\r
-instance Json String where\r
- writeJson = writeString\r
- readJson = getText\r
- toJson = JsonString\r
- fromJson (JsonString value) = value\r
-\r
-instance Json Boolean where\r
- writeJson = writeBoolean\r
- readJson p =\r
- if currentToken p == VALUE_TRUE\r
- then True\r
- else False\r
- toJson = JsonBoolean\r
- fromJson (JsonBoolean value) = value\r
- \r
-instance Json Double where\r
- writeJson = writeNumberDouble\r
- readJson = getDoubleValue\r
- toJson = JsonDouble\r
- fromJson (JsonDouble value) = value\r
-\r
-instance Json Float where\r
- writeJson = writeNumberFloat\r
- readJson = getFloatValue\r
- toJson = JsonDouble . toDouble\r
- fromJson (JsonDouble value) = fromDouble value\r
-\r
-instance Json Integer where\r
- writeJson = writeNumberInteger\r
- readJson = getIntValue\r
- toJson = JsonLong . fromInteger\r
- fromJson (JsonLong value) = Java.l2i value\r
-\r
-instance Json Long where\r
- writeJson = writeNumberLong\r
- readJson = getLongValue\r
- toJson = JsonLong\r
- fromJson (JsonLong value) = value\r
-\r
-instance Json Short where\r
- writeJson = writeNumberShort\r
- readJson = getShortValue\r
- toJson = JsonLong . Java.i2l . Java.s2i\r
- fromJson (JsonLong value) = Java.i2s (Java.l2i value) \r
- \r
-instance (Json a) => Json (Maybe a) where\r
- writeJson g (Just v) = writeJson g v\r
- writeJson g Nothing = writeNull g\r
- readJson p = \r
- if currentToken p == VALUE_NULL\r
- then Nothing\r
- else Just (readJson p)\r
- toJson (Just value) = toJson value\r
- toJson Nothing = JsonNull\r
- fromJson JsonNull = Nothing\r
- fromJson json = Just (fromJson json)\r
-\r
-instance (Json a) => Json [a] where\r
- writeJson g l = do\r
- writeStartArray g\r
- iter (writeJson g) l\r
- writeEndArray g\r
- readJson p = MList.freeze result\r
- where\r
- result = MList.create ()\r
- assertStartArray p\r
- while (nextToken p != END_ARRAY)\r
- (MList.add result $ readJson p)\r
- toJson l = JsonArray (map toJson l)\r
- fromJson (JsonArray l) = map fromJson l\r
-\r
-instance Json () where\r
- writeJson g _ = do\r
- writeStartArray g\r
- writeEndArray g\r
- readJson p = do\r
- assertStartArray p\r
- assertEndArray p\r
- ()\r
- toJson _ = JsonArray []\r
- fromJson (JsonArray []) = ()\r
-\r
-instance (Json a, Json b) => Json (a, b) where\r
- writeJson g (a, b) = do\r
- writeStartArray g\r
- writeJson g a\r
- writeJson g b\r
- writeEndArray g\r
- readJson p = (a, b)\r
- where\r
- assertStartArray p\r
- a = readNextJson p\r
- b = readNextJson p\r
- assertEndArray p\r
- toJson (a, b) = JsonArray [toJson a, toJson b]\r
- fromJson (JsonArray [a, b]) = (fromJson a, fromJson b) \r
-\r
-instance (Json a, Json b, Json c) => Json (a, b, c) where\r
- writeJson g (a, b, c) = do\r
- writeStartArray g\r
- writeJson g a\r
- writeJson g b\r
- writeJson g c\r
- writeEndArray g\r
- readJson p = (a, b, c)\r
- where\r
- assertStartArray p\r
- a = readNextJson p\r
- b = readNextJson p\r
- c = readNextJson p\r
- assertEndArray p\r
- toJson (a, b, c) = JsonArray [toJson a, toJson b, toJson c]\r
- fromJson (JsonArray [a, b, c]) = (fromJson a, fromJson b, fromJson c) \r
-\r
-instance (Json a, Json b, Json c, Json d) => Json (a, b, c, d) where\r
- writeJson g (a, b, c, d) = do\r
- writeStartArray g\r
- writeJson g a\r
- writeJson g b\r
- writeJson g c\r
- writeJson g d\r
- writeEndArray g\r
- readJson p = (a, b, c, d)\r
- where\r
- assertStartArray p\r
- a = readNextJson p\r
- b = readNextJson p\r
- c = readNextJson p\r
- d = readNextJson p\r
- assertEndArray p\r
- toJson (a, b, c, d) = JsonArray [toJson a, toJson b, toJson c, toJson d]\r
- fromJson (JsonArray [a, b, c, d]) = (fromJson a, fromJson b, fromJson c, fromJson d) \r
-\r
-instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where\r
- writeJson g (a, b, c, d, e) = do\r
- writeStartArray g\r
- writeJson g a\r
- writeJson g b\r
- writeJson g c\r
- writeJson g d\r
- writeJson g e\r
- writeEndArray g\r
- readJson p = (a, b, c, d, e)\r
- where\r
- assertStartArray p\r
- a = readNextJson p\r
- b = readNextJson p\r
- c = readNextJson p\r
- d = readNextJson p\r
- e = readNextJson p\r
- assertEndArray p\r
- toJson (a, b, c, d, e) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e]\r
- fromJson (JsonArray [a, b, c, d, e]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e) \r
-\r
-data Json =\r
- JsonString String\r
- | JsonDouble Double\r
- | JsonLong Long\r
- | JsonArray [Json]\r
- | JsonBoolean Boolean\r
- | JsonNull\r
- | JsonObject [JsonField]\r
-data JsonField = JsonField String Json\r
- \r
-deriving instance Show Json\r
-deriving instance Eq Json\r
-deriving instance Show JsonField\r
-deriving instance Eq JsonField\r
-\r
-instance Json Json where\r
- writeJson g (JsonString value) = writeString g value\r
- writeJson g (JsonDouble value) = writeNumberDouble g value\r
- writeJson g (JsonLong value) = writeNumberLong g value\r
- writeJson g (JsonBoolean value) = writeBoolean g value\r
- writeJson g JsonNull = writeNull g\r
- writeJson g (JsonArray values) = do\r
- writeStartArray g\r
- iter (writeJson g) values\r
- writeEndArray g\r
- writeJson g (JsonObject fields) = do\r
- writeStartObject g\r
- iter (\(JsonField name value) -> do\r
- writeFieldName g name\r
- writeJson g value) fields\r
- writeEndObject g\r
- \r
- readJson p = do\r
- token = currentToken p\r
- if token == VALUE_STRING\r
- then JsonString (getText p)\r
- else if token == VALUE_NUMBER_FLOAT\r
- then JsonDouble (getDoubleValue p)\r
- else if token == VALUE_NUMBER_INT\r
- then JsonLong (getLongValue p)\r
- else if token == VALUE_TRUE\r
- then JsonBoolean True\r
- else if token == VALUE_FALSE\r
- then JsonBoolean False\r
- else if token == VALUE_NULL\r
- then JsonNull\r
- else if token == START_ARRAY\r
- then do\r
- result = MList.create ()\r
- while (nextToken p != END_ARRAY)\r
- (MList.add result $ readJson p)\r
- JsonArray (MList.freeze result)\r
- else if token == START_OBJECT\r
- then do\r
- result = MList.create ()\r
- readJsonObjectContents result p\r
- JsonObject (MList.freeze result)\r
- else fail "Unsupported token type." \r
- toJson = id\r
- fromJson = id\r
-\r
-@private\r
-readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()\r
-readJsonObjectContents result p =\r
- match nextFieldName p with\r
- Just name -> do\r
- MList.add result $ JsonField name (readNextJson p)\r
- readJsonObjectContents result p\r
- Nothing -> ()\r
-\r
-/*\r
-@private\r
-makeTypeEqual :: a -> a -> ()\r
-makeTypeEqual _ _ = ()\r
-\r
-@private\r
-testValue :: Json a => Show a => Eq a => a -> <Proc> ()\r
-testValue v1 = do\r
- v2 = toJsonString v1\r
- v3 = fromJsonString v2\r
- makeTypeEqual v1 v3\r
- print "\(v1) -> \(v2) -> \(v3)"\r
- if v1 != v3\r
- then fail "Values differ"\r
- else ()\r
-\r
-testGenericJson :: String -> <Proc> ()\r
-testGenericJson v1 = do\r
- v2 = fromJsonString v1 :: Json\r
- v3 = toJsonString v2\r
- print "\(v1) -> \(v2) -> \(v3)"\r
- if v1 != v3\r
- then fail "Values differ"\r
- else ()\r
-\r
-testIt :: <Proc> ()\r
-testIt = do\r
- testValue "asd"\r
- testValue True\r
- testValue False\r
- testValue (123 :: Short)\r
- testValue (123 :: Integer) \r
- testValue (123 :: Long)\r
- testValue (123 :: Double)\r
- testValue (123 :: Float)\r
- testValue (Nothing :: Maybe String)\r
- testValue (Just "asd") \r
- testValue ["a", "b", "c"] \r
- testValue [[],["a"],["b","c"]]\r
- testValue ()\r
- testValue ("a", "b")\r
- testValue ("a", "b", "c")\r
- testValue ("a", "b", "c", "d")\r
- testValue [Just "a", Nothing]\r
- testValue [("a", "b"), ("c", "d")]\r
- testValue (("a", "b"), ("c", "d"))\r
- \r
- testGenericJson "\"asd\""\r
- testGenericJson "123"\r
- testGenericJson "123.0"\r
- testGenericJson "true"\r
- testGenericJson "false"\r
- testGenericJson "null"\r
- testGenericJson "[1,2,3]"\r
- testGenericJson "[[1],[2,3],[]]"\r
- testGenericJson "{}"\r
- testGenericJson "{\"a\":123,\"b\":[]}"\r
- testGenericJson "{\"a\":{}}"\r
-*/
\ No newline at end of file