module Text.Imparse.Report
where
import Data.String.Utils (join)
import Data.List (nubBy)
import qualified Text.RichReports as R
import Text.Imparse.AbstractSyntax
instance (R.ToHighlights a, R.ToMessages a) => R.ToReport (Parser a) where
report (Parser _ _ ps) = R.Finalize $ R.Conc [R.report p | p <- ps]
instance (R.ToHighlights a, R.ToMessages a) => R.ToReport (Production a) where
report (Production a e css) =
R.Block [] [] [
R.Line [] [R.Space],
R.C R.Variable (R.highlights a) (R.messages a) e, R.Text "::=",
R.BlockIndent [] [] [
R.Table [ R.report cs | cs <- css ]
]
]
instance (R.ToHighlights a, R.ToMessages a) => R.ToReport (Choices a) where
report (Choices a cs) =
R.Conc $
[R.report c | c <- cs] ++
[R.Row [
R.Field (R.Conc []),
R.Field (R.Atom (R.highlights a) (R.messages a) [R.Text "^"]),
R.Field (R.Conc [])]
]
instance (R.ToHighlights a, R.ToMessages a) => R.ToReport (Choice a) where
report (Choice a c asc es) =
R.Row [
R.Field (maybe (R.Conc []) R.Text c),
R.Field (R.Atom (R.highlights a) (R.messages a) [R.Text $ show asc]),
R.Field (R.Span [] [] [R.Conc [R.report e | e <- es]])
]
instance (R.ToHighlights a, R.ToMessages a) => R.ToReport (Element a) where
report (Terminal t) = R.report t
report (Error s) = R.err_ [R.HighlightError] [] $ "`!!!_" ++ s ++ "_!!!"
report r =
let rec d r =
let bq = if d > 0 then "" else "`"
in case r of
NonTerminal a nt -> R.var_ (R.highlights a) (R.messages a) $ bq ++ nt
Many e ms ->
R.Span [] [] $
[ R.key (bq ++ "["), rec (d+1) e ]
++ (maybe [] (\s -> [R.key "/", R.lit s]) ms)
++ [R.key "]"]
May e -> R.Span [] [] $ [ R.key (bq ++ "("), rec (d+1) e ] ++ [R.key ")"]
Indented w e ->
if w then
R.Span [] [] [R.key (bq ++ ">"), R.report e, R.key "<"]
else
R.Span [] [] [R.key (bq ++ ">>"), R.report e, R.key "<<"]
in rec 0 r
instance R.ToReport Terminal where
report t = case t of
Explicit s -> R.lit s
StringLiteral -> R.key "`$"
NaturalLiteral -> R.key "`#"
DecimalLiteral -> R.key "`#.#"
Identifier -> R.key "`var"
Constructor -> R.key "`con"
Flag -> R.key "`flag"
RegExp r -> R.Span [] [] [R.key "`{", R.Text r, R.key "}"]
--eof