diff options
| -rw-r--r-- | src/compiler/GF/Command/CommandInfo.hs | 4 | ||||
| -rw-r--r-- | src/compiler/GF/Command/Commands.hs | 239 | ||||
| -rw-r--r-- | src/compiler/GF/Command/Commands2.hs | 232 | ||||
| -rw-r--r-- | src/compiler/GF/Command/CommonCommands.hs | 247 | ||||
| -rw-r--r-- | src/compiler/GF/Command/Help.hs | 2 |
5 files changed, 265 insertions, 459 deletions
diff --git a/src/compiler/GF/Command/CommandInfo.hs b/src/compiler/GF/Command/CommandInfo.hs index bffb452ce..696d14cbc 100644 --- a/src/compiler/GF/Command/CommandInfo.hs +++ b/src/compiler/GF/Command/CommandInfo.hs @@ -55,3 +55,7 @@ toStrings = map showAsString showAsString t = case t of H.ELit (H.LStr s) -> s _ -> "\n" ++ H.showExpr [] t ---newline needed in other cases than the first + +-- ** Creating documentation + +mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl)) diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 76ccff365..100bba24f 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -26,10 +26,11 @@ import GF.Infra.SIO import GF.Command.Abstract --import GF.Command.Messages import GF.Command.CommandInfo +import GF.Command.CommonCommands import GF.Command.Help -import GF.Text.Lexing +--import GF.Text.Lexing import GF.Text.Clitics -import GF.Text.Transliterations +--import GF.Text.Transliterations import GF.Quiz import GF.Command.TreeOperations ---- temporary place for typecheck and compute @@ -41,7 +42,7 @@ import Data.List(intersperse,nub) import Data.Maybe import qualified Data.Map as Map --import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead! -import GF.System.Process +--import GF.System.Process import GF.Text.Pretty import Data.List (sort) --import Debug.Trace @@ -58,24 +59,7 @@ instance TypeCheckArg PGFEnv where -- 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", synopsis = "show word alignments between languages graphically", @@ -179,20 +163,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", syntax = "dg (-only=MODULES)?", @@ -218,30 +188,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", syntax = "eb (-probs=FILE | -lang=LANG)* -file=FILE.gfe", @@ -530,62 +476,6 @@ allCommands = Map.fromList [ mkEx ("pg -funs | ? grep \" S ;\" -- show functions with value cat S") ] }), - ("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", syntax = "pt OPT? TREE", @@ -605,14 +495,6 @@ allCommands = Map.fromList [ options = treeOpOptions undefined{-pgf-}, 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", synopsis = "read string or tree input from a file", @@ -726,38 +608,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", syntax = "so (-grep=STRING)* TYPE?", @@ -804,16 +654,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", synopsis = "show word dependency tree graphically", @@ -974,20 +814,6 @@ allCommands = Map.fromList [ ("view","program to open the resulting file (default \"open\")") ] }), - ("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", @@ -1125,15 +951,6 @@ allCommands = Map.fromList [ probs <- restricted $ readProbabilitiesFromFile file pgf return (setProbabilities probs pgf) - optTranslit opts = case (valStrOpts "to" "" opts, valStrOpts "from" "" opts) of - ("","") -> return id - (file,"") -> do - src <- restricted $ readFile file - return $ transliterateWithFile file src False - (_,file) -> do - src <- restricted $ readFile file - return $ transliterateWithFile file src True - optFile opts = valStrOpts "file" "_gftmp" opts optType pgf opts = @@ -1143,7 +960,6 @@ allCommands = Map.fromList [ Left tcErr -> error $ render (ppTcError tcErr) Right ty -> ty Nothing -> error ("Can't parse '"++str++"' as a type") - optComm opts = valStrOpts "command" "" opts optViewFormat opts = valStrOpts "format" "png" opts optViewGraph opts = valStrOpts "view" "open" opts optNum opts = valIntOpts "number" 1 opts @@ -1208,42 +1024,11 @@ 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 (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] @@ -1285,17 +1070,3 @@ prAllWords mo = prMorphoAnalysis :: (String,[(Lemma,Analysis)]) -> String prMorphoAnalysis (w,lps) = unlines (w:[showCId l ++ " : " ++ p | (l,p) <- lps]) - - -trie = render . pptss . toTrie . map 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 - Oth e -> pp (showExpr [] e) - Ap f [[]] -> pp (showCId f) - Ap f tss -> showCId f $$ nest 2 (pptss tss) 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) diff --git a/src/compiler/GF/Command/CommonCommands.hs b/src/compiler/GF/Command/CommonCommands.hs new file mode 100644 index 000000000..4099d042f --- /dev/null +++ b/src/compiler/GF/Command/CommonCommands.hs @@ -0,0 +1,247 @@ +-- | Commands that work in any type of environment, either because they don't +-- use the PGF, or because they are just documented here and implemented +-- elsewhere +module GF.Command.CommonCommands where +import Data.List(sort) +import GF.Command.CommandInfo +import qualified Data.Map as Map +import GF.Infra.SIO +import GF.Infra.UseIO(writeUTF8File) +import GF.System.Process +import GF.Command.Abstract --(isOpt,valStrOpts,prOpt) +import GF.Text.Pretty +import GF.Text.Transliterations +import GF.Text.Lexing(stringOp,opInEnv) + +import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..)) + +extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased + +commonCommands :: Map.Map String (CommandInfo env) +commonCommands = Map.fromList [ + ("!", emptyCommandInfo { + synopsis = "system command: escape to system shell", + syntax = "! SYSTEMCOMMAND", + examples = [ + ("! ls *.gf", "list all GF files in the working directory") + ] + }), + ("?", emptyCommandInfo { + synopsis = "system pipe: send value from previous command to a system command", + syntax = "? SYSTEMCOMMAND", + examples = [ + ("gt | l | ? wc", "generate, linearize, word-count") + ] + }), + ("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." + ] + }), + ("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") + ] + }), + ("e", emptyCommandInfo { + longname = "empty", + synopsis = "empty the environment" + }), + ("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") + ] + }), + ("q", emptyCommandInfo { + longname = "quit", + synopsis = "exit GF interpreter" + }), + ("r", emptyCommandInfo { + longname = "reload", + synopsis = "repeat the latest import command" + }), + + ("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)" + ] + }), + ("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" + ] + }), + ("tt", emptyCommandInfo { + longname = "to_trie", + syntax = "to_trie", + synopsis = "combine a list of trees into a trie", + exec = \ _ _ -> return . fromString . trie + }), + ("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 + }), + ("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")] + }) + ] + where + optComm opts = valStrOpts "command" "" opts + + optTranslit opts = case (valStrOpts "to" "" opts, valStrOpts "from" "" opts) of + ("","") -> return id + (file,"") -> do + src <- restricted $ readFile file + return $ transliterateWithFile file src False + (_,file) -> do + src <- restricted $ readFile file + return $ transliterateWithFile file src True + +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 + +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] + +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) diff --git a/src/compiler/GF/Command/Help.hs b/src/compiler/GF/Command/Help.hs index a1a6c0aaf..a1a4716ee 100644 --- a/src/compiler/GF/Command/Help.hs +++ b/src/compiler/GF/Command/Help.hs @@ -59,8 +59,6 @@ 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", |