forked from GitHub/gf-core
prompt and CPU time in experimental shell
This commit is contained in:
@@ -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
|
||||
}
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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)))]
|
||||
|
||||
Reference in New Issue
Block a user