forked from GitHub/gf-core
30cda51516
GF.Text.Pretty provides the class Pretty and overloaded versions of the pretty printing combinators in Text.PrettyPrint, allowing pretty printable values to be used directly instead of first having to convert them to Doc with functions like text, int, char and ppIdent. Some modules have been converted to use GF.Text.Pretty, but not all. Precedences could be added to simplify the pretty printers for terms and patterns. GF.Infra.Location contains the types Location and L, factored out from GF.Grammar.Grammar, and the class HasSourcePath. This allowed the import of GF.Grammar.Grammar to be removed from GF.Infra.CheckM, making it more like a pure library module.
45 lines
1.6 KiB
Haskell
45 lines
1.6 KiB
Haskell
module GF.Grammar.ShowTerm where
|
|
|
|
import GF.Grammar.Grammar
|
|
import GF.Grammar.Printer
|
|
import GF.Grammar.Lookup
|
|
import GF.Data.Operations
|
|
|
|
import GF.Text.Pretty
|
|
import Data.List (intersperse)
|
|
|
|
showTerm :: SourceGrammar -> TermPrintStyle -> TermPrintQual -> Term -> String
|
|
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 ',' [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
|
|
pr t = case t of
|
|
R rs ->
|
|
[(lab <+> '.' <+> path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val]
|
|
T _ cs ->
|
|
[(ppPatt q 0 patt <+> "=>" <+> path, str) | (patt, val ) <- cs, (path,str) <- pr val]
|
|
V ty cs ->
|
|
let pvals = case allParamValues gr ty of
|
|
Ok pvals -> pvals
|
|
Bad _ -> map Meta [1..]
|
|
in [(ppTerm q 0 pval <+> "=>" <+> path, str) | (pval, val) <- zip pvals cs, (path,str) <- pr val]
|
|
_ -> [(empty,ps t)]
|
|
ps t = case t of
|
|
K s -> pp s
|
|
C s u -> ps s <+> ps u
|
|
FV ts -> hsep (intersperse (pp '/') (map ps ts))
|
|
_ -> ppTerm q 0 t
|
|
|
|
data TermPrintStyle
|
|
= TermPrintTable
|
|
| TermPrintAll
|
|
| TermPrintList
|
|
| TermPrintOne
|
|
| TermPrintDefault
|