module Language.VHDL.Ppr where
import Text.PrettyPrint.HughesPJ
class Ppr a where
ppr :: a -> Doc
instance Ppr Doc where
ppr = id
class PprOps ops toPpr | toPpr -> ops where
pprOps :: ops -> toPpr -> Doc
dot :: Doc
dot = char '.'
vSpace :: Doc
vSpace = text ""
multiVSpace :: Int -> Doc
multiVSpace n = vcat (replicate n (text ""))
ppr_list :: Ppr a => (Doc -> Doc -> Doc) -> [a] -> Doc
ppr_list _ [] = empty
ppr_list join (a1:rest) = go a1 rest
where go a1 [] = ppr a1
go a1 (a2:rest) = ppr a1 `join` go a2 rest
pprOps_list :: PprOps ops toPpr => ops -> (Doc -> Doc -> Doc) -> [toPpr] -> Doc
pprOps_list _ _ [] = empty
pprOps_list ops join (a1:rest) = go a1 rest
where go a1 [] = pprOps ops a1
go a1 (a2:rest) = pprOps ops a1 `join` go a2 rest
vNSpaces :: Int -> Doc -> Doc -> Doc
vNSpaces n doc1 doc2 = doc1 $+$
multiVSpace n $+$
doc2
vSemi :: Doc -> Doc -> Doc
vSemi doc1 doc2 = doc1 <> semi $+$ doc2
vComma :: Doc -> Doc -> Doc
vComma doc1 doc2 = doc1 <> comma $+$ doc2
hComma :: Doc -> Doc -> Doc
hComma doc1 doc2 = doc1 <> comma <+> doc2
commaSep :: Ppr a => [a] -> Doc
commaSep = sep.(punctuate comma).(map ppr)
($++$) :: Doc -> Doc -> Doc
d1 $++$ d2
| isEmpty d1 || isEmpty d2 = empty
| otherwise = d1 $+$ d2
(<++>) :: Doc -> Doc -> Doc
d1 <++> d2
| isEmpty d1 || isEmpty d2 = empty
| otherwise = d1 <+> d2
parensNonEmpty :: Doc -> Doc
parensNonEmpty doc | isEmpty doc = empty
parensNonEmpty doc = parens doc
parensIf :: Bool -> Doc -> Doc
parensIf p d = if p then parens d else d