module SimpleEditor.JSON where

import Text.JSON

import SimpleEditor.Syntax


instance JSON Grammar where
  showJSON :: Grammar -> JSValue
showJSON (Grammar ModId
name [ModId]
extends Abstract
abstract [Concrete]
concretes) =
    [(ModId, JSValue)] -> JSValue
makeObj [ModId
"basename"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
name, ModId
"extends"ModId -> [ModId] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[ModId]
extends,
             ModId
"abstract"ModId -> Abstract -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=Abstract
abstract, ModId
"concretes"ModId -> [Concrete] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[Concrete]
concretes]
  readJSON :: JSValue -> Result Grammar
readJSON = ModId -> JSValue -> Result Grammar
forall a. HasCallStack => ModId -> a
error ModId
"Grammar.readJSON intentionally not defined"

instance JSON Abstract where
  showJSON :: Abstract -> JSValue
showJSON (Abstract ModId
startcat [ModId]
cats [Fun]
funs) =
    [(ModId, JSValue)] -> JSValue
makeObj [ModId
"startcat"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
startcat, ModId
"cats"ModId -> [ModId] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[ModId]
cats, ModId
"funs"ModId -> [Fun] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[Fun]
funs]
  readJSON :: JSValue -> Result Abstract
readJSON = ModId -> JSValue -> Result Abstract
forall a. HasCallStack => ModId -> a
error ModId
"Abstract.readJSON intentionally not defined"

instance JSON Fun where 
  showJSON :: Fun -> JSValue
showJSON (Fun   ModId
name [ModId]
typ) = ModId -> [ModId] -> JSValue
forall a a. (JSON a, JSON a) => a -> a -> JSValue
signature  ModId
name [ModId]
typ
  readJSON :: JSValue -> Result Fun
readJSON = ModId -> JSValue -> Result Fun
forall a. HasCallStack => ModId -> a
error ModId
"Fun.readJSON intentionally not defined"

instance JSON Param where 
  showJSON :: Param -> JSValue
showJSON (Param ModId
name ModId
rhs) = ModId -> ModId -> JSValue
forall a a. (JSON a, JSON a) => a -> a -> JSValue
definition ModId
name ModId
rhs
  readJSON :: JSValue -> Result Param
readJSON = ModId -> JSValue -> Result Param
forall a. HasCallStack => ModId -> a
error ModId
"Param.readJSON intentionally not defined"

instance JSON Oper where 
  showJSON :: Oper -> JSValue
showJSON (Oper  ModId
name ModId
rhs) = ModId -> ModId -> JSValue
forall a a. (JSON a, JSON a) => a -> a -> JSValue
definition ModId
name ModId
rhs
  readJSON :: JSValue -> Result Oper
readJSON = ModId -> JSValue -> Result Oper
forall a. HasCallStack => ModId -> a
error ModId
"Oper.readJSON intentionally not defined"

signature :: a -> a -> JSValue
signature  a
name a
typ = [(ModId, JSValue)] -> JSValue
makeObj [ModId
"name"ModId -> a -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=a
name,ModId
"type"ModId -> a -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=a
typ]
definition :: a -> a -> JSValue
definition a
name a
rhs = [(ModId, JSValue)] -> JSValue
makeObj [ModId
"name"ModId -> a -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=a
name,ModId
"rhs"ModId -> a -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=a
rhs]

instance JSON Concrete where
  showJSON :: Concrete -> JSValue
showJSON (Concrete ModId
langcode [ModId]
opens [Param]
params [Lincat]
lincats [Oper]
opers [Lin]
lins) =
    [(ModId, JSValue)] -> JSValue
makeObj [ModId
"langcode"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
langcode, ModId
"opens"ModId -> [ModId] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[ModId]
opens,
              ModId
"params"ModId -> [Param] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[Param]
params, ModId
"opers"ModId -> [Oper] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[Oper]
opers,
             ModId
"lincats"ModId -> [Lincat] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[Lincat]
lincats, ModId
"lins"ModId -> [Lin] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[Lin]
lins]
  readJSON :: JSValue -> Result Concrete
readJSON = ModId -> JSValue -> Result Concrete
forall a. HasCallStack => ModId -> a
error ModId
"Concrete.readJSON intentionally not defined"

instance JSON Lincat where
  showJSON :: Lincat -> JSValue
showJSON (Lincat ModId
cat ModId
lintype) = [(ModId, JSValue)] -> JSValue
makeObj [ModId
"cat"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
cat, ModId
"type"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
lintype]
  readJSON :: JSValue -> Result Lincat
readJSON = ModId -> JSValue -> Result Lincat
forall a. HasCallStack => ModId -> a
error ModId
"Lincat.readJSON intentionally not defined"

instance JSON Lin where
  showJSON :: Lin -> JSValue
showJSON (Lin ModId
fun [ModId]
args ModId
lin) = [(ModId, JSValue)] -> JSValue
makeObj [ModId
"fun"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
fun, ModId
"args"ModId -> [ModId] -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=[ModId]
args, ModId
"lin"ModId -> ModId -> (ModId, JSValue)
forall a a. JSON a => a -> a -> (a, JSValue)
.=ModId
lin]
  readJSON :: JSValue -> Result Lin
readJSON = ModId -> JSValue -> Result Lin
forall a. HasCallStack => ModId -> a
error ModId
"Lin.readJSON intentionally not defined"

infix 1 .=
a
name .= :: a -> a -> (a, JSValue)
.= a
v = (a
name,a -> JSValue
forall a. JSON a => a -> JSValue
showJSON a
v)