Add AaJson

smucclaw · Oct 4, 2024 · 213317c · 213317c
1 parent fa37e9b
commit 213317c
Show file tree

Hide file tree

Showing 7 changed files with 741 additions and 277 deletions.
diff --git a/lib/haskell/natural4/app/Main.hs b/lib/haskell/natural4/app/Main.hs
@@ -77,6 +77,7 @@ import LS.XPile.Org (toOrg)
 import LS.XPile.Petri (toPetri)
 import LS.XPile.Prolog (rulesToProlog, rulesToSCasp)
 import LS.XPile.Purescript (translate2PS)
+import LS.XPile.AaJson (translate2AaJson)
 import LS.XPile.SVG qualified as AAS
 import LS.XPile.Simala.Transpile qualified as Simala
 import LS.XPile.Typescript (asTypescript)
@@ -426,6 +427,10 @@ transpilersMap =
     , "anyall representation dumped as Purescript source code for mv'ing into RuleLib/*.purs"
     , [purescriptTranspiler]
     )
+  , ( SFL4.aajsonMode
+    , "anyall representation dumped as json source code to be used by the web app"
+    , [aajsonTranspiler]
+    )
   -- old position of nativeMode in on-disk output
   , ( SFL4.logicalEnglishMode
     , "logical english"
@@ -806,6 +811,21 @@ purescriptTranspiler =
       pure (Success (commentIfError "-- ! -- " psResult) (Just psErrors))
       )
 
+aajsonTranspiler :: Transpiler
+aajsonTranspiler =
+  MkTranspiler
+    { subdir     = "aajson"
+    , extension  = "json"
+    , entryPoint = go
+    , output     = DefaultTranspilerOutput (MkTranspilerOutputConfig Just writeFile putStrLn)
+    }
+  where
+    go = withNLGData (\ nlgd ds -> do
+      let (psResult, psErrors) = xpLog do
+            translate2AaJson nlgd.allEnv nlgd.env ds.interpreted
+      pure (Success (commentIfError "-- ! -- " psResult) (Just psErrors))
+      )
+
 prologTranspiler :: Transpiler
 prologTranspiler =
   pprintTranspiler "prolog" "pl" -- unclear if this should use pprint

diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
diff --git a/lib/haskell/natural4/src/LS/Lib.hs b/lib/haskell/natural4/src/LS/Lib.hs
@@ -64,6 +64,7 @@ module LS.Lib
     jsonMode,
     vueMode,
     pursMode,
+    aajsonMode,
     uppaalMode,
     simalaMode,
     defaultModes,
@@ -407,6 +408,7 @@ defaultModes =
   , jsonMode
   , vueMode
   , pursMode
+  , aajsonMode
   , mdMode
   , gftreesMode
   , groundsMode
@@ -519,6 +521,9 @@ dmnMode = MkModeName "dmn"
 pursMode :: ModeName
 pursMode = MkModeName "purs"
 
+aajsonMode :: ModeName
+aajsonMode = MkModeName "aajson"
+
 mdMode :: ModeName
 mdMode = MkModeName "md"