-- | 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 Data.Char (isSpace)
import GF.Command.CommandInfo
import qualified Data.Map as Map
import GF.Infra.SIO
import GF.Infra.UseIO(writeUTF8File)
import GF.Infra.Option(renameEncoding)
import GF.System.Console(changeConsoleEncoding)
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 Data.Char (isSpace)

import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))

extend :: Map k a -> [(k, a)] -> Map k a
extend Map k a
old [(k, a)]
new = Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, a)]
new) Map k a
old -- Map.union is left-biased

commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)
commonCommands :: Map String (CommandInfo m)
commonCommands = (CommandInfo SIO -> CommandInfo m)
-> Map String (CommandInfo SIO) -> Map String (CommandInfo m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SIO CommandOutput -> m CommandOutput)
-> CommandInfo SIO -> CommandInfo m
forall (m1 :: * -> *) (m2 :: * -> *).
(m1 CommandOutput -> m2 CommandOutput)
-> CommandInfo m1 -> CommandInfo m2
mapCommandExec SIO CommandOutput -> m CommandOutput
forall (m :: * -> *) a. MonadSIO m => SIO a -> m a
liftSIO) (Map String (CommandInfo SIO) -> Map String (CommandInfo m))
-> Map String (CommandInfo SIO) -> Map String (CommandInfo m)
forall a b. (a -> b) -> a -> b
$ [(String, CommandInfo SIO)] -> Map String (CommandInfo SIO)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
  (String
"!", CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     synopsis :: String
synopsis = String
"system command: escape to system shell",
     syntax :: String
syntax   = String
"! SYSTEMCOMMAND",
     examples :: [(String, String)]
examples = [
       (String
"! ls *.gf",  String
"list all GF files in the working directory")
       ]
     }),
  (String
"?", CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     synopsis :: String
synopsis = String
"system pipe: send value from previous command to a system command",
     syntax :: String
syntax   = String
"? SYSTEMCOMMAND",
     examples :: [(String, String)]
examples = [
       (String
"gt | l | ? wc",  String
"generate, linearize, word-count")
       ]
     }),
  (String
"dc",  CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"define_command",
     syntax :: String
syntax = String
"dc IDENT COMMANDLINE",
     synopsis :: String
synopsis = String
"define a command macro",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Defines IDENT as macro for COMMANDLINE, until IDENT gets redefined.",
       String
"A call of the command has the form %IDENT. The command may take an",
       String
"argument, which in COMMANDLINE is marked as ?0. Both strings and",
       String
"trees can be arguments. Currently at most one argument is possible.",
       String
"This command must be a line of its own, and thus cannot be a part",
       String
"of a pipe."
       ]
     }),
  (String
"dt",  CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"define_tree",
     syntax :: String
syntax = String
"dt IDENT (TREE | STRING | \"<\" COMMANDLINE)",
     synopsis :: String
synopsis = String
"define a tree or string macro",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.",
       String
"The defining value can also come from a command, preceded by \"<\".",
       String
"If the command gives many values, the first one is selected.",
       String
"A use of the macro has the form %IDENT. Currently this use cannot be",
       String
"a subtree of another tree. This command must be a line of its own",
       String
"and thus cannot be a part of a pipe."
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx (String
"dt ex \"hello world\"                    -- define ex as string"),
       String -> (String, String)
mkEx (String
"dt ex UseN man_N                         -- define ex as string"),
       String -> (String, String)
mkEx (String
"dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"),
       String -> (String, String)
mkEx (String
"l -lang=LangSwe %ex | ps -to_utf8        -- linearize the tree ex")
       ]
     }),
  (String
"e",  CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"empty",
     synopsis :: String
synopsis = String
"empty the environment"
     }),
  (String
"eh",  CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"execute_history",
     syntax :: String
syntax = String
"eh FILE",
     synopsis :: String
synopsis = String
"read commands from a file and execute them"
     }),
  (String
"ph", CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"print_history",
     synopsis :: String
synopsis = String
"print command history",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints the commands issued during the GF session.",
       String
"The result is readable by the eh command.",
       String
"The result can be used as a script when starting GF."
       ],
     examples :: [(String, String)]
