reintroduce the compiler API

src/compiler/api/GF/Command/CommandInfo.hs

@@ -0,0 +1,81 @@
+module GF.Command.CommandInfo where
+import GF.Command.Abstract(Option,Expr,Term)
+import GF.Text.Pretty(render)
+import GF.Grammar.Grammar(Term(K))
+import GF.Grammar.Printer() -- instance Pretty Term
+import PGF2(mkStr,unStr,showExpr)
+
+data CommandInfo m = CommandInfo {
+  exec     :: [Option] -> CommandArguments -> m CommandOutput,
+  synopsis :: String,
+  syntax   :: String,
+  explanation :: String,
+  longname :: String,
+  options  :: [(String,String)],
+  flags    :: [(String,String)],
+  examples :: [(String,String)],
+  needsTypeCheck :: Bool
+  }
+
+mapCommandExec f c = c { exec = \ opts ts -> f (exec c opts ts) }
+
+--emptyCommandInfo :: CommandInfo env
+emptyCommandInfo = CommandInfo {
+  exec = error "command not implemented",
+  synopsis = "",
+  syntax = "",
+  explanation = "",
+  longname = "",
+  options = [],
+  flags = [],
+  examples = [],
+  needsTypeCheck = True
+  }
+--------------------------------------------------------------------------------
+
+class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr
+
+--------------------------------------------------------------------------------
+
+data CommandArguments = Exprs [(Expr,Float)] | Strings [String] | Term Term
+
+newtype CommandOutput = Piped (CommandArguments,String) ---- errors, etc
+
+-- ** Converting command output
+fromStrings ss         = Piped (Strings ss, unlines ss)
+fromExprs show_p es    = Piped (Exprs es,unlines (map (\(e,p) -> (if show_p then (++) ("["++show p++"] ") else id) (showExpr [] e)) es))
+fromString  s          = Piped (Strings [s], s)
+pipeWithMessage es msg = Piped (Exprs es,msg)
+pipeMessage msg        = Piped (Exprs [],msg)
+pipeExprs   es         = Piped (Exprs es,[]) -- only used in emptyCommandInfo
+void                   = Piped (Exprs [],"")
+
+-- ** Converting command input
+
+toStrings args =
+    case args of
+      Strings ss -> ss
+      Exprs es -> zipWith showAsString (True:repeat False) es
+      Term t -> [render t]
+  where
+    showAsString first (e,p) =
+      case unStr e of
+        Just s  -> s
+        Nothing -> ['\n'|not first] ++
+                   showExpr [] e ---newline needed in other cases than the first
+
+toExprs args =
+  case args of
+    Exprs es -> map fst es
+    Strings ss -> map mkStr ss
+    Term t -> [mkStr (render t)]
+
+toTerm args =
+  case args of
+    Term t -> t
+    Strings ss -> K $ unwords ss -- hmm
+    Exprs es -> K $ unwords $ map (showExpr [] . fst) es -- hmm
+
+-- ** Creating documentation
+
+mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))