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

8 files changed, 93 insertions, 52 deletions

diff --git a/src/GF.hs b/src/GF.hs
index 5b1776987..de288df10 100644
--- a/src/GF.hs
+++ b/src/GF.hs
@@ -37,5 +37,6 @@ mainOpts opts files =
       ModeVersion     -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version
       ModeHelp        -> putStrLn helpMessage
       ModeInteractive -> mainGFI opts files
+      ModeRun         -> mainRunGFI opts files
       ModeCompiler    -> dieIOE (mainGFC opts files)
 
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
diff --git a/src/GFI.hs b/src/GFI.hs
index 04c4c5d75..03fbb184f 100644
--- a/src/GFI.hs
+++ b/src/GFI.hs
@@ -1,4 +1,4 @@
-module GFI (mainGFI) where
+module GFI (mainGFI,mainRunGFI) where
 
 import GF.Command.Interpreter
 import GF.Command.Importing
@@ -11,8 +11,7 @@ import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.System.Readline
 
-import GF.Text.UTF8 ----
-import GF.Text.CP1251
+import GF.Text.Coding
 
 import PGF
 import PGF.Data
@@ -28,10 +27,17 @@ import System.CPUTime
 import Control.Exception
 import Data.Version
 import GF.System.Signal
-
+--import System.IO.Error (try)
 
 import Paths_gf
 
+mainRunGFI :: Options -> [FilePath] -> IO ()
+mainRunGFI opts files = do
+  let opts1 = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet})) opts
+  gfenv <- importInEnv emptyGFEnv opts1 files
+  loop opts1 gfenv
+  return ()
+
 mainGFI :: Options -> [FilePath] -> IO ()
 mainGFI opts files = do
   putStrLn welcome
@@ -39,17 +45,25 @@ mainGFI opts files = do
   loop opts gfenv
   return ()
 
-loopNewCPU gfenv' = do 
-   cpu' <- getCPUTime
-   putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
-   return $ gfenv' {cputime = cpu'}
+loopOptNewCPU opts gfenv' 
+ | not (verbAtLeast opts Normal) = return gfenv'
+ | otherwise = do 
+     cpu' <- getCPUTime
+     putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
+     return $ gfenv' {cputime = cpu'}
 
 loop :: Options -> GFEnv -> IO GFEnv
 loop opts gfenv0 = do
+  let loopNewCPU = loopOptNewCPU opts
+  let isv = verbAtLeast opts Normal
+  let ifv act = if isv then act else return ()
   let env = commandenv gfenv0
   let sgr = sourcegrammar gfenv0
   setCompletionFunction (Just (wordCompletion gfenv0))
-  s0 <- fetchCommand (prompt env)
+  let fetch = case flag optMode opts of
+        ModeRun -> tryGetLine
+        _ -> fetchCommand (prompt env)
+  s0 <- fetch 
   let gfenv = gfenv0 {history = s0 : history gfenv0}
   let 
     enc = encode gfenv
@@ -62,7 +76,7 @@ loop opts gfenv0 = do
 
   case pwords of
 
-      "q":_  -> putStrLn "See you." >> return gfenv
+      "q":_  -> ifv (putStrLn "See you.") >> return gfenv
 
       _ -> do
         r <- runInterruptibly $ case pwords of
@@ -132,8 +146,16 @@ importInEnv gfenv opts files
         do let opts' = addOptions (setOptimization OptCSE False) opts
                pgf0 = multigrammar (commandenv gfenv)
            pgf1 <- importGrammar pgf0 opts' files
-           putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
-           return $ gfenv { commandenv = mkCommandEnv (encode gfenv) pgf1 }
+           if (verbAtLeast opts Normal)
+             then putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
+             else return ()
+           return $ gfenv { commandenv = mkCommandEnv (coding gfenv) pgf1 }
+
+tryGetLine = do
+  res <- try getLine
+  case res of
+   Left e -> return "q"
+   Right l -> return l
 
 welcome = unlines [
   "                              ",
@@ -168,18 +190,10 @@ data GFEnv = GFEnv {
   }
 
 emptyGFEnv :: GFEnv
-emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv encodeUTF8 emptyPGF) [] 0 "utf8"
-
-encode env = case coding env of
-  "utf8"   -> encodeUTF8
-  "cp1251" -> encodeCP1251
-  _        -> id
-
-decode env = case coding env of
-  "utf8"   -> decodeUTF8
-  "cp1251" -> decodeCP1251
-  _        -> id
+emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv "utf8" emptyPGF) [] 0 "utf8"
 
+encode = encodeUnicode . coding 
+decode = decodeUnicode . coding
 
 wordCompletion gfenv line0 prefix0 p =
   case wc_type (take p line) of
diff --git a/src/PGF/Quiz.hs b/src/PGF/Quiz.hs
index 7f5bae201..096930f46 100644
--- a/src/PGF/Quiz.hs
+++ b/src/PGF/Quiz.hs
@@ -23,6 +23,7 @@ import PGF.ShowLinearize
 
 import GF.Data.Operations
 import GF.Infra.UseIO
+import GF.Text.Coding
 
 import System.Random
 
@@ -32,9 +33,9 @@ import Data.List (nub)
 
 -- generic quiz function
 
-mkQuiz :: String -> [(String,[String])] -> IO ()
-mkQuiz msg tts = do
-  let qas = [ (q, mkAnswer as) | (q,as) <- tts]
+mkQuiz :: String -> String -> [(String,[String])] -> IO ()
+mkQuiz cod msg tts = do
+  let qas = [ (q, mkAnswer cod as) | (q,as) <- tts]
   teachDialogue qas msg
 
 translationList :: 
@@ -57,11 +58,14 @@ morphologyList pgf ig cat number = do
            (pws,i) <- zip ss forms, let (par,ws) = pws !! i]
 
 -- | compare answer to the list of right answers, increase score and give feedback 
-mkAnswer :: [String] -> String -> (Integer, String) 
-mkAnswer as s = if (elem (norml s) as) 
-                   then (1,"Yes.") 
-                   else (0,"No, not" +++ s ++ ", but" ++++ unlines as)
+mkAnswer :: String -> [String] -> String -> (Integer, String) 
+mkAnswer cod as s = 
+  if (elem (norm s) as) 
+     then (1,"Yes.") 
+     else (0,"No, not" +++ s ++ ", but" ++++ enc (unlines as))
+ where
+   norm = unwords . words . decodeUnicode cod
+   enc = encodeUnicode cod
 
-norml :: String -> String
 norml = unwords . words