examples = [
      String -> (String, String)
mkEx String
"ph | wf -file=foo.gfs  -- save the history into a file"
      ]
     }),
  (String
"ps", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"put_string",
     syntax :: String
syntax = String
"ps OPT? STRING",
     synopsis :: String
synopsis = String
"return a string, possibly processed with a function",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Returns a string obtained from its argument string by applying",
       String
"string processing functions in the order given in the command line",
       String
"option list. Thus 'ps -f -g s' returns g (f s). Typical string processors",
       String
"are lexers and unlexers, but also character encoding conversions are possible.",
       String
"The unlexers preserve the division of their input to lines.",
       String
"To see transliteration tables, use command ut."
       ],
     examples :: [(String, String)]
examples = [
--       mkEx "l (EAdd 3 4) | ps -code         -- linearize code-like output",
       String -> (String, String)
mkEx String
"l (EAdd 3 4) | ps -unlexcode    -- linearize code-like output",
--       mkEx "ps -lexer=code | p -cat=Exp     -- parse code-like input",
       String -> (String, String)
mkEx String
"ps -lexcode | p -cat=Exp        -- parse code-like input",
       String -> (String, String)
mkEx String
"gr -cat=QCl | l | ps -bind      -- linearization output from LangFin",
       String -> (String, String)
mkEx String
"ps -to_devanagari \"A-p\"         -- show Devanagari in UTF8 terminal",
       String -> (String, String)
mkEx String
"rf -file=Hin.gf | ps -env=quotes -to_devanagari -- convert translit to UTF8",
       String -> (String, String)
mkEx String
"rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic -- convert UTF8 to transliteration",
       String -> (String, String)
mkEx String
"ps -to=chinese.trans \"abc\"      -- apply transliteration defined in file chinese.trans",
       String -> (String, String)
mkEx String
"ps -lexgreek \"a)gavoi` a)'nvrwpoi' tines*\" -- normalize ancient greek accentuation"
       ],
     exec :: [Option] -> CommandArguments -> SIO CommandOutput
exec = \[Option]
opts CommandArguments
x-> do
               let ([Option]
os,[Option]
fs) = [Option] -> ([Option], [Option])
optsAndFlags [Option]
opts
               String -> String
trans <- [Option] -> SIO (String -> String)
optTranslit [Option]
opts

               case [Option]
opts of
                 [Option]
_ | String -> [Option] -> Bool
isOpt String
"lines" [Option]
opts -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> CommandOutput
fromStrings ([String] -> CommandOutput) -> [String] -> CommandOutput
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
trans (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, String) -> [String] -> String -> String
stringOps ([Option] -> Maybe (String, String)
envFlag [Option]
fs) ((Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
prOpt [Option]
os)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
x
                 [Option]
_ | String -> [Option] -> Bool
isOpt String
"paragraphs" [Option]
opts -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> CommandOutput
fromStrings ([String] -> CommandOutput) -> [String] -> CommandOutput
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
trans (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, String) -> [String] -> String -> String
stringOps ([Option] -> Maybe (String, String)
envFlag [Option]
fs) ((Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
prOpt [Option]
os)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
toParagraphs ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
x
                 [Option]
_ -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> CommandOutput
fromString (String -> CommandOutput)
-> (CommandArguments -> String)
-> CommandArguments
-> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trans (String -> String)
-> (CommandArguments -> String) -> CommandArguments -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, String) -> [String] -> String -> String
stringOps ([Option] -> Maybe (String, String)
envFlag [Option]
fs) ((Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
prOpt [Option]
os) (String -> String)
-> (CommandArguments -> String) -> CommandArguments -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandArguments -> String
toString) CommandArguments
x),
     options :: [(String, String)]
options = [
       (String
"lines",String
"apply the operation separately to each input line, returning a list of lines"),
       (String
"paragraphs",String
"apply separately to each input paragraph (as separated by empty lines), returning a list of lines")
       ] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
       [(String, String)]
stringOpOptions,
     flags :: [(String, String)]
