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