module HyLo.Model.PrettyPrint ( toDot )
where
import Text.PrettyPrint
import Data.Foldable ( toList )
import HyLo.Model ( Model, worlds, succs, namesOf, propsOf )
import HyLo.Signature ( getSignature, relSymbols )
toDot :: (Show w, Show n, Show p, Show r, Ord w) => Model w n p r -> String
toDot m = render dotDoc
where dotDoc = text "digraph M" <+> lbrace $+$ (nest 2 $ vcat [
text "node [fontname=helvetica];",
(vcat $ map nodeDef ws),
empty,
text "edge [fontname=helvetica];",
(vcat [relDef w r v | r <- rs,
w <- ws,
v <- toList $ succs m r w])]
) $+$
rbrace
nodeDef w = textS w <+> (brackets $
text "label = " <>
(doubleQuotes $
text (show w) <> text "\\n" <>
(braces . hsep . punctuate comma $
(map textS $ namesOf w m) ++
(map textS $ propsOf w m)))) <>
semi
relDef w r v = textS w <+> text "->" <+> textS v <+>
labIfNeeded r <> semi
labIfNeeded = if gt1 rs
then \r -> brackets $
text "label =" <> doubleQuotes (textS r)
else const empty
ws = toList . worlds $ m
rs = toList . relSymbols . getSignature $ m
gt1 (_:_:_) = True
gt1 _ = False
textS :: Show a => a -> Doc
textS = text . show