flags = [
       (String
"env",String
"apply in this environment only"),
       (String
"from",String
"backward-apply transliteration defined in this file (format 'unicode translit' per line)"),
       (String
"to",  String
"forward-apply transliteration defined in this file")
       ]
     }),
  (String
"q",  CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"quit",
     synopsis :: String
synopsis = String
"exit GF interpreter"
     }),
  (String
"r",  CommandInfo SIO
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"reload",
     synopsis :: String
synopsis = String
"repeat the latest import command"
     }),

  (String
"se", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"set_encoding",
     synopsis :: String
synopsis = String
"set the encoding used in current terminal",
     syntax :: String
syntax   = String
"se ID",
     examples :: [(String, String)]
examples = [
      String -> (String, String)
mkEx String
"se cp1251 -- set encoding to cp1521",
      String -> (String, String)
mkEx String
"se utf8   -- set encoding to utf8 (default)"
      ],
     needsTypeCheck :: Bool
needsTypeCheck = Bool
False,
     exec :: [Option] -> CommandArguments -> SIO CommandOutput
exec = \ [Option]
opts CommandArguments
ts ->
       case String -> [String]
words (CommandArguments -> String
toString CommandArguments
ts) of
         [String
c] -> do let cod :: String
cod = String -> String
renameEncoding String
c
                   IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
changeConsoleEncoding String
cod
                   CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
         [String]
_ -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CommandOutput
pipeMessage String
"se command not parsed")
    }),
  (String
"sp", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"system_pipe",
     synopsis :: String
synopsis = String
"send argument to a system command",
     syntax :: String
syntax   = String
"sp -command=\"SYSTEMCOMMAND\", alt. ? SYSTEMCOMMAND",
     exec :: [Option] -> CommandArguments -> SIO CommandOutput
exec = \[Option]
opts CommandArguments
arg -> do
       let syst :: String
syst = [Option] -> String
optComm [Option]
opts  -- ++ " " ++ tmpi
       {-
       let tmpi = "_tmpi" ---
       let tmpo = "_tmpo"
       restricted $ writeFile tmpi $ toString arg
       restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo
       fmap fromString $ restricted $ readFile tmpo,
       -}
       (String -> CommandOutput) -> SIO String -> SIO CommandOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> CommandOutput
fromStrings ([String] -> CommandOutput)
-> (String -> [String]) -> String -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (SIO String -> SIO CommandOutput)
-> ([String] -> SIO String) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO String -> SIO String
forall a. IO a -> SIO a
restricted (IO String -> SIO String)
-> ([String] -> IO String) -> [String] -> SIO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO String
readShellProcess String
syst (String -> IO String)
-> ([String] -> String) -> [String] -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n')) ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings (CommandArguments -> [String]) -> CommandArguments -> [String]
forall a b. (a -> b) -> a -> b
$ CommandArguments
arg,

     flags :: [(String, String)]
flags = [
       (String
"command",String
"the system command applied to the argument")
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"gt | l | ? wc  -- generate trees, linearize, and count words"
       ]
     }),
  (String
"tt", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"to_trie",
     syntax :: String
syntax = String
"to_trie",
     synopsis :: String
synopsis = String
"combine a list of trees into a trie",
     exec :: [Option] -> CommandArguments -> SIO CommandOutput
exec = \ [Option]
_ -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> (CommandArguments -> CommandOutput)
-> CommandArguments
-> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandOutput
fromString (String -> CommandOutput)
-> (CommandArguments -> String)
-> CommandArguments
-> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree] -> String
trie ([Tree] -> String)
-> (CommandArguments -> [Tree]) -> CommandArguments -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandArguments -> [Tree]
toExprs
    }),
  (String
"ut", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"unicode_table",
     synopsis :: String
synopsis = String
"show a transliteration table for a unicode character set",
     exec :: [Option] -> CommandArguments -> SIO CommandOutput
exec = \[Option]
opts CommandArguments
_ -> do
         let t :: String
t = (Option -> String) -> [Option] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Option -> String
prOpt (Int -> [Option] -> [Option]
forall a. Int -> [a] -> [a]
take Int
1 [Option]
opts)
         let out :: String
out = String
-> (Transliteration -> String) -> Maybe Transliteration -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"no such transliteration" Transliteration -> String
characterTable (Maybe Transliteration -> String)
-> Maybe Transliteration -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe Transliteration
transliteration String
t
         CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString String
out,
     options :: [(String, String)]
options = [(String, String)]
transliterationPrintNames
     }),
  (String
"wf", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"write_file",
     synopsis :: String
synopsis = String
"send string or tree to a file",
     exec :: [Option] -> CommandArguments -> SIO CommandOutput
exec = \[Option]
opts CommandArguments
arg-> do
         let file :: String
file = String -> String -> [Option] -> String
valStrOpts String
"file" String
"_gftmp" [Option]
opts
         if String -> [Option] -> Bool
isOpt String
"append" [Option]
opts
           then IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
appendFile String
file (CommandArguments -> String
toLines CommandArguments
arg)
           else IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeUTF8File String
file (CommandArguments -> String
toLines CommandArguments
arg)
         CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void,
     options :: [(String, String)]
options = [
       (String
"append",String
"append to file, instead of overwriting it")
       ],
     flags :: [(String, String)]
flags = [(String
"file",String
"the output filename")]
     })
  ]
 where
   optComm :: [Option] -> String
