mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-31 21:58:54 -06:00
@@ -38,7 +38,6 @@ import GF.Server(server)
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
import GF.Command.Messages(welcome)
|
import GF.Command.Messages(welcome)
|
||||||
import GF.Infra.UseIO (Output)
|
|
||||||
-- Provides an orphan instance of MonadFail for StateT in ghc versions < 8
|
-- Provides an orphan instance of MonadFail for StateT in ghc versions < 8
|
||||||
import Control.Monad.Trans.Instances ()
|
import Control.Monad.Trans.Instances ()
|
||||||
|
|
||||||
@@ -56,6 +55,7 @@ mainGFI opts files = do
|
|||||||
|
|
||||||
shell opts files = flip evalStateT (emptyGFEnv opts) $
|
shell opts files = flip evalStateT (emptyGFEnv opts) $
|
||||||
do mapStateT runSIO $ importInEnv opts files
|
do mapStateT runSIO $ importInEnv opts files
|
||||||
|
modify $ \ gfenv0 -> gfenv0 {history = [unwords ("i":files)]}
|
||||||
loop
|
loop
|
||||||
|
|
||||||
#ifdef SERVER_MODE
|
#ifdef SERVER_MODE
|
||||||
|
|||||||
@@ -58,6 +58,7 @@ mainGFI opts files = do
|
|||||||
|
|
||||||
shell opts files = flip evalStateT (emptyGFEnv opts) $
|
shell opts files = flip evalStateT (emptyGFEnv opts) $
|
||||||
do mapStateT runSIO $ importInEnv opts files
|
do mapStateT runSIO $ importInEnv opts files
|
||||||
|
modify $ \ gfenv0 -> gfenv0 {history = [unwords ("i":files)]}
|
||||||
loop
|
loop
|
||||||
|
|
||||||
{-
|
{-
|
||||||
@@ -101,7 +102,7 @@ timeIt act =
|
|||||||
|
|
||||||
-- | Optionally show how much CPU time was used to run an IO action
|
-- | Optionally show how much CPU time was used to run an IO action
|
||||||
optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
|
optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
|
||||||
optionallyShowCPUTime opts act
|
optionallyShowCPUTime opts act
|
||||||
| not (verbAtLeast opts Normal) = act
|
| not (verbAtLeast opts Normal) = act
|
||||||
| otherwise = do (dt,r) <- timeIt act
|
| otherwise = do (dt,r) <- timeIt act
|
||||||
liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
|
liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
|
||||||
@@ -358,7 +359,7 @@ wordCompletion gfenv (left,right) = do
|
|||||||
CmplIdent _ pref
|
CmplIdent _ pref
|
||||||
-> case mb_pgf of
|
-> case mb_pgf of
|
||||||
Just pgf -> ret (length pref)
|
Just pgf -> ret (length pref)
|
||||||
[Haskeline.simpleCompletion name
|
[Haskeline.simpleCompletion name
|
||||||
| name <- C.functions pgf,
|
| name <- C.functions pgf,
|
||||||
isPrefixOf pref name]
|
isPrefixOf pref name]
|
||||||
_ -> ret (length pref) []
|
_ -> ret (length pref) []
|
||||||
@@ -369,7 +370,7 @@ wordCompletion gfenv (left,right) = do
|
|||||||
cmdEnv = commandenv gfenv
|
cmdEnv = commandenv gfenv
|
||||||
{-
|
{-
|
||||||
optLang opts = valStrOpts "lang" (head $ Map.keys (concretes cmdEnv)) opts
|
optLang opts = valStrOpts "lang" (head $ Map.keys (concretes cmdEnv)) opts
|
||||||
optType opts =
|
optType opts =
|
||||||
let str = valStrOpts "cat" (H.showCId $ H.lookStartCat pgf) opts
|
let str = valStrOpts "cat" (H.showCId $ H.lookStartCat pgf) opts
|
||||||
in case H.readType str of
|
in case H.readType str of
|
||||||
Just ty -> ty
|
Just ty -> ty
|
||||||
@@ -416,7 +417,7 @@ wc_type = cmd_name
|
|||||||
option x y (c :cs)
|
option x y (c :cs)
|
||||||
| isIdent c = option x y cs
|
| isIdent c = option x y cs
|
||||||
| otherwise = cmd x cs
|
| otherwise = cmd x cs
|
||||||
|
|
||||||
optValue x y ('"':cs) = str x y cs
|
optValue x y ('"':cs) = str x y cs
|
||||||
optValue x y cs = cmd x cs
|
optValue x y cs = cmd x cs
|
||||||
|
|
||||||
@@ -434,7 +435,7 @@ wc_type = cmd_name
|
|||||||
where
|
where
|
||||||
x1 = take (length x - length y - d) x
|
x1 = take (length x - length y - d) x
|
||||||
x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
|
x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
|
||||||
|
|
||||||
cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
|
cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
|
||||||
[x] -> Just x
|
[x] -> Just x
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|||||||
@@ -16,18 +16,19 @@ import Data.Version
|
|||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import GF.System.Console (setConsoleEncoding)
|
-- import GF.System.Console (setConsoleEncoding)
|
||||||
|
|
||||||
-- | Run the GF main program, taking arguments from the command line.
|
-- | Run the GF main program, taking arguments from the command line.
|
||||||
-- (It calls 'setConsoleEncoding' and 'getOptions', then 'mainOpts'.)
|
-- (It calls 'setConsoleEncoding' and 'getOptions', then 'mainOpts'.)
|
||||||
-- Run @gf --help@ for usage info.
|
-- Run @gf --help@ for usage info.
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
--setConsoleEncoding
|
-- setConsoleEncoding
|
||||||
uncurry mainOpts =<< getOptions
|
uncurry mainOpts =<< getOptions
|
||||||
|
|
||||||
-- | Get and parse GF command line arguments. Fix relative paths.
|
-- | Get and parse GF command line arguments. Fix relative paths.
|
||||||
-- Calls 'getArgs' and 'parseOptions'.
|
-- Calls 'getArgs' and 'parseOptions'.
|
||||||
|
getOptions :: IO (Options, [FilePath])
|
||||||
getOptions = do
|
getOptions = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
case parseOptions args of
|
case parseOptions args of
|
||||||
@@ -43,7 +44,7 @@ getOptions = do
|
|||||||
-- the options it invokes 'mainGFC', 'mainGFI', 'mainRunGFI', 'mainServerGFI',
|
-- the options it invokes 'mainGFC', 'mainGFI', 'mainRunGFI', 'mainServerGFI',
|
||||||
-- or it just prints version/usage info.
|
-- or it just prints version/usage info.
|
||||||
mainOpts :: Options -> [FilePath] -> IO ()
|
mainOpts :: Options -> [FilePath] -> IO ()
|
||||||
mainOpts opts files =
|
mainOpts opts files =
|
||||||
case flag optMode opts of
|
case flag optMode opts of
|
||||||
ModeVersion -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ buildInfo
|
ModeVersion -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ buildInfo
|
||||||
ModeHelp -> putStrLn helpMessage
|
ModeHelp -> putStrLn helpMessage
|
||||||
|
|||||||
Reference in New Issue
Block a user