module DCLabel.PrettyShow (PrettyShow(..), prettyShow) where
import DCLabel.Core
import Text.PrettyPrint
class PrettyShow a where
pShow :: a -> Doc
prettyShow :: PrettyShow a => a -> String
prettyShow = render . pShow
instance PrettyShow Disj where
pShow (MkDisj xs) = bracks $ showDisj xs
where showDisj [] = empty
showDisj [x] = pShow x
showDisj (x:xs) = pShow x <+> ( text "\\/") <+> showDisj xs
bracks x = lbrack <> x <> rbrack
instance PrettyShow Conj where
pShow (MkConj []) = empty
pShow (MkConj (x:[])) = pShow x
pShow (MkConj (x:xs)) = pShow x <+> (text "/\\") <+> pShow (MkConj xs)
instance PrettyShow Label where
pShow MkLabelAll = braces $ text "ALL"
pShow l = let (MkLabel conj) = toLNF l
in braces $ pShow conj
instance PrettyShow DCLabel where
pShow (MkDCLabel s i) = angle $ pShow s <+> comma <+> pShow i
where angle txt = (text "<") <> txt <> (text ">")
instance PrettyShow Principal where
pShow (MkPrincipal s) = text (show s)