X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.scl.data%2Fscl%2FData%2FJson.scl;h=268b9732a3e17db930708696f2d913c2a50b38a2;hp=659329df7ed8ad12f1b5cc293f85851a0db0ec1e;hb=7eae9b1b2b1b13b7ab2888ad2a35371d95f7dcc1;hpb=0ae2b770234dfc3cbb18bd38f324125cf0faca07

diff --git a/bundles/org.simantics.scl.data/scl/Data/Json.scl b/bundles/org.simantics.scl.data/scl/Data/Json.scl
index 659329df7..268b9732a 100644
--- a/bundles/org.simantics.scl.data/scl/Data/Json.scl
+++ b/bundles/org.simantics.scl.data/scl/Data/Json.scl
@@ -1,3 +1,23 @@
+/*
+
+An example how to implement 
+
+data GeographicalLocation = GeographicalLocation {
+    latitude :: Double,
+    longitude :: Double
+}
+
+instance Json GeographicalLocation where
+    toJson GeographicalLocation { latitude, longitude } = JsonObject [
+        JsonField "latitude" (toJson latitude),
+        JsonField "longitude" (toJson longitude)
+    ]
+    fromJson object = GeographicalLocation {
+        latitude = fromJson $ fromJust $ lookupJsonField "latitude" object,
+        longitude = fromJson $ fromJust $ lookupJsonField "longitude" object
+    }
+*/
+
 import "StandardLibrary"
 import "Data/Writer"
 import "JavaBuiltin" as Java
@@ -154,6 +174,7 @@ instance Json Double where
     readJson = getDoubleValue
     toJson = JsonDouble
     fromJson (JsonDouble value) = value
+    fromJson (JsonLong value) = Java.l2d value
 
 instance Json Float where
     writeJson = writeNumberFloat
@@ -288,6 +309,30 @@ instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where
     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)        
 
+instance (Json a, Json b, Json c, Json d, Json e, Json f) => Json (a, b, c, d, e, f) where
+    writeJson g (a, b, c, d, e, f) = do
+        writeStartArray g
+        writeJson g a
+        writeJson g b
+        writeJson g c
+        writeJson g d
+        writeJson g e
+        writeJson g f
+        writeEndArray g
+    readJson p = (a, b, c, d, e, f)
+      where
+        assertStartArray p
+        a = readNextJson p
+        b = readNextJson p
+        c = readNextJson p
+        d = readNextJson p
+        e = readNextJson p
+        f = readNextJson p
+        assertEndArray p
+    toJson (a, b, c, d, e, f) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e, toJson f]
+    fromJson (JsonArray [a, b, c, d, e, f]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e, fromJson f)  
+
+
 data Json =
     JsonString String
   | JsonDouble Double
@@ -298,6 +343,12 @@ data Json =
   | JsonObject [JsonField]
 data JsonField = JsonField String Json
   
+lookupJsonField :: String -> Json -> Maybe Json  
+lookupJsonField fieldName (JsonObject fields) = mapFirst selector fields
+  where
+    selector (JsonField name value) | name == fieldName = Just value
+    selector _ = Nothing 
+  
 deriving instance Show Json
 deriving instance Show JsonField