Embed/TemplateApp

2 files changed, 69 insertions, 1 deletions

diff --git a/src/GF/Embed/EmbedAPI.hs b/src/GF/Embed/EmbedAPI.hs
index 197c24de2..0058d77c5 100644
--- a/src/GF/Embed/EmbedAPI.hs
+++ b/src/GF/Embed/EmbedAPI.hs
@@ -15,13 +15,15 @@
 
 module GF.Embed.EmbedAPI where
 
-import GF.Compile.ShellState (ShellState,grammar2shellState,canModules,stateGrammarOfLang,abstract,grammar)
+import GF.Compile.ShellState (ShellState,grammar2shellState,canModules,stateGrammarOfLang,abstract,grammar,firstStateGrammar,allLanguages,allCategories)
 import GF.UseGrammar.Linear (linTree2string)
+import GF.UseGrammar.GetTree (string2tree)
 import GF.Embed.EmbedParsing (parseString)
 import GF.Canon.CMacros (noMark)
 import GF.Grammar.Grammar (Trm)
 import GF.Grammar.MMacros (exp2tree)
 import GF.Grammar.Macros (zIdent)
+import GF.Grammar.PrGrammar (prt_)
 import GF.Grammar.Values (tree2exp)
 import GF.Grammar.TypeCheck (annotate)
 import GF.Canon.GetGFC (getCanonGrammar)
@@ -47,9 +49,19 @@ type Category     = String
 type Tree         = Trm
 
 file2grammar :: FilePath -> IO MultiGrammar
+
 linearize    :: MultiGrammar -> Language -> Tree -> String
 parse        :: MultiGrammar -> Language -> Category -> String -> [Tree]
 
+linearizeAll :: MultiGrammar             -> Tree -> [String]
+parseAll     :: MultiGrammar             -> Category -> String -> [[Tree]]
+
+readTree     :: MultiGrammar -> String -> Tree
+showTree     ::                 Tree -> String
+
+languages    :: MultiGrammar -> [Language]
+categories   :: MultiGrammar -> [Category]
+
 ---------------------------------------------------
 -- Implementation
 ---------------------------------------------------
@@ -76,3 +88,15 @@ parse mgr lang cat =
    sgr   = stateGrammarOfLang mgr (zIdent lang)
    cfcat = string2CFCat abs cat
    abs   = maybe (error "no abstract syntax") prIdent $ abstract mgr
+
+linearizeAll mgr t = [linearize mgr lang t | lang <- languages mgr]
+
+parseAll mgr cat s = [parse mgr lang cat s | lang <- languages mgr]
+
+readTree mgr s = tree2exp $ string2tree (firstStateGrammar mgr) s
+
+showTree t  = prt_ t
+
+languages mgr = [prt_ l | l <- allLanguages mgr]
+
+categories mgr = [prt_ c | (_,c) <- allCategories mgr]
diff --git a/src/GF/Embed/TemplateApp.hs b/src/GF/Embed/TemplateApp.hs
new file mode 100644
index 000000000..f8722691f
--- /dev/null
+++ b/src/GF/Embed/TemplateApp.hs
@@ -0,0 +1,44 @@
+module Main where
+
+import GF.Embed.EmbedAPI
+import System
+
+-- Simple translation application built on EmbedAPI. AR 7/10/2005
+
+main :: IO ()
+main = do
+  file:_  <- getArgs
+  grammar <- file2grammar file
+  translate grammar
+
+translate :: MultiGrammar -> IO ()
+translate grammar = do
+  s <- getLine
+  if s == "quit" then return () else do
+    treat grammar s
+    translate grammar
+
+treat :: MultiGrammar -> String -> IO ()
+treat grammar s = putStrLn $ case comm of
+  ["lin"]        -> unlines $ linearizeAll grammar $ readTree grammar rest 
+  ["lin",lang]   -> linearize grammar lang $ readTree grammar rest 
+  ["parse",cat]  -> unlines $ map showTree $ concat $ parseAll grammar cat rest
+  ["parse",lang,cat] -> unlines $ map showTree $ parse grammar lang cat rest
+  ["langs"]      -> unwords $ languages grammar
+  ["cats"]       -> unwords $ categories grammar
+  ["help"]       -> helpMsg
+  _ -> "command not interpreted: " ++ s
+ where
+   (comm,rest) = (words c,drop 1 r) where
+      (c,r) = span (/=':') s
+
+helpMsg = unlines [
+  "lin : <Tree>",
+  "lin <Lang> : <Tree>",
+  "parse <Cat> : <String>",
+  "parse <Lang> <Cat> : <String>",
+  "langs",
+  "cats",
+  "help",
+  "quit"
+  ]