forked from GitHub/gf-core
option cc -list added
This commit is contained in:
@@ -216,6 +216,7 @@ allCommands env@(pgf, mos) = Map.fromList [
|
||||
],
|
||||
options = [
|
||||
("all","pick all strings (forms and variants) from records and tables"),
|
||||
("list","all strings, comma-separated on one line"),
|
||||
("one","pick the first strings, if there is any, from records and tables"),
|
||||
("table","show all strings labelled by parameters"),
|
||||
("unqual","hide qualifying module names")
|
||||
|
||||
@@ -9,12 +9,13 @@ import Text.PrettyPrint
|
||||
import Data.List (intersperse)
|
||||
|
||||
showTerm :: SourceGrammar -> TermPrintStyle -> TermPrintQual -> Term -> String
|
||||
showTerm gr style q t = render $
|
||||
case style of
|
||||
TermPrintTable -> vcat [p <+> s | (p,s) <- ppTermTabular gr q t]
|
||||
TermPrintAll -> vcat [ s | (p,s) <- ppTermTabular gr q t]
|
||||
TermPrintOne -> vcat [ s | (p,s) <- take 1 (ppTermTabular gr q t)]
|
||||
TermPrintDefault -> ppTerm q 0 t
|
||||
showTerm gr sty q t = case sty of
|
||||
TermPrintTable -> render $ vcat [p <+> s | (p,s) <- ppTermTabular gr q t]
|
||||
TermPrintAll -> render $ vcat [ s | (p,s) <- ppTermTabular gr q t]
|
||||
TermPrintList -> renderStyle (style{mode = OneLineMode}) $
|
||||
vcat (punctuate comma [s | (p,s) <- ppTermTabular gr q t])
|
||||
TermPrintOne -> render $ vcat [ s | (p,s) <- take 1 (ppTermTabular gr q t)]
|
||||
TermPrintDefault -> render $ ppTerm q 0 t
|
||||
|
||||
ppTermTabular :: SourceGrammar -> TermPrintQual -> Term -> [(Doc,Doc)]
|
||||
ppTermTabular gr q = pr where
|
||||
@@ -38,5 +39,6 @@ ppTermTabular gr q = pr where
|
||||
data TermPrintStyle
|
||||
= TermPrintTable
|
||||
| TermPrintAll
|
||||
| TermPrintList
|
||||
| TermPrintOne
|
||||
| TermPrintDefault
|
||||
|
||||
@@ -111,6 +111,7 @@ loop opts gfenv0 = do
|
||||
let
|
||||
pOpts style q ("-table" :ws) = pOpts TermPrintTable q ws
|
||||
pOpts style q ("-all" :ws) = pOpts TermPrintAll q ws
|
||||
pOpts style q ("-list" :ws) = pOpts TermPrintList q ws
|
||||
pOpts style q ("-one" :ws) = pOpts TermPrintOne q ws
|
||||
pOpts style q ("-default":ws) = pOpts TermPrintDefault q ws
|
||||
pOpts style q ("-unqual" :ws) = pOpts style Unqualified ws
|
||||
|
||||
Reference in New Issue
Block a user