gf-core/src-3.0/GFI.hs

module GFI (mainGFI) where

import GF.Command.Interpreter
import GF.Command.Importing
import GF.Command.Commands
import GF.GFCC.API

import GF.Infra.UseIO
import GF.Infra.Option ---- Haskell's option lib
import GF.System.Readline (fetchCommand)

import System.CPUTime


mainGFI :: [String] -> IO ()
mainGFI xx = do
  putStrLn welcome
  env <- importInEnv emptyMultiGrammar xx
  loop (GFEnv env [] 0)
  return ()

loop :: GFEnv -> IO GFEnv
loop gfenv0 = do
  let env = commandenv gfenv0
  s <- fetchCommand (prompt env)
  let gfenv = gfenv0 {history = s : history gfenv0}
  case words s of

  -- special commands, working on GFEnv
    "i":args -> do
      env1 <- importInEnv (multigrammar env) args
      loopNewCPU $ gfenv {commandenv = env1}
    "e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyMultiGrammar}}
    "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv
    "q":_  -> putStrLn "See you." >> return gfenv

  -- ordinary commands, working on CommandEnv
    _ -> do
      interpretCommandLine env s
      loopNewCPU gfenv

loopNewCPU gfenv = do
  cpu' <- getCPUTime
  putStrLn (show ((cpu' - cputime gfenv) `div` 1000000000) ++ " msec")
  loop $ gfenv {cputime = cpu'}

importInEnv mgr0 xx = do
  let (opts,files) = getOptions "-" xx
  mgr1 <- case files of
    [] -> return mgr0
    _  -> importGrammar mgr0 opts files
  let env = CommandEnv mgr1 (allCommands mgr1)
  putStrLn $ unwords $ "\nLanguages:" : languages mgr1
  return env

welcome = unlines [
  "                              ",
  "         *  *  *              ",
  "      *           *           ",
  "    *               *         ",
  "   *                          ",
  "   *                          ",
  "   *        * * * * * *       ",
  "   *        *         *       ",
  "    *       * * * *  *        ",
  "      *     *      *          ",
  "         *  *  *              ",
  "                              ",
  "This is GF version 3.0 alpha. ",
  "Some things may work.         "
  ]

prompt env = absname ++ "> " where
  absname = case abstractName (multigrammar env) of
    "_" -> ""  --- created by new Ident handling 22/5/2008
    n   -> n

data GFEnv = GFEnv {
  commandenv :: CommandEnv,
  history    :: [String],
  cputime    :: Integer
  }