From 2c4d34af28b31fefe26379bf6301ce9b48fb38dc Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Tue, 6 Nov 2007 17:27:20 +0000
Subject: [PATCH] prompt and CPU time in experimental shell

---
 src/GF/Devel/GF3.hs   | 29 +++++++++++++++++++++++------
 src/GF/Devel/UseIO.hs |  1 +
 src/GF/GFCC/API.hs    |  5 +++++
 3 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/src/GF/Devel/GF3.hs b/src/GF/Devel/GF3.hs
index 742feb09a..30bc2f810 100644
--- a/src/GF/Devel/GF3.hs
+++ b/src/GF/Devel/GF3.hs
@@ -5,6 +5,8 @@ import GF.Command.Importing
 import GF.Command.Commands
 import GF.GFCC.API
 
+import GF.Devel.UseIO
+import GF.Devel.Arch
 import GF.Infra.Option ---- Haskell's option lib
 
 import System (getArgs)
@@ -14,20 +16,27 @@ main = do
   putStrLn welcome
   xx <- getArgs
   env <- importInEnv emptyMultiGrammar xx
-  loop env
+  loop (GFEnv env [] 0)
   return ()
 
-loop :: CommandEnv -> IO CommandEnv
-loop env = do
+loop :: GFEnv -> IO GFEnv
+loop gfenv0 = do
+  let env = commandenv gfenv0
+  putStrFlush (prompt env)
   s <- getLine
+  let gfenv = gfenv0 {history = s : history gfenv0}
   case words s of
-    "q":_ -> return env
+    "q":_ -> return gfenv
     "i":args -> do
       env1 <- importInEnv (multigrammar env) args
-      loop env1
+      loopNewCPU $ gfenv {commandenv = env1}
     _ -> do
       interpretCommandLine env s
-      loop env
+      loopNewCPU gfenv
+
+loopNewCPU gfenv = do
+  cpu <- prCPU $ cputime gfenv
+  loop $ gfenv {cputime = cpu}
 
 importInEnv mgr0 xx = do
   let (opts,files) = getOptions "-" xx
@@ -42,3 +51,11 @@ welcome = unlines [
   "This is GF version 3.0 alpha.",
   "Some things may work."
   ]
+
+prompt env = abstractName (multigrammar env) ++ "> "
+
+data GFEnv = GFEnv {
+  commandenv :: CommandEnv,
+  history    :: [String],
+  cputime    :: Integer
+  }
diff --git a/src/GF/Devel/UseIO.hs b/src/GF/Devel/UseIO.hs
index bd9f47845..21842724d 100644
--- a/src/GF/Devel/UseIO.hs
+++ b/src/GF/Devel/UseIO.hs
@@ -23,6 +23,7 @@ import System.Directory
 import System.IO
 import System.IO.Error
 import System.Environment
+import System.CPUTime
 import Control.Monad
 
 putShow' :: Show a => (c -> a) -> c -> IO ()
diff --git a/src/GF/GFCC/API.hs b/src/GF/GFCC/API.hs
index 2abd0e09b..093d13b97 100644
--- a/src/GF/GFCC/API.hs
+++ b/src/GF/GFCC/API.hs
@@ -112,6 +112,11 @@ readTree _ = pTree
 
 showTree = prExp
 
+prIdent :: CId -> String
+prIdent (CId s) = s
+
+abstractName mgr = prIdent (absname (gfcc mgr))
+
 languages mgr = [l | CId l <- cncnames (gfcc mgr)]
 
 categories mgr = [c | CId c <- Map.keys (cats (abstract (gfcc mgr)))]