added mode 'gf --run' for running silently a script ; made quizzes handle character encoding correctly ; for this end, collected coding functions in GF.Text.Coding

5 files changed, 43 insertions, 21 deletions

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index 31c3ec652..baeb6ba41 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -28,6 +28,7 @@ import GF.Text.Lexing
 import GF.Text.Transliterations
 
 import GF.Data.Operations
+import GF.Text.Coding
 
 import Data.Maybe
 import qualified Data.Map as Map
@@ -63,10 +64,10 @@ emptyCommandInfo = CommandInfo {
 lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
 lookCommand = Map.lookup
 
-commandHelpAll :: (String -> String) -> PGF -> [Option] -> String
-commandHelpAll enc pgf opts = unlines
+commandHelpAll :: String -> PGF -> [Option] -> String
+commandHelpAll cod pgf opts = unlines
   [commandHelp (isOpt "full" opts) (co,info)
-    | (co,info) <- Map.assocs (allCommands enc pgf)]
+    | (co,info) <- Map.assocs (allCommands cod pgf)]
 
 commandHelp :: Bool -> (String,CommandInfo) -> String
 commandHelp full (co,info) = unlines $ [
@@ -82,8 +83,8 @@ commandHelp full (co,info) = unlines $ [
   ] else []
 
 -- this list must no more be kept sorted by the command name
-allCommands :: (String -> String) -> PGF -> Map.Map String CommandInfo
-allCommands enc pgf = Map.fromList [
+allCommands :: String -> PGF -> Map.Map String CommandInfo
+allCommands cod pgf = Map.fromList [
   ("cc", emptyCommandInfo {
      longname = "compute_concrete",
      syntax = "cc (-all | -table | -unqual)? TERM",
@@ -206,10 +207,10 @@ allCommands enc pgf = Map.fromList [
           _ | isOpt "coding" opts -> codingMsg
           _ | isOpt "license" opts -> licenseMsg
           [t] -> let co = getCommandOp (showTree t) in 
-                 case lookCommand co (allCommands enc pgf) of   ---- new map ??!!
+                 case lookCommand co (allCommands cod pgf) of   ---- new map ??!!
                    Just info -> commandHelp True (co,info)
                    _ -> "command not found"
-          _ -> commandHelpAll enc pgf opts
+          _ -> commandHelpAll cod pgf opts
        in return (fromString msg) 
      }),
   ("i", emptyCommandInfo {
@@ -253,6 +254,7 @@ allCommands enc pgf = Map.fromList [
      exec = \opts -> return . fromStrings . map (optLin opts),
      options = [
        ("all","show all forms and variants"),
+       ("multi","linearize to all languages (default)"),
        ("record","show source-code-like record"),
        ("table","show all forms labelled by parameters"),
        ("term", "show PGF term"),
@@ -282,7 +284,7 @@ allCommands enc pgf = Map.fromList [
      exec = \opts _ -> do
          let lang = optLang opts
          let cat  = optCat opts
-         morphologyQuiz pgf lang cat
+         morphologyQuiz cod pgf lang cat
          return void,
      flags = [
        ("lang","language of the quiz"),
@@ -402,7 +404,7 @@ allCommands enc pgf = Map.fromList [
          let from = valIdOpts "from" (optLang opts) opts
          let to   = valIdOpts "to"   (optLang opts) opts
          let cat  = optCat opts
-         translationQuiz pgf from to cat
+         translationQuiz cod pgf from to cat
          return void,
      flags = [
        ("from","translate from this language"),
@@ -507,6 +509,7 @@ allCommands enc pgf = Map.fromList [
      })
   ]
  where
+   enc = encodeUnicode cod
    lin opts t = unlines [linearize pgf lang t    | lang <- optLangs opts]
    par opts s = concat  [parse pgf lang (optCat opts) s | lang <- optLangs opts]
  
@@ -616,15 +619,15 @@ stringOpOptions = [
        ("words","lexer that assumes tokens separated by spaces (default)")
        ]
 
-translationQuiz :: PGF -> Language -> Language -> Category -> IO ()
-translationQuiz pgf ig og cat = do
+translationQuiz :: String -> PGF -> Language -> Language -> Category -> IO ()
+translationQuiz cod pgf ig og cat = do
   tts <- translationList pgf ig og cat infinity
-  mkQuiz "Welcome to GF Translation Quiz." tts
+  mkQuiz cod "Welcome to GF Translation Quiz." tts
 
-morphologyQuiz :: PGF -> Language -> Category -> IO ()
-morphologyQuiz pgf ig cat = do
+morphologyQuiz :: String -> PGF -> Language -> Category -> IO ()
+morphologyQuiz cod pgf ig cat = do
   tts <- morphologyList pgf ig cat infinity
-  mkQuiz "Welcome to GF Morphology Quiz." tts
+  mkQuiz cod "Welcome to GF Morphology Quiz." tts
 
 -- | the maximal number of precompiled quiz problems
 infinity :: Int
diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs
index f4e3e220d..eff6e8b58 100644
--- a/src/GF/Command/Interpreter.hs
+++ b/src/GF/Command/Interpreter.hs
@@ -28,11 +28,11 @@ data CommandEnv = CommandEnv {
   expmacros     :: Map.Map String Tree
   }
 
-mkCommandEnv :: (String -> String) -> PGF -> CommandEnv
+mkCommandEnv :: String -> PGF -> CommandEnv
 mkCommandEnv enc pgf = CommandEnv pgf (allCommands enc pgf) Map.empty Map.empty
 
 emptyCommandEnv :: CommandEnv
-emptyCommandEnv = mkCommandEnv encodeUTF8 emptyPGF
+emptyCommandEnv = mkCommandEnv "utf8" emptyPGF
 
 interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO ()
 interpretCommandLine enc env line =
diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs
index 5d5081541..289bdd92b 100644
--- a/src/GF/Compile.hs
+++ b/src/GF/Compile.hs
@@ -52,12 +52,16 @@ compileToPGF opts fs =
        link opts name gr
 
 link :: Options -> String -> SourceGrammar -> IOE PGF
-link opts cnc gr =
-    do gc1 <- putPointE Normal opts "linking ... " $
+link opts cnc gr = do
+       let isv = (verbAtLeast opts Normal)
+       gc1 <- putPointE Normal opts "linking ... " $
                 let (abs,gc0) = mkCanon2gfcc opts cnc gr
                 in case checkPGF gc0 of
 		     Ok (gc,b) -> do 
-		       ioeIO $ putStrLn $ if b then "OK" else "Corrupted PGF"
+                       case (isv,b) of
+                         (True, True) -> ioeIO $ putStrLn "OK" 
+                         (False,True) -> return ()
+                         _            -> ioeIO $ putStrLn $ "Corrupted PGF"
 		       return gc
 		     Bad s -> fail s
        return $ buildParser opts $ optimize opts gc1
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index 8e8d44aff..10b5dcd21 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -68,7 +68,7 @@ errors = fail . unlines
 
 -- Types
 
-data Mode = ModeVersion | ModeHelp | ModeInteractive | ModeCompiler
+data Mode = ModeVersion | ModeHelp | ModeInteractive | ModeRun | ModeCompiler
   deriving (Show,Eq,Ord)
 
 data Verbosity = Quiet | Normal | Verbose | Debug
@@ -413,6 +413,7 @@ optDescr =
      Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
      Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.",
      Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
+     Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).",
      Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).",
      Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",
      Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .",
diff --git a/src/GF/Text/Coding.hs b/src/GF/Text/Coding.hs
new file mode 100644
index 000000000..47aaa5cb5
--- /dev/null
+++ b/src/GF/Text/Coding.hs
@@ -0,0 +1,14 @@
+module GF.Text.Coding where
+
+import GF.Text.UTF8
+import GF.Text.CP1251
+
+encodeUnicode e = case e of
+  "utf8"   -> encodeUTF8
+  "cp1251" -> encodeCP1251
+  _        -> id
+
+decodeUnicode e = case e of
+  "utf8"   -> decodeUTF8
+  "cp1251" -> decodeCP1251
+  _        -> id