forked from GitHub/gf-core
ab3cc77656
This patch fixes a problem introduced last year when the GF shell was
refactored to allow more commands to be treated uniformly and be part
of pipes. The cc command was one of those commands, but unfortunately this
introduced a parsing problem, e.g.
> cc "last"
constant not found: last
> cc "last"++"year"
command not parsed: cc "last"++"year"
This happened because the generic command line parser in
GF.Command.{Abstract,Parse} assumes that all commands have an argument of
type PGF.Expr. Commands that expect other types of arguments have to
use PGF.showExpr combined with other conversion to the argument type they
expect. The cc command excpets a GF.Grammar.Term, and unfortunately not
all terms survice the roundtrip through PGF.Expr, in part because of
an additional hack to allow strings to be roundtripped through PGF.Expr
without adding superfluous double quotes.
To solve the problem, this patch
+ makes room for arguments of type Term in the Argument type in
GF.Command.Abstract.
+ makes a special case for the cc command in GF.Command.Parse, by
calling the partial parser 'runPartial pTerm' recently added in
GF.Grammar.Lexer and GF.Grammar.Parser. Care was taken so that
that "|" and ";" can be used both inside terms and as separators between
commands in the shell, e.g. things like the following now work:
> cc ("a"|"b") | ps -lexcode
variants { "a" ; "b" }
+ introduces a type CommandArgument that replaces [Expr] as the
type of values passed between commands in pipes. It has room for
values of type [Expr], [String] and Term, thus eliminating the need
to roundtrip through the Expr type all the time.
The hack to avoid adding superfluous quotes when strings are
roundtripped through Expr has been left in place for now,
but can probably be removed.
114 lines
3.7 KiB
Haskell
114 lines
3.7 KiB
Haskell
module GF.Command.Interpreter (
|
|
CommandEnv(..),mkCommandEnv,
|
|
interpretCommandLine,
|
|
getCommandOp
|
|
) where
|
|
import GF.Command.CommandInfo
|
|
import GF.Command.Abstract
|
|
import GF.Command.Parse
|
|
import PGF.Internal(Expr(..))
|
|
import GF.Infra.UseIO(putStrLnE)
|
|
|
|
import Control.Monad(when)
|
|
import qualified Data.Map as Map
|
|
|
|
data CommandEnv m = CommandEnv {
|
|
commands :: Map.Map String (CommandInfo m),
|
|
commandmacros :: Map.Map String CommandLine,
|
|
expmacros :: Map.Map String Expr
|
|
}
|
|
|
|
--mkCommandEnv :: PGFEnv -> CommandEnv
|
|
mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty
|
|
|
|
--interpretCommandLine :: CommandEnv -> String -> SIO ()
|
|
interpretCommandLine env line =
|
|
case readCommandLine line of
|
|
Just [] -> return ()
|
|
Just pipes -> mapM_ (interpretPipe env) pipes
|
|
Nothing -> putStrLnE $ "command not parsed: "++line
|
|
|
|
interpretPipe env cs = do
|
|
Piped v@(_,s) <- intercs cs void
|
|
putStrLnE s
|
|
return ()
|
|
where
|
|
intercs [] args = return args
|
|
intercs (c:cs) (Piped (args,_)) = interc c args >>= intercs cs
|
|
|
|
interc comm@(Command co opts arg) args =
|
|
case co of
|
|
'%':f -> case Map.lookup f (commandmacros env) of
|
|
Just css ->
|
|
do args <- getCommandTrees env False arg args
|
|
mapM_ (interpretPipe env) (appLine args css)
|
|
return void
|
|
Nothing -> do
|
|
putStrLnE $ "command macro " ++ co ++ " not interpreted"
|
|
return void
|
|
_ -> interpret env args comm
|
|
|
|
appLine = map . map . appCommand
|
|
|
|
-- | macro definition applications: replace ?i by (exps !! i)
|
|
appCommand :: CommandArguments -> Command -> Command
|
|
appCommand args c@(Command i os arg) = case arg of
|
|
AExpr e -> Command i os (AExpr (app e))
|
|
_ -> c
|
|
where
|
|
xs = toExprs args
|
|
|
|
app e = case e of
|
|
EAbs b x e -> EAbs b x (app e)
|
|
EApp e1 e2 -> EApp (app e1) (app e2)
|
|
ELit l -> ELit l
|
|
EMeta i -> xs !! i
|
|
EFun x -> EFun x
|
|
|
|
-- | return the trees to be sent in pipe, and the output possibly printed
|
|
--interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
|
|
interpret env trees comm =
|
|
do (info,opts,trees) <- getCommand env trees comm
|
|
tss@(Piped (_,s)) <- exec info opts trees
|
|
when (isOpt "tr" opts) $ putStrLnE 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 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 PGFEnv)
|
|
getCommandInfo env cmd =
|
|
case Map.lookup (getCommandOp cmd) (commands env) of
|
|
Just info -> return info
|
|
Nothing -> fail $ "command not found: " ++ cmd
|
|
|
|
--checkOpts :: CommandInfo env -> [Option] -> Either String ()
|
|
checkOpts info opts =
|
|
case
|
|
[o | OOpt o <- opts, notElem o ("tr" : map fst (options info))] ++
|
|
[o | OFlag o _ <- opts, notElem o (map fst (flags info))]
|
|
of
|
|
[] -> return ()
|
|
[o] -> fail $ "option not interpreted: " ++ o
|
|
os -> fail $ "options not interpreted: " ++ unwords os
|
|
|
|
--getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr]
|
|
getCommandTrees env needsTypeCheck a args =
|
|
case a of
|
|
AMacro m -> case Map.lookup m (expmacros env) of
|
|
Just e -> one e
|
|
_ -> return (Exprs []) -- report error?
|
|
AExpr e -> if needsTypeCheck
|
|
then one =<< typeCheckArg e
|
|
else one e
|
|
ATerm t -> return (Term t)
|
|
ANoArg -> return args -- use piped
|
|
where
|
|
one e = return (Exprs [e]) -- ignore piped
|