GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

Finish JSON conversion for abstract

Browse Source
This commit is contained in:
John J. Camilleri
2019-07-03 16:34:07 +02:00
parent c5a75c482c
commit ecf9b41db0
1 changed files with 29 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
src/compiler/GF/Compile/PGFtoJSON.hs
View File

@@ -4,6 +4,10 @@ import PGF(showCId)
import PGF.Internal as M import PGF.Internal as M
import qualified Text.JSON as JSON import qualified Text.JSON as JSON
import Text.JSON (JSValue(..))
-- import Text.JSON.Pretty (pp_value)
-- import Text.PrettyPrint (render)
--import GF.Data.ErrM --import GF.Data.ErrM
--import GF.Infra.Option --import GF.Infra.Option
@@ -19,38 +23,47 @@ import qualified Data.IntMap as IntMap
pgf2json :: PGF -> String pgf2json :: PGF -> String
pgf2json pgf = pgf2json pgf =
JSON.encode $ JSON.makeObj JSON.encode $ JSON.makeObj
-- render $ pp_value $ JSON.makeObj
[ ("abstract", json_abstract) [ ("abstract", json_abstract)
, ("concretes", json_concretes) , ("concretes", json_concretes)
] ]
-- JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
where where
-- n = showCId $ absname pgf n = showCId $ absname pgf
as = abstract pgf as = abstract pgf
cs = Map.assocs (concretes pgf) cs = Map.assocs (concretes pgf)
start = showCId $ M.lookStartCat pgf start = showCId $ M.lookStartCat pgf
-- grammar = new "GFGrammar" [js_abstract, js_concrete] json_abstract = abstract2json n start as
-- js_abstract = abstract2js start as
-- js_concrete = JS.EObj $ map concrete2js cs
json_abstract = abstract2json start as
json_concretes = JSON.makeObj $ map concrete2json cs json_concretes = JSON.makeObj $ map concrete2json cs
abstract2json :: String -> Abstr -> JSON.JSValue abstract2json :: String -> String -> Abstr -> JSValue
abstract2json start ds = JSON.JSNull abstract2json name start ds =
JSON.makeObj
[ ("name", JSString $ JSON.toJSString name)
, ("startcat", JSString $ JSON.toJSString start)
, ("funs", JSON.makeObj $ map absdef2js (Map.assocs (funs ds)))
]
-- abstract2js :: String -> Abstr -> JS.Expr -- abstract2js :: String -> Abstr -> JS.Expr
-- abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))] -- abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
--
-- absdef2js :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> JS.Property absdef2js :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> (String,JSValue)
-- absdef2js (f,(typ,_,_,_)) = absdef2js (f,(typ,_,_,_)) = (showCId f,sig)
-- let (args,cat) = M.catSkeleton typ in where
-- JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)]) (args,cat) = M.catSkeleton typ
-- sig = JSON.makeObj
[ ("args", JSArray $ map (mkJSString.showCId) args)
, ("cat", mkJSString $ showCId cat)
]
mkJSString :: String -> JSValue
mkJSString = JSString . JSON.toJSString
-- lit2js (LStr s) = JS.EStr s -- lit2js (LStr s) = JS.EStr s
-- lit2js (LInt n) = JS.EInt n -- lit2js (LInt n) = JS.EInt n
-- lit2js (LFlt d) = JS.EDbl d -- lit2js (LFlt d) = JS.EDbl d
concrete2json :: (CId,Concr) -> (String,JSON.JSValue) concrete2json :: (CId,Concr) -> (String,JSValue)
concrete2json (c,cnc) = (showCId c,JSON.JSNull) concrete2json (c,cnc) = (showCId c,JSNull)
-- concrete2js :: (CId,Concr) -> JS.Property -- concrete2js :: (CId,Concr) -> JS.Property
-- concrete2js (c,cnc) = -- concrete2js (c,cnc) =