forked from GitHub/gf-core
Better help.
This commit is contained in:
@@ -58,11 +58,12 @@ markSubterm (beg, end) t = case t of
|
||||
R rs -> R $ map markField rs
|
||||
T ty cs -> T ty [Cas p (mark v) | Cas p v <- cs]
|
||||
FV ts -> FV $ map mark ts
|
||||
_ -> foldr1 C [tK beg, t, tK end] -- t : Str guaranteed?
|
||||
_ -> foldr1 C (tk beg ++ [t] ++ tk end) -- t : Str guaranteed?
|
||||
where
|
||||
mark = markSubterm (beg, end)
|
||||
markField lt@(Ass l t) = if isLinLabel l then (Ass l (mark t)) else lt
|
||||
|
||||
tk s = if null s then [] else [tK s]
|
||||
|
||||
tK :: String -> Term
|
||||
tK = K . KS
|
||||
|
||||
|
||||
@@ -311,6 +311,12 @@ type WParser a b = [a] -> [(b,[a])] -- old Wadler style parser
|
||||
wParseResults :: WParser a b -> [a] -> [b]
|
||||
wParseResults p aa = [b | (b,[]) <- p aa]
|
||||
|
||||
paragraphs :: String -> [String]
|
||||
paragraphs = map unlines . chop . lines where
|
||||
chop [] = []
|
||||
chop ss = let (ps,rest) = break empty ss in ps : chop (dropWhile empty rest)
|
||||
empty = all isSpace
|
||||
|
||||
-- printing
|
||||
|
||||
indent :: Int -> String -> String
|
||||
|
||||
@@ -128,6 +128,20 @@ unComputed t = case t of
|
||||
Computed v -> unComputed v
|
||||
_ -> t --- composSafeOp unComputed t
|
||||
|
||||
|
||||
{-
|
||||
--- defined (better) in compile/PrOld
|
||||
|
||||
stripTerm :: Term -> Term
|
||||
stripTerm t = case t of
|
||||
Q _ c -> Cn c
|
||||
QC _ c -> Cn c
|
||||
T ti psts -> T ti [(stripPatt p, stripTerm v) | (p,v) <- psts]
|
||||
_ -> composSafeOp stripTerm t
|
||||
where
|
||||
stripPatt p = errVal p $ term2patt $ stripTerm $ patt2term p
|
||||
-}
|
||||
|
||||
computed = Computed
|
||||
|
||||
termForm :: Term -> Err ([(Ident)], Term, [Term])
|
||||
|
||||
@@ -160,6 +160,8 @@ doCompute = iOpt "c"
|
||||
optimizeCanon = iOpt "opt"
|
||||
stripQualif = iOpt "strip"
|
||||
nostripQualif = iOpt "nostrip"
|
||||
showAll = iOpt "all"
|
||||
fromSource = iOpt "src"
|
||||
|
||||
-- mainly for stand-alone
|
||||
useUnicode = iOpt "unicode"
|
||||
|
||||
@@ -80,7 +80,7 @@ data Command =
|
||||
| CPrintCanonXML
|
||||
| CPrintCanonXMLStruct
|
||||
| CPrintHistory
|
||||
| CHelp
|
||||
| CHelp (Maybe String)
|
||||
|
||||
| CImpure ImpureCommand
|
||||
|
||||
@@ -177,7 +177,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
|
||||
CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
|
||||
|
||||
CComputeConcrete m t ->
|
||||
justOutput (putStrLn (err id prt (
|
||||
justOutput (putStrLn (err id (prt . stripTerm) (
|
||||
string2srcTerm src m t >>= Co.computeConcrete src))) sa
|
||||
|
||||
CTranslationQuiz il ol -> justOutput (teachTranslation opts (sgr il) (sgr ol)) sa
|
||||
@@ -201,7 +201,10 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
|
||||
CSetFlag -> changeState (addGlobalOptions opts0) sa
|
||||
---- deprec! CSetLocalFlag lang -> changeState (addLocalOptions lang opts0) sa
|
||||
|
||||
CHelp -> returnArg (AString txtHelpFile) sa
|
||||
CHelp (Just c) -> returnArg (AString (txtHelpCommand c)) sa
|
||||
CHelp _
|
||||
| oElem showAll opts -> returnArg (AString txtHelpFile) sa
|
||||
| otherwise -> returnArg (AString txtHelpFileSummary) sa
|
||||
|
||||
CPrintGrammar
|
||||
| oElem showOld opts -> returnArg (AString $ printGrammarOld (canModules st)) sa
|
||||
|
||||
@@ -104,7 +104,8 @@ pCommand ws = case ws of
|
||||
"pm" : [] -> aUnit CPrintMultiGrammar
|
||||
"po" : [] -> aUnit CPrintGlobalOptions
|
||||
"pl" : [] -> aUnit CPrintLanguages
|
||||
"h" : [] -> aUnit CHelp
|
||||
"h" : c : [] -> aUnit $ CHelp (Just (abbrevCommand c))
|
||||
"h" : [] -> aUnit $ CHelp Nothing
|
||||
|
||||
"q" : [] -> aImpure ICQuit
|
||||
"eh" : f : [] -> aImpure (ICExecuteHistory f)
|
||||
|
||||
Reference in New Issue
Block a user