forked from GitHub/gf-core
flag -env=quotes (and possible other flags) to restrict ps
This commit is contained in:
@@ -56,6 +56,12 @@ isOpt o opts = elem o [x | OOpt x <- opts]
|
|||||||
isFlag :: String -> [Option] -> Bool
|
isFlag :: String -> [Option] -> Bool
|
||||||
isFlag o opts = elem o [x | OFlag x _ <- opts]
|
isFlag o opts = elem o [x | OFlag x _ <- opts]
|
||||||
|
|
||||||
|
optsAndFlags :: [Option] -> ([Option],[Option])
|
||||||
|
optsAndFlags = foldr add ([],[]) where
|
||||||
|
add o (os,fs) = case o of
|
||||||
|
OOpt _ -> (o:os,fs)
|
||||||
|
OFlag _ _ -> (os,o:fs)
|
||||||
|
|
||||||
prOpt :: Option -> String
|
prOpt :: Option -> String
|
||||||
prOpt o = case o of
|
prOpt o = case o of
|
||||||
OOpt i -> i
|
OOpt i -> i
|
||||||
|
|||||||
@@ -416,10 +416,15 @@ allCommands cod env@(pgf, mos) = Map.fromList [
|
|||||||
"l (EAdd 3 4) | ps -code -- linearize code-like output",
|
"l (EAdd 3 4) | ps -code -- linearize code-like output",
|
||||||
"ps -lexer=code | p -cat=Exp -- parse code-like input",
|
"ps -lexer=code | p -cat=Exp -- parse code-like input",
|
||||||
"gr -cat=QCl | l | ps -bind -- linearization output from LangFin",
|
"gr -cat=QCl | l | ps -bind -- linearization output from LangFin",
|
||||||
"ps -to_devanagari \"A-p\" -- show Devanagari in UTF8 terminal"
|
"ps -to_devanagari \"A-p\" -- show Devanagari in UTF8 terminal"
|
||||||
],
|
],
|
||||||
exec = \opts -> return . fromString . stringOps (map prOpt opts) . toString,
|
exec = \opts ->
|
||||||
options = stringOpOptions
|
let (os,fs) = optsAndFlags opts in
|
||||||
|
return . fromString . stringOps (envFlag fs) (map prOpt os) . toString,
|
||||||
|
options = stringOpOptions,
|
||||||
|
flags = [
|
||||||
|
("env","apply in this environment only")
|
||||||
|
]
|
||||||
}),
|
}),
|
||||||
("pt", emptyCommandInfo {
|
("pt", emptyCommandInfo {
|
||||||
longname = "put_tree",
|
longname = "put_tree",
|
||||||
@@ -603,7 +608,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
|
|||||||
(prCId (abstractName pgf) ++ ": " ++ showTree t) :
|
(prCId (abstractName pgf) ++ ": " ++ showTree t) :
|
||||||
[prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
|
[prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
|
||||||
|
|
||||||
unlex opts lang = stringOps (getUnlex opts lang ++ map prOpt opts)
|
unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ----
|
||||||
|
|
||||||
getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
|
getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
|
||||||
lexs -> case lookup lang
|
lexs -> case lookup lang
|
||||||
@@ -616,7 +621,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
|
|||||||
-- - If lang has flag coding=utf8, -to_utf8 is ignored.
|
-- - If lang has flag coding=utf8, -to_utf8 is ignored.
|
||||||
-- - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first.
|
-- - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first.
|
||||||
-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly
|
-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly
|
||||||
unlexx opts lang = {- trace (unwords optsC) $ -} stringOps optsC where
|
unlexx opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ----
|
||||||
optsC = case lookFlag pgf lang "coding" of
|
optsC = case lookFlag pgf lang "coding" of
|
||||||
Just "utf8" -> filter (/="to_utf8") $ map prOpt opts
|
Just "utf8" -> filter (/="to_utf8") $ map prOpt opts
|
||||||
Just other | isOpt "to_utf8" opts ->
|
Just other | isOpt "to_utf8" opts ->
|
||||||
@@ -666,8 +671,13 @@ allCommands cod env@(pgf, mos) = Map.fromList [
|
|||||||
morpho la = maybe Map.empty id $ Map.lookup la mos
|
morpho la = maybe Map.empty id $ Map.lookup la mos
|
||||||
|
|
||||||
-- ps -f -g s returns g (f s)
|
-- ps -f -g s returns g (f s)
|
||||||
stringOps opts s = foldr app s (reverse opts) where
|
stringOps menv opts s = foldr (menvop . app) s (reverse opts) where
|
||||||
app f = maybe id id (stringOp f)
|
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 opts s = foldr app s (reverse opts) where
|
treeOps opts s = foldr app s (reverse opts) where
|
||||||
app f = maybe id id (treeOp pgf f)
|
app f = maybe id id (treeOp pgf f)
|
||||||
|
|||||||
@@ -29,6 +29,8 @@ stringOp name = case name of
|
|||||||
"from_cp1251" -> Just decodeCP1251
|
"from_cp1251" -> Just decodeCP1251
|
||||||
_ -> transliterate name
|
_ -> transliterate name
|
||||||
|
|
||||||
|
-- perform op in environments beg--end, t.ex. between "--"
|
||||||
|
--- suboptimal implementation
|
||||||
opInEnv :: String -> String -> (String -> String) -> (String -> String)
|
opInEnv :: String -> String -> (String -> String) -> (String -> String)
|
||||||
opInEnv beg end op = concat . altern False . chop (lbeg, beg) [] where
|
opInEnv beg end op = concat . altern False . chop (lbeg, beg) [] where
|
||||||
chop mk@(lg, mark) s0 s =
|
chop mk@(lg, mark) s0 s =
|
||||||
|
|||||||
Reference in New Issue
Block a user