X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.scl.data%2Fscl%2FData%2FJson.scl;fp=bundles%2Forg.simantics.scl.data%2Fscl%2FData%2FJson.scl;h=0000000000000000000000000000000000000000;hb=0364f8f54b009e9e5de482d5c9d1cb7efb023141;hp=fb034cd57886311de41b4aa8253689ce957c0105;hpb=7ecf07ff9aacab300f1fb900f1f0f97beb1be139;p=simantics%2Fplatform.git diff --git a/bundles/org.simantics.scl.data/scl/Data/Json.scl b/bundles/org.simantics.scl.data/scl/Data/Json.scl deleted file mode 100644 index fb034cd57..000000000 --- a/bundles/org.simantics.scl.data/scl/Data/Json.scl +++ /dev/null @@ -1,421 +0,0 @@ -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 -> () - - writeStartArray :: JsonGenerator -> () - @JavaName writeStartArray - writeStartArrayN :: JsonGenerator -> Integer -> () - writeEndArray :: JsonGenerator -> () - - writeStartObject :: JsonGenerator -> () - writeFieldName :: JsonGenerator -> String -> () - writeEndObject :: JsonGenerator -> () - - writeBoolean :: JsonGenerator -> Boolean -> () - - writeString :: JsonGenerator -> String -> () - - @JavaName writeNumber - writeNumberDouble :: JsonGenerator -> Double -> () - @JavaName writeNumber - writeNumberInteger :: JsonGenerator -> Integer -> () - @JavaName writeNumber - writeNumberLong :: JsonGenerator -> Long -> () - @JavaName writeNumber - writeNumberShort :: JsonGenerator -> Short -> () - @JavaName writeNumber - writeNumberFloat :: JsonGenerator -> Float -> () - - @JavaName close - closeGenerator :: JsonGenerator -> () - -@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 -instance Eq JsonToken where - (==) = Java.equals - -importJava "com.fasterxml.jackson.core.JsonParser" where - data JsonParser - -@private -importJava "com.fasterxml.jackson.core.JsonParser" where - nextToken :: JsonParser -> JsonToken - currentToken :: JsonParser -> JsonToken - getDoubleValue :: JsonParser -> Double - getIntValue :: JsonParser -> Integer - getText :: JsonParser -> String - getShortValue :: JsonParser -> Short - getFloatValue :: JsonParser -> Float - getLongValue :: JsonParser -> Long - nextFieldName :: JsonParser -> Maybe String - -@private -importJava "com.fasterxml.jackson.core.JsonFactory" where - data JsonFactory - - @JavaName "" - createJsonFactory :: JsonFactory - - @JavaName createGenerator - createWriterGenerator :: JsonFactory -> Writer -> JsonGenerator - - @JavaName createParser - createStringParser :: JsonFactory -> String -> JsonParser - -@private -defaultFactory = createJsonFactory - -@private -@inline -assertStartArray :: JsonParser -> () -assertStartArray p = if currentToken p == START_ARRAY - then () - else fail "Expected START_ARRAY token." - -@private -@inline -assertEndArray :: JsonParser -> () -assertEndArray p = if nextToken p == END_ARRAY - then () - else fail "Expected END_ARRAY token." - -// *** Json type class ******************************************************** - -class Json a where - writeJson :: JsonGenerator -> a -> () - readJson :: JsonParser -> a - toJson :: a -> Json - fromJson :: Json -> a - - writeJson g v = writeJson g (toJson v) - readJson p = fromJson (readJson p) - -@private -readNextJson :: Json a => JsonParser -> 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 Eq Json -deriving instance Show JsonField -deriving instance Eq 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 -> () -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 => Eq a => a -> () -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 -> () -testGenericJson v1 = do - v2 = fromJsonString v1 :: Json - v3 = toJsonString v2 - print "\(v1) -> \(v2) -> \(v3)" - if v1 != v3 - then fail "Values differ" - else () - -testIt :: () -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\":{}}" -*/ \ No newline at end of file