diff options
Diffstat (limited to 'src/compiler/GF/Command/Commands2.hs')
| -rw-r--r-- | src/compiler/GF/Command/Commands2.hs | 232 |
1 files changed, 9 insertions, 223 deletions
diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs index 0c9315f1d..0bf8f62bc 100644 --- a/src/compiler/GF/Command/Commands2.hs +++ b/src/compiler/GF/Command/Commands2.hs @@ -26,7 +26,8 @@ import GF.Command.Abstract --import GF.Command.Messages import GF.Command.CommandInfo import GF.Command.Help -import GF.Text.Lexing +import GF.Command.CommonCommands +--import GF.Text.Lexing --import GF.Text.Clitics import GF.Text.Transliterations --import GF.Quiz @@ -42,7 +43,7 @@ import qualified Data.Map as Map --import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead! import GF.System.Process import GF.Text.Pretty -import Data.List (sort) +--import Data.List (sort) import Control.Monad(mplus) --import Debug.Trace --import System.Random (newStdGen) ---- @@ -57,25 +58,8 @@ instance TypeCheckArg PGFEnv where typeCheckArg env e = Right e -- no type checker available !! --- this list must no more be kept sorted by the command name allCommands :: Map.Map String (CommandInfo PGFEnv) -allCommands = Map.fromList [ - ("!", emptyCommandInfo { - synopsis = "system command: escape to system shell", - syntax = "! SYSTEMCOMMAND", - examples = [ - ("! ls *.gf", "list all GF files in the working directory") - ], - needsTypeCheck = False - }), - ("?", emptyCommandInfo { - synopsis = "system pipe: send value from previous command to a system command", - syntax = "? SYSTEMCOMMAND", - examples = [ - ("gt | l | ? wc", "generate, linearize, word-count") - ], - needsTypeCheck = False - }), +allCommands = extend commonCommands [ {- ("aw", emptyCommandInfo { longname = "align_words", @@ -182,20 +166,6 @@ allCommands = Map.fromList [ needsTypeCheck = False }), -} - ("dc", emptyCommandInfo { - longname = "define_command", - syntax = "dc IDENT COMMANDLINE", - synopsis = "define a command macro", - explanation = unlines [ - "Defines IDENT as macro for COMMANDLINE, until IDENT gets redefined.", - "A call of the command has the form %IDENT. The command may take an", - "argument, which in COMMANDLINE is marked as ?0. Both strings and", - "trees can be arguments. Currently at most one argument is possible.", - "This command must be a line of its own, and thus cannot be a part", - "of a pipe." - ], - needsTypeCheck = False - }), {- ("dg", emptyCommandInfo { longname = "dependency_graph", @@ -223,30 +193,6 @@ allCommands = Map.fromList [ needsTypeCheck = False }), -} - ("dt", emptyCommandInfo { - longname = "define_tree", - syntax = "dt IDENT (TREE | STRING | \"<\" COMMANDLINE)", - synopsis = "define a tree or string macro", - explanation = unlines [ - "Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.", - "The defining value can also come from a command, preceded by \"<\".", - "If the command gives many values, the first one is selected.", - "A use of the macro has the form %IDENT. Currently this use cannot be", - "a subtree of another tree. This command must be a line of its own", - "and thus cannot be a part of a pipe." - ], - examples = [ - mkEx ("dt ex \"hello world\" -- define ex as string"), - mkEx ("dt ex UseN man_N -- define ex as string"), - mkEx ("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"), - mkEx ("l -lang=LangSwe %ex | ps -to_utf8 -- linearize the tree ex") - ], - needsTypeCheck = False - }), - ("e", emptyCommandInfo { - longname = "empty", - synopsis = "empty the environment" - }), {- ("eb", emptyCommandInfo { longname = "example_based", @@ -525,7 +471,7 @@ allCommands = Map.fromList [ mkEx "p \"this fish is fresh\" | l -lang=Swe -- try parsing with all languages and translate the successful parses to Swedish" ], exec = needPGF $ \ env opts -> return . cParse env opts . toStrings - }), + }) {- ("p", emptyCommandInfo { longname = "parse", @@ -596,62 +542,6 @@ allCommands = Map.fromList [ ] }), -} - ("ph", emptyCommandInfo { - longname = "print_history", - synopsis = "print command history", - explanation = unlines [ - "Prints the commands issued during the GF session.", - "The result is readable by the eh command.", - "The result can be used as a script when starting GF." - ], - examples = [ - mkEx "ph | wf -file=foo.gfs -- save the history into a file" - ] - }), - ("ps", emptyCommandInfo { - longname = "put_string", - syntax = "ps OPT? STRING", - synopsis = "return a string, possibly processed with a function", - explanation = unlines [ - "Returns a string obtained from its argument string by applying", - "string processing functions in the order given in the command line", - "option list. Thus 'ps -f -g s' returns g (f s). Typical string processors", - "are lexers and unlexers, but also character encoding conversions are possible.", - "The unlexers preserve the division of their input to lines.", - "To see transliteration tables, use command ut." - ], - examples = [ - mkEx "l (EAdd 3 4) | ps -code -- linearize code-like output", - mkEx "ps -lexer=code | p -cat=Exp -- parse code-like input", - mkEx "gr -cat=QCl | l | ps -bind -- linearization output from LangFin", - mkEx "ps -to_devanagari \"A-p\" -- show Devanagari in UTF8 terminal", - mkEx "rf -file=Hin.gf | ps -env=quotes -to_devanagari -- convert translit to UTF8", - mkEx "rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic -- convert UTF8 to transliteration", - mkEx "ps -to=chinese.trans \"abc\" -- apply transliteration defined in file chinese.trans" - ], - exec = \_ opts x -> do - let (os,fs) = optsAndFlags opts - trans <- optTranslit opts - - if isOpt "lines" opts - then return $ fromStrings $ map (trans . stringOps (envFlag fs) (map prOpt os)) $ toStrings x - else return ((fromString . trans . stringOps (envFlag fs) (map prOpt os) . toString) x), - options = [ - ("lines","apply the operation separately to each input line, returning a list of lines") - ] ++ - stringOpOptions, - flags = [ - ("env","apply in this environment only"), - ("from","backward-apply transliteration defined in this file (format 'unicode translit' per line)"), - ("to", "forward-apply transliteration defined in this file") - ] - }), - ("tt", emptyCommandInfo { - longname = "to_trie", - syntax = "to_trie", - synopsis = "combine a list of trees into a trie", - exec = \ _ _ -> return . fromString . trie - }), {- ("pt", emptyCommandInfo { longname = "put_tree", @@ -673,14 +563,6 @@ allCommands = Map.fromList [ flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-} }), -} - ("q", emptyCommandInfo { - longname = "quit", - synopsis = "exit GF interpreter" - }), - ("r", emptyCommandInfo { - longname = "reload", - synopsis = "repeat the latest import command" - }), {- ("rf", emptyCommandInfo { longname = "read_file", @@ -797,37 +679,6 @@ allCommands = Map.fromList [ needsTypeCheck = False }), -} - ("se", emptyCommandInfo { - longname = "set_encoding", - synopsis = "set the encoding used in current terminal", - syntax = "se ID", - examples = [ - mkEx "se cp1251 -- set encoding to cp1521", - mkEx "se utf8 -- set encoding to utf8 (default)" - ], - needsTypeCheck = False - }), - ("sp", emptyCommandInfo { - longname = "system_pipe", - synopsis = "send argument to a system command", - syntax = "sp -command=\"SYSTEMCOMMAND\", alt. ? SYSTEMCOMMAND", - exec = \_ opts arg -> do - let syst = optComm opts -- ++ " " ++ tmpi - {- - let tmpi = "_tmpi" --- - let tmpo = "_tmpo" - restricted $ writeFile tmpi $ toString arg - restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo - fmap fromString $ restricted $ readFile tmpo, - -} - fmap fromString . restricted . readShellProcess syst $ toString arg, - flags = [ - ("command","the system command applied to the argument") - ], - examples = [ - mkEx "gt | l | ? wc -- generate trees, linearize, and count words" - ] - }), {- ("so", emptyCommandInfo { longname = "show_operations", @@ -875,15 +726,6 @@ allCommands = Map.fromList [ needsTypeCheck = False }), -} - ("ut", emptyCommandInfo { - longname = "unicode_table", - synopsis = "show a transliteration table for a unicode character set", - exec = \_ opts _ -> do - let t = concatMap prOpt (take 1 opts) - let out = maybe "no such transliteration" characterTable $ transliteration t - return $ fromString out, - options = transliterationPrintNames - }), {- ("vd", emptyCommandInfo { longname = "visualize_dependency", @@ -1045,20 +887,7 @@ allCommands = Map.fromList [ ] }), -} - ("wf", emptyCommandInfo { - longname = "write_file", - synopsis = "send string or tree to a file", - exec = \_ opts arg -> do - let file = valStrOpts "file" "_gftmp" opts - if isOpt "append" opts - then restricted $ appendFile file (toString arg) - else restricted $ writeUTF8File file (toString arg) - return void, - options = [ - ("append","append to file, instead of overwriting it") - ], - flags = [("file","the output filename")] - }){-, +{- ("ai", emptyCommandInfo { longname = "abstract_info", syntax = "ai IDENTIFIER or ai EXPR", @@ -1174,7 +1003,7 @@ allCommands = Map.fromList [ Just (cid,ts@(_:_)) -> H.mkApp (mk cid) (map t2m ts) _ -> t mk = H.mkCId . ("mk" ++) . H.showCId . H.lookValCat (H.abstract pgf) --} + unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ---- getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of @@ -1182,7 +1011,7 @@ allCommands = Map.fromList [ [(H.mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of Just le -> chunks ',' le _ -> [] -{- + commaList [] = [] commaList ws = concat $ head ws : map (", " ++) (tail ws) -} @@ -1317,42 +1146,12 @@ allCommands = Map.fromList [ _ -> Nothing -} -- ps -f -g s returns g (f s) - stringOps menv opts s = foldr (menvop . app) s (reverse opts) where - app f = maybe id id (stringOp f) - menvop op = maybe op (\ (b,e) -> opInEnv b e op) menv - - envFlag fs = case valStrOpts "env" "global" fs of - "quotes" -> Just ("\"","\"") - _ -> Nothing {- treeOps pgf opts s = foldr app s (reverse opts) where app (OOpt op) | Just (Left f) <- treeOp pgf op = f app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (H.mkCId x) app _ = id --} -stringOpOptions = sort $ [ - ("bind","bind tokens separated by Prelude.BIND, i.e. &+"), - ("chars","lexer that makes every non-space character a token"), - ("from_cp1251","decode from cp1251 (Cyrillic used in Bulgarian resource)"), - ("from_utf8","decode from utf8 (default)"), - ("lextext","text-like lexer"), - ("lexcode","code-like lexer"), - ("lexmixed","mixture of text and code, as in LaTeX (code between $...$, \\(...)\\, \\[...\\])"), - ("to_cp1251","encode to cp1251 (Cyrillic used in Bulgarian resource)"), - ("to_html","wrap in a html file with linebreaks"), - ("to_utf8","encode to utf8 (default)"), - ("unlextext","text-like unlexer"), - ("unlexcode","code-like unlexer"), - ("unlexmixed","mixture of text and code (code between $...$, \\(...)\\, \\[...\\])"), - ("unchars","unlexer that puts no spaces between tokens"), - ("unwords","unlexer that puts a single space between tokens (default)"), - ("words","lexer that assumes tokens separated by spaces (default)") - ] ++ - concat [ - [("from_" ++ p, "from unicode to GF " ++ n ++ " transliteration"), - ("to_" ++ p, "from GF " ++ n ++ " transliteration to unicode")] | - (p,n) <- transliterationPrintNames] -{- + treeOpOptions pgf = [(op,expl) | (op,(expl,Left _)) <- allTreeOps pgf] treeOpFlags pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf] @@ -1396,19 +1195,6 @@ prMorphoAnalysis (w,lps) = unlines (w:[H.showCId l ++ " : " ++ p | (l,p) <- lps]) -} -trie = render . pptss . H.toTrie . map H.toATree - where - pptss [ts] = "*"<+>nest 2 (ppts ts) - pptss tss = vcat [i<+>nest 2 (ppts ts)|(i,ts)<-zip [(1::Int)..] tss] - - ppts = vcat . map ppt - - ppt t = - case t of - H.Oth e -> pp (H.showExpr [] e) - H.Ap f [[]] -> pp (H.showCId f) - H.Ap f tss -> H.showCId f $$ nest 2 (pptss tss) - hsExpr c = case C.unApp c of Just (f,cs) -> H.mkApp (H.mkCId f) (map hsExpr cs) |