optComm [Option]
opts = String -> String -> [Option] -> String
valStrOpts String
"command" String
"" [Option]
opts

   optTranslit :: [Option] -> SIO (String -> String)
optTranslit [Option]
opts = case (String -> String -> [Option] -> String
valStrOpts String
"to" String
"" [Option]
opts, String -> String -> [Option] -> String
valStrOpts String
"from" String
"" [Option]
opts) of
     (String
"",String
"")  -> (String -> String) -> SIO (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String
forall a. a -> a
id
     (String
file,String
"") -> do
       String
src <- IO String -> SIO String
forall a. IO a -> SIO a
restricted (IO String -> SIO String) -> IO String -> SIO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
file
       (String -> String) -> SIO (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> String) -> SIO (String -> String))
-> (String -> String) -> SIO (String -> String)
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool -> String -> String
transliterateWithFile String
file String
src Bool
False
     (String
_,String
file) -> do
       String
src <- IO String -> SIO String
forall a. IO a -> SIO a
restricted (IO String -> SIO String) -> IO String -> SIO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
file
       (String -> String) -> SIO (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> String) -> SIO (String -> String))
-> (String -> String) -> SIO (String -> String)
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool -> String -> String
transliterateWithFile String
file String
src Bool
True

stringOps :: Maybe (String, String) -> [String] -> String -> String
stringOps Maybe (String, String)
menv [String]
opts String
s = (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((String -> String) -> String -> String
menvop ((String -> String) -> String -> String)
-> (String -> String -> String) -> String -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
app) String
s ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
opts)
  where
    app :: String -> String -> String
app String
f = (String -> String)
-> ((String -> String) -> String -> String)
-> Maybe (String -> String)
-> String
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id (String -> String) -> String -> String
forall a. a -> a
id ((String -> Bool) -> String -> Maybe (String -> String)
stringOp (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False) String
f)
    menvop :: (String -> String) -> String -> String
menvop String -> String
op = (String -> String)
-> ((String, String) -> String -> String)
-> Maybe (String, String)
-> String
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
op (\ (String
b,String
e) -> String -> String -> (String -> String) -> String -> String
opInEnv String
b String
e String -> String
op) Maybe (String, String)
menv

envFlag :: [Option] -> Maybe (String, String)
envFlag [Option]
fs =
  case String -> String -> [Option] -> String
valStrOpts String
"env" String
"global" [Option]
fs of
    String
"quotes" -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
"\"",String
"\"")
    String
_ -> Maybe (String, String)
forall a. Maybe a
Nothing

