GF Shell: "ph | wf -file=foo.gfs" now works as advertised

The print_history command was among the commands implemented in an ad-hoc
way instead of being handled by the command line interpreter, which means
it could not be used in a pipe, as in the example in the help info.
The refactoring in the previous patch made this old bug easy to fix.

Also fixed a bug in the "empty" command, introduced when moving the PGF from
CommandEnv to GFEnv.

TODO: fix the undocumented eh command. A comment in the help info for
print_history, and some commented out old code, suggest that eh means
"execute_history", but at present it does nothing...

2 files changed, 58 insertions, 24 deletions

diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs
index 3d5f1695c..003517336 100644
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -8,7 +8,7 @@ import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)
 import GF.Command.Commands(flags,options,PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)
 import GF.Command.CommonCommands(commonCommands,extend)
 import GF.Command.SourceCommands
---import GF.Command.CommandInfo(mapCommandEnv,liftCommandInfo)
+import GF.Command.CommandInfo
 import GF.Command.Help(helpCommand)
 import GF.Command.Abstract
 import GF.Command.Parse(readCommandLine,pCommand)
@@ -34,7 +34,7 @@ import qualified Text.ParserCombinators.ReadP as RP
 --import System.CPUTime(getCPUTime)
 import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import Control.Exception(SomeException,fromException,evaluate,try)
-import Control.Monad.State
+import Control.Monad.State hiding (void)
 import qualified GF.System.Signal as IO(runInterruptibly)
 #ifdef SERVER_MODE
 import GF.Server(server)
@@ -133,10 +133,10 @@ execute1 opts s0 =
          "eh":ws  -> eh ws
          "i" :ws  -> import_ ws
       -- other special commands, working on GFEnv
-         "e" :_   -> empty
          "dc":ws  -> define_command ws
          "dt":ws  -> define_tree ws
-         "ph":_   -> print_history
+--       "e" :_   -> empty
+--       "ph":_   -> print_history
          "r" :_   -> reload_last
       -- ordinary commands
          _        -> do env <- gets commandenv
@@ -190,9 +190,6 @@ execute1 opts s0 =
                 continue
          continue
 
-    empty = do modify $ \ gfenv -> gfenv { commandenv=emptyCommandEnv }
-               continue
-
     define_command (f:ws) =
         case readCommandLine (unwords ws) of
            Just comm ->
@@ -224,10 +221,6 @@ execute1 opts s0 =
 
     dt_not_parsed = putStrLnE "value definition not parsed" >> continue
 
-    print_history =
-      do mapM_ putStrLnE . reverse . drop 1 . history =<< get
-         continue
-
     reload_last = do
       gfenv0 <- get
       let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
@@ -239,6 +232,30 @@ execute1 opts s0 =
           putStrLnE $ "no import in history"
           continue
 
+moreCommands = [
+  ("e",  emptyCommandInfo {
+     longname = "empty",
+     synopsis = "empty the environment (except the command history)",
+     exec = \ _ _ ->
+            do modify $ \ gfenv -> emptyGFEnv { history=history gfenv }
+               return void
+     }),
+  ("ph", emptyCommandInfo {
+     longname = "print_history",
+     synopsis = "print command history",
+     explanation = unlines [
+       "Prints the commands issued during the GF session.",
+       "The result is readable by the eh command.",
+       "The result can be used as a script when starting GF."
+       ],
+     examples = [
+      mkEx "ph | wf -file=foo.gfs  -- save the history into a file"
+      ],
+     exec = \ _ _ ->
+            fmap (fromString . unlines . reverse . drop 1 . history) get
+     })
+  ]
+
 
 printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
 
@@ -305,7 +322,7 @@ emptyCommandEnv = mkCommandEnv allCommands
 multigrammar = pgf . snd . pgfenv
 
 allCommands =
-  extend pgfCommands [helpCommand allCommands]
+  extend pgfCommands (helpCommand allCommands:moreCommands)
   `Map.union` sourceCommands
   `Map.union` commonCommands
 
diff --git a/src/compiler/GF/Interactive2.hs b/src/compiler/GF/Interactive2.hs
index 97736e0b1..d379d5316 100644
--- a/src/compiler/GF/Interactive2.hs
+++ b/src/compiler/GF/Interactive2.hs
@@ -4,9 +4,9 @@ module GF.Interactive2 (mainGFI,mainRunGFI{-,mainServerGFI-}) where
 import Prelude hiding (putStrLn,print)
 import qualified Prelude as P(putStrLn)
 import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretCommandLine)
---import GF.Command.Importing(importSource,importGrammar)
 import GF.Command.Commands2(flags,options,PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands)
 import GF.Command.CommonCommands
+import GF.Command.CommandInfo
 import GF.Command.Help(helpCommand)
 import GF.Command.Abstract
 import GF.Command.Parse(readCommandLine,pCommand)
@@ -35,7 +35,7 @@ import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import System.FilePath(takeExtensions)
 import Control.Exception(SomeException,fromException,try)
 --import Control.Monad
-import Control.Monad.State
+import Control.Monad.State hiding (void)
 
 import qualified GF.System.Signal as IO(runInterruptibly)
 {-
@@ -135,10 +135,10 @@ execute1 opts s0 =
          "eh":ws  -> eh ws
          "i" :ws  -> import_ ws
       -- other special commands, working on GFEnv
-         "e" :_   -> empty
          "dc":ws  -> define_command ws
          "dt":ws  -> define_tree ws
-         "ph":_   -> print_history
+--       "e" :_   -> empty
+--       "ph":_   -> print_history
          "r" :_   -> reload_last
       -- ordinary commands
          _        -> do env <- gets commandenv
@@ -192,9 +192,6 @@ execute1 opts s0 =
                 continue
          continue
 
-    empty = do modify $ \ gfenv -> gfenv { commandenv=emptyCommandEnv }
-               continue
-
     define_command (f:ws) =
         case readCommandLine (unwords ws) of
            Just comm ->
@@ -226,10 +223,6 @@ execute1 opts s0 =
 
     dt_not_parsed = putStrLnE "value definition not parsed" >> continue
 
-    print_history =
-      do mapM_ putStrLnE . reverse . drop 1 . history =<< get
-         continue
-
     reload_last = do
       gfenv0 <- get
       let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
@@ -241,6 +234,30 @@ execute1 opts s0 =
           putStrLnE $ "no import in history"
           continue
 
+moreCommands = [
+  ("e",  emptyCommandInfo {
+     longname = "empty",
+     synopsis = "empty the environment (except the command history)",
+     exec = \ _ _ ->
+            do modify $ \ gfenv -> emptyGFEnv { history=history gfenv }
+               return void
+     }),
+  ("ph", emptyCommandInfo {
+     longname = "print_history",
+     synopsis = "print command history",
+     explanation = unlines [
+       "Prints the commands issued during the GF session.",
+       "The result is readable by the eh command.",
+       "The result can be used as a script when starting GF."
+       ],
+     examples = [
+      mkEx "ph | wf -file=foo.gfs  -- save the history into a file"
+      ],
+     exec = \ _ _ ->
+            fmap (fromString . unlines . reverse . drop 1 . history) get
+     })
+  ]
+
 
 printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
 
@@ -306,7 +323,7 @@ multigrammar = pgf . pgfenv
 concretes = concs . pgfenv
 
 allCommands =
-  extend pgfCommands [helpCommand allCommands]
+  extend pgfCommands (helpCommand allCommands:moreCommands)
   `Map.union` commonCommands
 
 instance HasPGFEnv ShellM where getPGFEnv = gets pgfenv