GF Shell: refactoring for improved modularity and reusability:

+ Generalize the CommandInfo type by parameterizing it on the monad
  instead of just the environment.
+ Generalize the commands defined in
  GF.Command.{Commands,Commands2,CommonCommands,SourceCommands,HelpCommand}
  to work in any monad that supports the needed operations.
+ Liberate GF.Command.Interpreter from the IO monad.
  Also, move the current PGF from CommandEnv to GFEnv in
  GF.Interactive, making the command interpreter even more generic.
+ Use a state monad to maintain the state of the interpreter in
  GF.{Interactive,Interactive2}.

src/compiler/GF/Command/Interpreter.hs

@@ -1,67 +1,57 @@
 module GF.Command.Interpreter (
-  CommandEnv,pgfenv,commands,commandmacros,expmacros,
-  mkCommandEnv,
---emptyCommandEnv,
+  CommandEnv(..),mkCommandEnv,
   interpretCommandLine,
---interpretPipe,
   getCommandOp
   ) where
-import Prelude hiding (putStrLn)
-
 import GF.Command.CommandInfo
 import GF.Command.Abstract
 import GF.Command.Parse
---import PGF
 import PGF.Internal(Expr(..))
---import PGF.Morphology
-import GF.Infra.SIO(putStrLn,putStrLnFlush)
+import GF.Infra.UseIO(putStrLnE)
 
 import GF.Text.Pretty(render)
 import Control.Monad(when)
---import Control.Monad.Error()
 import qualified Data.Map as Map
 
-data CommandEnv env = CommandEnv {
-  pgfenv        :: env,
-  commands      :: Map.Map String (CommandInfo env),
+data CommandEnv m = CommandEnv {
+  commands      :: Map.Map String (CommandInfo m),
   commandmacros :: Map.Map String CommandLine,
   expmacros     :: Map.Map String Expr
   }
 
 --mkCommandEnv :: PGFEnv -> CommandEnv
-mkCommandEnv env cmds = CommandEnv env cmds Map.empty Map.empty
+mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty
 
 --interpretCommandLine :: CommandEnv -> String -> SIO ()
 interpretCommandLine env line =
   case readCommandLine line of
     Just []    -> return ()
     Just pipes -> mapM_ (interpretPipe env) pipes
-    Nothing    -> putStrLnFlush "command not parsed"
+    Nothing    -> putStrLnE "command not parsed"
 
 interpretPipe env cs = do
-     Piped v@(_,s) <- intercs void cs
-     putStrLnFlush s
+     Piped v@(_,s) <- intercs cs void
+     putStrLnE s
      return ()
   where
-   intercs treess [] = return treess
-   intercs (Piped (trees,_)) (c:cs) = do
-     treess2 <- interc trees c
-     intercs treess2 cs
-   interc es comm@(Command co opts arg) = case co of
-     '%':f -> case Map.lookup f (commandmacros env) of
-       Just css ->
-         case getCommandTrees env False arg es of
-           Right es -> do mapM_ (interpretPipe env) (appLine es css) 
-                          return void
-           Left msg -> do putStrLn ('\n':msg)
-                          return void
-       Nothing  -> do
-         putStrLn $ "command macro " ++ co ++ " not interpreted"
-         return void
-     _ -> interpret env es comm
-   appLine es = map (map (appCommand es))
+   intercs [] treess = return treess
+   intercs (c:cs) (Piped (trees,_)) = interc c trees >>= intercs cs
 
--- macro definition applications: replace ?i by (exps !! i)
+   interc comm@(Command co opts arg) es =
+     case co of
+       '%':f -> case Map.lookup f (commandmacros env) of
+         Just css ->
+           do es <- getCommandTrees env False arg es
+              mapM_ (interpretPipe env) (appLine es css)
+              return void
+         Nothing  -> do
+           putStrLnE $ "command macro " ++ co ++ " not interpreted"
+           return void
+       _ -> interpret env es comm
+
+   appLine = map . map . appCommand
+
+-- | macro definition applications: replace ?i by (exps !! i)
 appCommand :: [Expr] -> Command -> Command
 appCommand xs c@(Command i os arg) = case arg of
   AExpr e -> Command i os (AExpr (app e))
@@ -74,25 +64,22 @@ appCommand xs c@(Command i os arg) = case arg of
     EMeta i    -> xs !! i
     EFun x     -> EFun x
 
--- return the trees to be sent in pipe, and the output possibly printed
+-- | return the trees to be sent in pipe, and the output possibly printed
 --interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
 interpret env trees comm = 
-  case getCommand env trees comm of
-    Left  msg               -> do putStrLn ('\n':msg)
-                                  return void
-    Right (info,opts,trees) -> do let cmdenv = pgfenv env
-                                  tss@(Piped (_,s)) <- exec info cmdenv opts trees
-                                  when (isOpt "tr" opts) $ putStrLn s
-                                  return tss
+  do (info,opts,trees) <- getCommand env trees comm
+     tss@(Piped (_,s)) <- exec info opts trees
+     when (isOpt "tr" opts) $ putStrLnE s
+     return tss
 
--- analyse command parse tree to a uniform datastructure, normalizing comm name
+-- | analyse command parse tree to a uniform datastructure, normalizing comm name
 --- the env is needed for macro lookup
 --getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo PGFEnv,[Option],[Expr])
-getCommand env es co@(Command c opts arg) = do
-  info <- getCommandInfo  env c
-  checkOpts info opts
-  es   <- getCommandTrees env (needsTypeCheck info) arg es
-  return (info,opts,es)
+getCommand env es co@(Command c opts arg) =
+  do info <- getCommandInfo  env c
+     checkOpts info opts
+     es <- getCommandTrees env (needsTypeCheck info) arg es
+     return (info,opts,es)
 
 --getCommandInfo :: CommandEnv -> String -> Either String (CommandInfo PGFEnv)
 getCommandInfo env cmd = 
@@ -100,7 +87,7 @@ getCommandInfo env cmd =
     Just info -> return info
     Nothing   -> fail $ "command not found: " ++ cmd
 
-checkOpts :: CommandInfo env -> [Option] -> Either String ()
+--checkOpts :: CommandInfo env -> [Option] -> Either String ()
 checkOpts info opts = 
   case
     [o | OOpt  o   <- opts, notElem o ("tr" : map fst (options info))] ++
@@ -114,12 +101,11 @@ checkOpts info opts =
 getCommandTrees env needsTypeCheck a es =
   case a of
     AMacro m -> case Map.lookup m (expmacros env) of
-                  Just e -> return [e]
-                  _      -> return [] 
+                  Just e -> one e
+                  _      -> return [] -- report error?
     AExpr e -> if needsTypeCheck
-                 then case typeCheckArg (pgfenv env) e of
-                        Left tcErr -> fail $ render tcErr
-                        Right e    -> return [e] -- ignore piped
-                 else return [e]
+               then one =<< typeCheckArg e
+               else one e
     ANoArg  -> return es  -- use piped
-
+  where
+    one e = return [e] -- ignore piped