]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.runtime/scl/Json.scl
Render last known value in time series chart hairline value tip
[simantics/platform.git] / bundles / org.simantics.scl.runtime / scl / Json.scl
1 import "Prelude"
2 import "StringBuilder" as StringBuilder
3 import "Coercion"
4
5 // JSValue and printing
6
7 data JSValue = JSObject [JSEntry]
8              | JSArray [JSValue]
9              | JSString String
10              | JSNumber String
11              | JSBoolean Boolean
12              | JSNull
13
14 data JSEntry = JSEntry String JSValue
15
16 instance Show JSValue where
17     sb <+ JSObject entries = printWithSeparator (sb << "{") "," entries << "}"
18     sb <+ JSArray elements = printWithSeparator (sb << "[") "," elements << "]"
19     sb <+ JSString str     = sb <+ str
20     sb <+ JSNumber str     = sb << str
21     sb <+ JSBoolean v      = sb << if v then "true" else "false"
22     sb <+ JSNull           = sb << "null"
23
24 instance Show JSEntry where
25     sb <+ JSEntry key value = sb <+ key << ":" <+ value
26
27 // JSCompatible
28
29 class JSCompatible a where
30     toJSValue :: a -> JSValue
31     toJSONString :: a -> String
32     printJSON :: StringBuilder.T -> a -> <Proc> StringBuilder.T
33     
34     printJSON sb v = sb <+ toJSValue v
35     toJSONString v = runProc (StringBuilder.toString (printJSON StringBuilder.new v))
36
37 instance JSCompatible JSValue where
38     toJSValue = id
39     printJSON = (<+)
40 instance JSCompatible Integer where
41     toJSValue = JSNumber . coerce
42 instance JSCompatible Long where
43     toJSValue = JSNumber . coerce
44 instance JSCompatible Float where
45     toJSValue = JSNumber . coerce
46 instance JSCompatible Double where
47     toJSValue = JSNumber . coerce
48 instance JSCompatible String where
49     toJSValue = JSString
50 instance JSCompatible Boolean where
51     toJSValue = JSBoolean
52 instance (JSCompatible a) => JSCompatible (Maybe a) where
53     toJSValue (Just v) = toJSValue v
54     toJSValue Nothing = JSNull
55 instance (JSCompatible a) => JSCompatible [a] where
56     toJSValue = JSArray . map toJSValue
57
58 (:::) :: JSCompatible a => String -> a -> JSEntry
59 key ::: value = JSEntry key (toJSValue value)