stringOpOptions :: [(String, String)]
stringOpOptions = [(String, String)] -> [(String, String)]
forall a. Ord a => [a] -> [a]
sort ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ [
       (String
"bind",String
"bind tokens separated by Prelude.BIND, i.e. &+"),
       (String
"chars",String
"lexer that makes every non-space character a token"),
       (String
"from_cp1251",String
"decode from cp1251 (Cyrillic used in Bulgarian resource)"),
       (String
"from_utf8",String
"decode from utf8 (default)"),
       (String
"lextext",String
"text-like lexer"),
       (String
"lexcode",String
"code-like lexer"),
       (String
"lexmixed",String
"mixture of text and code, as in LaTeX (code between $...$, \\(...)\\, \\[...\\])"),
       (String
"lexgreek",String
"lexer normalizing ancient Greek accentuation"),
       (String
"lexgreek2",String
"lexer normalizing ancient Greek accentuation for text with vowel length annotations"),
       (String
"to_cp1251",String
"encode to cp1251 (Cyrillic used in Bulgarian resource)"),
       (String
"to_html",String
"wrap in a html file with linebreaks"),
       (String
"to_utf8",String
"encode to utf8 (default)"),
       (String
"unlextext",String
"text-like unlexer"),
       (String
"unlexcode",String
"code-like unlexer"),
       (String
"unlexmixed",String
"mixture of text and code (code between $...$, \\(...)\\, \\[...\\])"),
       (String
"unchars",String
"unlexer that puts no spaces between tokens"),
       (String
"unlexgreek",String
"unlexer de-normalizing ancient Greek accentuation"),
       (String
"unwords",String
"unlexer that puts a single space between tokens (default)"),
       (String
"words",String
"lexer that assumes tokens separated by spaces (default)")
       ] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
      [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
       [(String
"from_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p, String
"from unicode to GF " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" transliteration"),
        (String
"to_"   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p, String
"from GF " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" transliteration to unicode")] |
                                    (String
p,String
n) <- [(String, String)]
transliterationPrintNames]

trie :: [Tree] -> String
trie = Doc -> String
forall a. Pretty a => a -> String
render (Doc -> String) -> ([Tree] -> Doc) -> [Tree] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Trie]] -> Doc
pptss ([[Trie]] -> Doc) -> ([Tree] -> [[Trie]]) -> [Tree] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ATree Tree] -> [[Trie]]
H.toTrie ([ATree Tree] -> [[Trie]])
-> ([Tree] -> [ATree Tree]) -> [Tree] -> [[Trie]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree -> ATree Tree) -> [Tree] -> [ATree Tree]
forall a b. (a -> b) -> [a] -> [b]
map Tree -> ATree Tree
H.toATree
  where
    pptss :: [[Trie]] -> Doc
pptss [[Trie]
ts] = String
"*"String -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>Int -> Doc -> Doc
forall a. Pretty a => Int -> a -> Doc
nest Int
2 ([Trie] -> Doc
ppts [Trie]
ts)
    pptss [[Trie]]
tss  = [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat [Int
iInt -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>Int -> Doc -> Doc
forall a. Pretty a => Int -> a -> Doc
nest Int
2 ([Trie] -> Doc
ppts [Trie]
ts)|(Int
i,[Trie]
ts)<-[Int] -> [[Trie]] -> [(Int, [Trie])]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1::Int)..] [[Trie]]
tss]

    ppts :: [Trie] -> Doc
ppts = [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat ([Doc] -> Doc) -> ([Trie] -> [Doc]) -> [Trie] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trie -> Doc) -> [Trie] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Trie -> Doc
ppt

    ppt :: Trie -> Doc
ppt Trie
t =
      case Trie
t of
        H.Oth Tree
e     -> String -> Doc
forall a. Pretty a => a -> Doc
pp ([CId] -> Tree -> String
H.showExpr [] Tree
e)
        H.Ap CId
f [[]] -> String -> Doc
forall a. Pretty a => a -> Doc
pp (CId -> String
H.showCId CId
f)
        H.Ap CId
f [[Trie]]
tss  -> CId -> String
H.showCId CId
f String -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ Int -> Doc -> Doc
forall a. Pretty a => Int -> a -> Doc
nest Int
2 ([[Trie]] -> Doc
pptss [[Trie]]
tss)

-- ** Converting command input
toString :: CommandArguments -> String
toString  = [String] -> String
unwords ([String] -> String)
-> (CommandArguments -> [String]) -> CommandArguments -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandArguments -> [String]
toStrings
toLines :: CommandArguments -> String
toLines = [String] -> String
unlines ([String] -> String)
-> (CommandArguments -> [String]) -> CommandArguments -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandArguments -> [String]
toStrings

toParagraphs :: [String] -> [String]
toParagraphs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
toParas
  where
    toParas :: [String] -> [String]
toParas [String]
ls = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) [String]
ls of
      ([],[])   -> []
      ([],String
_:[String]
ll) -> [String] -> [String]
toParas [String]
ll
      ([String]
l, [])   -> [[String] -> String
unwords [String]
l]
      ([String]
l, String
_:[String]
ll) -> [String] -> String
unwords [String]
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
toParas [String]
ll