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}.

1 files changed, 17 insertions, 2 deletions

diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs
index e24a6cb35..3b6a4c3c1 100644
--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -1,9 +1,9 @@
 -- | Shell IO: a monad that can restrict acesss to arbitrary IO and has the
 -- ability to capture output that normally would be sent to stdout.
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts #-}
 module GF.Infra.SIO(
        -- * The SIO monad
-       SIO,
+       SIO,MonadSIO(..),
        -- * Running SIO operations
        runSIO,hRunSIO,captureSIO,
        -- * Unrestricted, safe operations
@@ -25,12 +25,14 @@ module GF.Infra.SIO(
 import Prelude hiding (putStrLn,print)
 import Control.Applicative(Applicative(..))
 import Control.Monad(liftM,ap)
+import Control.Monad.Trans(MonadTrans(..))
 import System.IO(hPutStrLn,hFlush,stdout)
 import GF.System.Catch(try)
 import System.Process(system)
 import System.Environment(getEnv)
 import Control.Concurrent.Chan(newChan,writeChan,getChanContents)
 import GF.Infra.Concurrency(lazyIO)
+import GF.Infra.UseIO(Output(..))
 import qualified System.CPUTime as IO(getCPUTime)
 import qualified System.Directory as IO(getCurrentDirectory)
 import qualified System.Random as IO(newStdGen)
@@ -56,6 +58,19 @@ instance Monad SIO where
   return x = SIO (const (return x))
   SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
 
+instance Output SIO where
+  ePutStr = lift0 . ePutStr
+  ePutStrLn = lift0 . ePutStrLn
+  putStrLnE = putStrLnFlush
+--putStrE = --- !!!
+
+class MonadSIO m where liftSIO :: SIO a -> m a
+
+instance MonadSIO SIO where liftSIO = id
+
+instance (MonadTrans t,Monad m,MonadSIO m) => MonadSIO (t m) where
+  liftSIO = lift . liftSIO
+
 -- * Running SIO operations
 
 -- | Run normally