mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Refactor GF shell modules to improve modularity and reusability
+ Move type CommandInfo from GF.Command.Commands to a new module GF.Commands.CommandInfo and make it independent of the PGF type. + Make the module GF.Command.Interpreter independent of the PGF type and eliminate the import of GF.Command.Commands. + Move the implementation of the "help" command to its own module GF.Command.Help
This commit is contained in:
hallgren
2
gf.cabal
2
gf.cabal
@@ -161,7 +161,9 @@ Library
|
||||
|
||||
DarcsVersion_gf
|
||||
GF.Command.Abstract
|
||||
GF.Command.CommandInfo
|
||||
GF.Command.Commands
|
||||
GF.Command.Help
|
||||
GF.Command.Importing
|
||||
GF.Command.Interpreter
|
||||
GF.Command.Messages
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
module GF.Command.Abstract where
|
||||
module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr) where
|
||||
|
||||
import PGF(CId,mkCId,Expr)
|
||||
import PGF(CId,mkCId,Expr,showExpr)
|
||||
|
||||
type Ident = String
|
||||
|
||||
|
||||
57
src/compiler/GF/Command/CommandInfo.hs
Normal file
57
src/compiler/GF/Command/CommandInfo.hs
Normal file
@@ -0,0 +1,57 @@
|
||||
module GF.Command.CommandInfo where
|
||||
import GF.Command.Abstract(Option,Expr)
|
||||
import GF.Infra.SIO(SIO)
|
||||
import qualified PGF as H(showExpr)
|
||||
import qualified PGF.Internal as H(Literal(LStr),Expr(ELit)) ----
|
||||
import GF.Text.Pretty(Doc)
|
||||
|
||||
data CommandInfo env = CommandInfo {
|
||||
exec :: env -> [Option] -> [Expr] -> SIO CommandOutput,
|
||||
synopsis :: String,
|
||||
syntax :: String,
|
||||
explanation :: String,
|
||||
longname :: String,
|
||||
options :: [(String,String)],
|
||||
flags :: [(String,String)],
|
||||
examples :: [(String,String)],
|
||||
needsTypeCheck :: Bool
|
||||
}
|
||||
|
||||
emptyCommandInfo :: CommandInfo env
|
||||
emptyCommandInfo = CommandInfo {
|
||||
exec = \_ _ ts -> return $ pipeExprs ts, ----
|
||||
synopsis = "",
|
||||
syntax = "",
|
||||
explanation = "",
|
||||
longname = "",
|
||||
options = [],
|
||||
flags = [],
|
||||
examples = [],
|
||||
needsTypeCheck = True
|
||||
}
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class TypeCheckArg env where typeCheckArg :: env -> Expr -> Either Doc Expr
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
newtype CommandOutput = Piped {fromPipe :: ([Expr],String)} ---- errors, etc
|
||||
|
||||
-- ** Converting command output
|
||||
fromStrings ss = Piped (map stringAsExpr ss, unlines ss)
|
||||
fromExprs es = Piped (es,unlines (map (H.showExpr []) es))
|
||||
fromString s = Piped ([stringAsExpr s], s)
|
||||
pipeWithMessage es msg = Piped (es,msg)
|
||||
pipeMessage msg = Piped ([],msg)
|
||||
pipeExprs es = Piped (es,[]) -- only used in emptyCommandInfo
|
||||
void = Piped ([],"")
|
||||
|
||||
stringAsExpr = H.ELit . H.LStr -- should be a pattern macro
|
||||
|
||||
-- ** Converting command input
|
||||
toString = unwords . toStrings
|
||||
toStrings = map showAsString
|
||||
where
|
||||
showAsString t = case t of
|
||||
H.ELit (H.LStr s) -> s
|
||||
_ -> "\n" ++ H.showExpr [] t ---newline needed in other cases than the first
|
||||
@@ -1,21 +1,14 @@
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
{-# LANGUAGE PatternGuards, TypeSynonymInstances, FlexibleInstances #-}
|
||||
module GF.Command.Commands (
|
||||
allCommands,
|
||||
lookCommand,
|
||||
exec,
|
||||
isOpt,
|
||||
options,
|
||||
flags,
|
||||
needsTypeCheck,
|
||||
CommandInfo,
|
||||
CommandOutput(..),void
|
||||
PGFEnv,pgfEnv,allCommands,
|
||||
options,flags,
|
||||
) where
|
||||
import Prelude hiding (putStrLn)
|
||||
|
||||
import PGF
|
||||
|
||||
import PGF.Internal(lookStartCat,functionsToCat,lookValCat,restrictPGF,hasLin)
|
||||
import PGF.Internal(abstract,funs,cats,Literal(LStr),Expr(EFun,ELit)) ----
|
||||
import PGF.Internal(abstract,funs,cats,Expr(EFun)) ----
|
||||
--import PGF.Morphology(isInMorpho,morphoKnown)
|
||||
import PGF.Internal(ppFun,ppCat)
|
||||
--import PGF.Probabilistic(rankTreesByProbs,probTree,setProbabilities)
|
||||
@@ -31,7 +24,9 @@ import GF.Infra.UseIO(writeUTF8File)
|
||||
import GF.Infra.SIO
|
||||
--import GF.Data.ErrM ----
|
||||
import GF.Command.Abstract
|
||||
import GF.Command.Messages
|
||||
--import GF.Command.Messages
|
||||
import GF.Command.CommandInfo
|
||||
import GF.Command.Help
|
||||
import GF.Text.Lexing
|
||||
import GF.Text.Clitics
|
||||
import GF.Text.Transliterations
|
||||
@@ -55,113 +50,14 @@ import Data.List (sort)
|
||||
|
||||
type PGFEnv = (PGF, Map.Map Language Morpho)
|
||||
|
||||
data CommandInfo = CommandInfo {
|
||||
exec :: PGFEnv -> [Option] -> [Expr] -> SIO CommandOutput,
|
||||
synopsis :: String,
|
||||
syntax :: String,
|
||||
explanation :: String,
|
||||
longname :: String,
|
||||
options :: [(String,String)],
|
||||
flags :: [(String,String)],
|
||||
examples :: [(String,String)],
|
||||
needsTypeCheck :: Bool
|
||||
}
|
||||
pgfEnv pgf = (pgf,mos)
|
||||
where mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
newtype CommandOutput = Piped {fromPipe :: ([Expr],String)} ---- errors, etc
|
||||
|
||||
-- Converting command output:
|
||||
fromStrings ss = Piped (map (ELit . LStr) ss, unlines ss)
|
||||
fromExprs es = Piped (es,unlines (map (showExpr []) es))
|
||||
fromString s = Piped ([ELit (LStr s)], s)
|
||||
pipeWithMessage es msg = Piped (es,msg)
|
||||
pipeMessage msg = Piped ([],msg)
|
||||
pipeExprs es = Piped (es,[]) -- only used in emptyCommandInfo
|
||||
void = Piped ([],"")
|
||||
|
||||
-- Converting command input:
|
||||
toString = unwords . toStrings
|
||||
toStrings = map showAsString
|
||||
where
|
||||
showAsString t = case t of
|
||||
ELit (LStr s) -> s
|
||||
_ -> "\n" ++ showExpr [] t ---newline needed in other cases than the first
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
emptyCommandInfo :: CommandInfo
|
||||
emptyCommandInfo = CommandInfo {
|
||||
exec = \_ _ ts -> return $ pipeExprs ts, ----
|
||||
synopsis = "",
|
||||
syntax = "",
|
||||
explanation = "",
|
||||
longname = "",
|
||||
options = [],
|
||||
flags = [],
|
||||
examples = [],
|
||||
needsTypeCheck = True
|
||||
}
|
||||
|
||||
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
|
||||
lookCommand = Map.lookup
|
||||
|
||||
commandHelpAll :: [Option] -> String
|
||||
commandHelpAll opts = unlines $
|
||||
commandHelp' opts (isOpt "full" opts) `map` Map.toList allCommands
|
||||
|
||||
commandHelp' opts = if isOpt "t2t" opts then commandHelpTags else commandHelp
|
||||
|
||||
commandHelp :: Bool -> (String,CommandInfo) -> String
|
||||
commandHelp full (co,info) = unlines . compact $ [
|
||||
co ++ optionally (", " ++) (longname info),
|
||||
synopsis info] ++ if full then [
|
||||
"",
|
||||
optionally (("syntax:" ++++).(" "++).(++"\n")) (syntax info),
|
||||
explanation info,
|
||||
section "options:" [" -" ++ o ++ "\t" ++ e | (o,e) <- options info],
|
||||
section "flags:" [" -" ++ o ++ "\t" ++ e | (o,e) <- flags info],
|
||||
section "examples:" [" " ++ o ++ "\t--" ++ e | (o,e) <- examples info]
|
||||
] else []
|
||||
|
||||
-- for printing with txt2tags formatting
|
||||
|
||||
commandHelpTags :: Bool -> (String,CommandInfo) -> String
|
||||
commandHelpTags full (co,info) = unlines . compact $ [
|
||||
"#VSPACE","",
|
||||
"===="++hdrname++"====",
|
||||
"#NOINDENT",
|
||||
name ++ ": " ++
|
||||
"//" ++ synopsis info ++ ".//"] ++ if full then [
|
||||
"","#TINY","",
|
||||
explanation info,
|
||||
optionally ("- Syntax: "++) (lit (syntax info)),
|
||||
section "- Options:\n" [" | ``-" ++ o ++ "`` | " ++ e | (o,e) <- options info],
|
||||
section "- Flags:\n" [" | ``-" ++ o ++ "`` | " ++ e | (o,e) <- flags info],
|
||||
section "- Examples:\n" [" | ``" ++ o ++ "`` | " ++ e | (o,e) <- examples info],
|
||||
"", "#NORMAL", ""
|
||||
] else []
|
||||
where
|
||||
hdrname = co ++ equal (longname info)
|
||||
name = lit co ++ equal (lit (longname info))
|
||||
|
||||
lit = optionally (wrap "``")
|
||||
equal = optionally (" = "++)
|
||||
-- verbatim = optionally (wrap ["```"])
|
||||
wrap d s = d++s++d
|
||||
|
||||
section hdr = optionally ((hdr++++).unlines)
|
||||
|
||||
optionally f [] = []
|
||||
optionally f s = f s
|
||||
|
||||
compact [] = []
|
||||
compact ([]:xs@([]:_)) = compact xs
|
||||
compact (x:xs) = x:compact xs
|
||||
|
||||
mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))
|
||||
instance TypeCheckArg PGFEnv where
|
||||
typeCheckArg (pgf,_) = either (Left . ppTcError) (Right . fst) . inferExpr pgf
|
||||
|
||||
-- this list must no more be kept sorted by the command name
|
||||
allCommands :: Map.Map String CommandInfo
|
||||
allCommands :: Map.Map String (CommandInfo PGFEnv)
|
||||
allCommands = Map.fromList [
|
||||
("!", emptyCommandInfo {
|
||||
synopsis = "system command: escape to system shell",
|
||||
@@ -440,35 +336,7 @@ allCommands = Map.fromList [
|
||||
Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)
|
||||
returnFromExprs $ take (optNumInf opts) ts
|
||||
}),
|
||||
("h", emptyCommandInfo {
|
||||
longname = "help",
|
||||
syntax = "h (-full)? COMMAND?",
|
||||
synopsis = "get description of a command, or a the full list of commands",
|
||||
explanation = unlines [
|
||||
"Displays information concerning the COMMAND.",
|
||||
"Without argument, shows the synopsis of all commands."
|
||||
],
|
||||
options = [
|
||||
("changes","give a summary of changes from GF 2.9"),
|
||||
("coding","give advice on character encoding"),
|
||||
("full","give full information of the commands"),
|
||||
("license","show copyright and license information"),
|
||||
("t2t","output help in txt2tags format")
|
||||
],
|
||||
exec = \_ opts ts ->
|
||||
let
|
||||
msg = case ts of
|
||||
_ | isOpt "changes" opts -> changesMsg
|
||||
_ | isOpt "coding" opts -> codingMsg
|
||||
_ | isOpt "license" opts -> licenseMsg
|
||||
[t] -> let co = getCommandOp (showExpr [] t) in
|
||||
case lookCommand co allCommands of
|
||||
Just info -> commandHelp' opts True (co,info)
|
||||
_ -> "command not found"
|
||||
_ -> commandHelpAll opts
|
||||
in return (fromString msg),
|
||||
needsTypeCheck = False
|
||||
}),
|
||||
helpCommand allCommands,
|
||||
("i", emptyCommandInfo {
|
||||
longname = "import",
|
||||
synopsis = "import a grammar from source code or compiled .pgf file",
|
||||
|
||||
93
src/compiler/GF/Command/Help.hs
Normal file
93
src/compiler/GF/Command/Help.hs
Normal file
@@ -0,0 +1,93 @@
|
||||
module GF.Command.Help where
|
||||
import GF.Command.Messages
|
||||
import GF.Command.Abstract(isOpt,getCommandOp,showExpr)
|
||||
import GF.Command.CommandInfo
|
||||
|
||||
import GF.Data.Operations((++++))
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
||||
commandHelpAll' allCommands opts = unlines $
|
||||
commandHelp' opts (isOpt "full" opts) `map` Map.toList allCommands
|
||||
|
||||
commandHelp' opts = if isOpt "t2t" opts then commandHelpTags else commandHelp
|
||||
|
||||
commandHelp :: Bool -> (String,CommandInfo env) -> String
|
||||
commandHelp full (co,info) = unlines . compact $ [
|
||||
co ++ optionally (", " ++) (longname info),
|
||||
synopsis info] ++ if full then [
|
||||
"",
|
||||
optionally (("syntax:" ++++).(" "++).(++"\n")) (syntax info),
|
||||
explanation info,
|
||||
section "options:" [" -" ++ o ++ "\t" ++ e | (o,e) <- options info],
|
||||
section "flags:" [" -" ++ o ++ "\t" ++ e | (o,e) <- flags info],
|
||||
section "examples:" [" " ++ o ++ "\t--" ++ e | (o,e) <- examples info]
|
||||
] else []
|
||||
|
||||
-- for printing with txt2tags formatting
|
||||
|
||||
commandHelpTags :: Bool -> (String,CommandInfo env) -> String
|
||||
commandHelpTags full (co,info) = unlines . compact $ [
|
||||
"#VSPACE","",
|
||||
"===="++hdrname++"====",
|
||||
"#NOINDENT",
|
||||
name ++ ": " ++
|
||||
"//" ++ synopsis info ++ ".//"] ++ if full then [
|
||||
"","#TINY","",
|
||||
explanation info,
|
||||
optionally ("- Syntax: "++) (lit (syntax info)),
|
||||
section "- Options:\n" [" | ``-" ++ o ++ "`` | " ++ e | (o,e) <- options info],
|
||||
section "- Flags:\n" [" | ``-" ++ o ++ "`` | " ++ e | (o,e) <- flags info],
|
||||
section "- Examples:\n" [" | ``" ++ o ++ "`` | " ++ e | (o,e) <- examples info],
|
||||
"", "#NORMAL", ""
|
||||
] else []
|
||||
where
|
||||
hdrname = co ++ equal (longname info)
|
||||
name = lit co ++ equal (lit (longname info))
|
||||
|
||||
lit = optionally (wrap "``")
|
||||
equal = optionally (" = "++)
|
||||
-- verbatim = optionally (wrap ["```"])
|
||||
wrap d s = d++s++d
|
||||
|
||||
section hdr = optionally ((hdr++++).unlines)
|
||||
|
||||
optionally f [] = []
|
||||
optionally f s = f s
|
||||
|
||||
compact [] = []
|
||||
compact ([]:xs@([]:_)) = compact xs
|
||||
compact (x:xs) = x:compact xs
|
||||
|
||||
mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))
|
||||
|
||||
helpCommand allCommands =
|
||||
("h", emptyCommandInfo {
|
||||
longname = "help",
|
||||
syntax = "h (-full)? COMMAND?",
|
||||
synopsis = "get description of a command, or a the full list of commands",
|
||||
explanation = unlines [
|
||||
"Displays information concerning the COMMAND.",
|
||||
"Without argument, shows the synopsis of all commands."
|
||||
],
|
||||
options = [
|
||||
("changes","give a summary of changes from GF 2.9"),
|
||||
("coding","give advice on character encoding"),
|
||||
("full","give full information of the commands"),
|
||||
("license","show copyright and license information"),
|
||||
("t2t","output help in txt2tags format")
|
||||
],
|
||||
exec = \_ opts ts ->
|
||||
let
|
||||
msg = case ts of
|
||||
_ | isOpt "changes" opts -> changesMsg
|
||||
_ | isOpt "coding" opts -> codingMsg
|
||||
_ | isOpt "license" opts -> licenseMsg
|
||||
[t] -> let co = getCommandOp (showExpr [] t) in
|
||||
case Map.lookup co allCommands of
|
||||
Just info -> commandHelp' opts True (co,info)
|
||||
_ -> "command not found"
|
||||
_ -> commandHelpAll' allCommands opts
|
||||
in return (fromString msg),
|
||||
needsTypeCheck = False
|
||||
})
|
||||
@@ -1,44 +1,37 @@
|
||||
module GF.Command.Interpreter (
|
||||
CommandEnv,commands,multigrammar,commandmacros,expmacros,
|
||||
CommandEnv,pgfenv,commands,commandmacros,expmacros,
|
||||
mkCommandEnv,
|
||||
emptyCommandEnv,
|
||||
--emptyCommandEnv,
|
||||
interpretCommandLine,
|
||||
interpretPipe,
|
||||
--interpretPipe,
|
||||
getCommandOp
|
||||
) where
|
||||
import Prelude hiding (putStrLn)
|
||||
|
||||
import GF.Command.Commands
|
||||
import GF.Command.CommandInfo
|
||||
import GF.Command.Abstract
|
||||
import GF.Command.Parse
|
||||
import PGF
|
||||
import PGF.Internal
|
||||
--import PGF
|
||||
import PGF.Internal(Expr(..))
|
||||
--import PGF.Morphology
|
||||
import GF.Infra.SIO
|
||||
import GF.Infra.SIO(putStrLn,putStrLnFlush)
|
||||
|
||||
import GF.Text.Pretty
|
||||
import GF.Text.Pretty(render)
|
||||
import Control.Monad(when)
|
||||
--import Control.Monad.Error()
|
||||
import qualified Data.Map as Map
|
||||
|
||||
data CommandEnv = CommandEnv {
|
||||
multigrammar :: PGF,
|
||||
morphos :: Map.Map Language Morpho,
|
||||
--commands :: Map.Map String CommandInfo,
|
||||
data CommandEnv env = CommandEnv {
|
||||
pgfenv :: env,
|
||||
commands :: Map.Map String (CommandInfo env),
|
||||
commandmacros :: Map.Map String CommandLine,
|
||||
expmacros :: Map.Map String Expr
|
||||
}
|
||||
commands _ = allCommands
|
||||
|
||||
mkCommandEnv :: PGF -> CommandEnv
|
||||
mkCommandEnv pgf =
|
||||
let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in
|
||||
CommandEnv pgf mos {-allCommands-} Map.empty Map.empty
|
||||
--mkCommandEnv :: PGFEnv -> CommandEnv
|
||||
mkCommandEnv env cmds = CommandEnv env cmds Map.empty Map.empty
|
||||
|
||||
emptyCommandEnv :: CommandEnv
|
||||
emptyCommandEnv = mkCommandEnv emptyPGF
|
||||
|
||||
interpretCommandLine :: CommandEnv -> String -> SIO ()
|
||||
--interpretCommandLine :: CommandEnv -> String -> SIO ()
|
||||
interpretCommandLine env line =
|
||||
case readCommandLine line of
|
||||
Just [] -> return ()
|
||||
@@ -48,7 +41,7 @@ interpretCommandLine env line =
|
||||
interpretPipe env cs = do
|
||||
Piped v@(_,s) <- intercs void cs
|
||||
putStrLnFlush s
|
||||
return v
|
||||
return ()
|
||||
where
|
||||
intercs treess [] = return treess
|
||||
intercs (Piped (trees,_)) (c:cs) = do
|
||||
@@ -82,32 +75,32 @@ appCommand xs c@(Command i os arg) = case arg of
|
||||
EFun x -> EFun x
|
||||
|
||||
-- return the trees to be sent in pipe, and the output possibly printed
|
||||
interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
|
||||
--interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
|
||||
interpret env trees comm =
|
||||
case getCommand env trees comm of
|
||||
Left msg -> do putStrLn ('\n':msg)
|
||||
return void
|
||||
Right (info,opts,trees) -> do let cmdenv = (multigrammar env,morphos env)
|
||||
Right (info,opts,trees) -> do let cmdenv = pgfenv env
|
||||
tss@(Piped (_,s)) <- exec info cmdenv opts trees
|
||||
when (isOpt "tr" opts) $ putStrLn s
|
||||
return tss
|
||||
|
||||
-- analyse command parse tree to a uniform datastructure, normalizing comm name
|
||||
--- the env is needed for macro lookup
|
||||
getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo,[Option],[Expr])
|
||||
--getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo PGFEnv,[Option],[Expr])
|
||||
getCommand env es co@(Command c opts arg) = do
|
||||
info <- getCommandInfo env c
|
||||
checkOpts info opts
|
||||
es <- getCommandTrees env (needsTypeCheck info) arg es
|
||||
return (info,opts,es)
|
||||
|
||||
getCommandInfo :: CommandEnv -> String -> Either String CommandInfo
|
||||
--getCommandInfo :: CommandEnv -> String -> Either String (CommandInfo PGFEnv)
|
||||
getCommandInfo env cmd =
|
||||
case lookCommand (getCommandOp cmd) (commands env) of
|
||||
case Map.lookup (getCommandOp cmd) (commands env) of
|
||||
Just info -> return info
|
||||
Nothing -> fail $ "command " ++ cmd ++ " not interpreted"
|
||||
Nothing -> fail $ "command not found: " ++ cmd
|
||||
|
||||
checkOpts :: CommandInfo -> [Option] -> Either String ()
|
||||
checkOpts :: CommandInfo env -> [Option] -> Either String ()
|
||||
checkOpts info opts =
|
||||
case
|
||||
[o | OOpt o <- opts, notElem o ("tr" : map fst (options info))] ++
|
||||
@@ -117,16 +110,16 @@ checkOpts info opts =
|
||||
[o] -> fail $ "option not interpreted: " ++ o
|
||||
os -> fail $ "options not interpreted: " ++ unwords os
|
||||
|
||||
getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr]
|
||||
--getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr]
|
||||
getCommandTrees env needsTypeCheck a es =
|
||||
case a of
|
||||
AMacro m -> case Map.lookup m (expmacros env) of
|
||||
Just e -> return [e]
|
||||
_ -> return []
|
||||
AExpr e -> if needsTypeCheck
|
||||
then case inferExpr (multigrammar env) e of
|
||||
Left tcErr -> fail $ render (ppTcError tcErr)
|
||||
Right (e,ty) -> return [e] -- ignore piped
|
||||
then case typeCheckArg (pgfenv env) e of
|
||||
Left tcErr -> fail $ render tcErr
|
||||
Right e -> return [e] -- ignore piped
|
||||
else return [e]
|
||||
ANoArg -> return es -- use piped
|
||||
|
||||
|
||||
@@ -3,9 +3,9 @@
|
||||
module GF.Interactive (mainGFI,mainRunGFI,mainServerGFI) where
|
||||
import Prelude hiding (putStrLn,print)
|
||||
import qualified Prelude as P(putStrLn)
|
||||
import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,emptyCommandEnv,interpretCommandLine)
|
||||
import GF.Command.Interpreter(CommandEnv(..),pgfenv,commands,mkCommandEnv,interpretCommandLine)
|
||||
--import GF.Command.Importing(importSource,importGrammar)
|
||||
import GF.Command.Commands(flags,options)
|
||||
import GF.Command.Commands(flags,options,PGFEnv,pgfEnv,allCommands)
|
||||
import GF.Command.Abstract
|
||||
import GF.Command.Parse(readCommandLine,pCommand)
|
||||
import GF.Data.Operations (Err(..),chunks,err,raise,done)
|
||||
@@ -29,7 +29,7 @@ import qualified System.Console.Haskeline as Haskeline
|
||||
--import GF.Compile.Coding(codeTerm)
|
||||
|
||||
import PGF
|
||||
import PGF.Internal(emptyPGF,abstract,funs,lookStartCat)
|
||||
import PGF.Internal(abstract,funs,lookStartCat,emptyPGF)
|
||||
|
||||
import Data.Char
|
||||
import Data.List(nub,isPrefixOf,isInfixOf,partition)
|
||||
@@ -357,10 +357,10 @@ importInEnv gfenv opts files
|
||||
do src <- importSource opts files
|
||||
pgf <- lazySIO importPGF -- duplicates some work, better to link src
|
||||
return $ gfenv {grammar = src, retain=True,
|
||||
commandenv = mkCommandEnv pgf}
|
||||
commandenv = commandEnv pgf }
|
||||
| otherwise =
|
||||
do pgf1 <- importPGF
|
||||
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
||||
return $ gfenv { commandenv = commandEnv pgf1 }
|
||||
where
|
||||
importPGF =
|
||||
do let opts' = addOptions (setOptimization OptCSE False) opts
|
||||
@@ -406,13 +406,16 @@ prompt env
|
||||
data GFEnv = GFEnv {
|
||||
grammar :: Grammar, -- gfo grammar -retain
|
||||
retain :: Bool, -- grammar was imported with -retain flag
|
||||
commandenv :: CommandEnv,
|
||||
commandenv :: CommandEnv PGFEnv,
|
||||
history :: [String]
|
||||
}
|
||||
|
||||
emptyGFEnv :: GFEnv
|
||||
emptyGFEnv =
|
||||
GFEnv emptyGrammar False (mkCommandEnv emptyPGF) [] {-0-}
|
||||
emptyGFEnv = GFEnv emptyGrammar False emptyCommandEnv [] {-0-}
|
||||
|
||||
commandEnv pgf = mkCommandEnv (pgfEnv pgf) allCommands
|
||||
emptyCommandEnv = commandEnv emptyPGF
|
||||
multigrammar = fst . pgfenv
|
||||
|
||||
wordCompletion gfenv (left,right) = do
|
||||
case wc_type (reverse left) of
|
||||
|
||||
Reference in New Issue
Block a user