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)