summaryrefslogtreecommitdiff
path: root/src/Control/Funflow/Pretty.hs
blob: 2f7dea12b7cfae8d9d323b7cab216df6fb688517 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Pretty-printer for Funflow diagrams.
module Control.Funflow.Pretty where

import           Control.Funflow.Base
import           Control.Funflow.Diagram
import qualified Data.Text               as T
import           Text.PrettyPrint

ppFlow :: Flow eff ex a b -> Doc
ppFlow = ppDiagram . toDiagram where
  ppDiagram :: forall ex a b. Diagram ex a b -> Doc
  ppDiagram (Node (NodeProperties (lbl:_)) _ _)    = text . T.unpack $ lbl
  ppDiagram (Node _ _ _)    = text "unlabeled step"
  ppDiagram (Seq f g) = parens $ ppDiagram f <+> text ">>>" <+> ppDiagram g
  ppDiagram (Par f g) = parens $ ppDiagram f <+>  text "***" <+> ppDiagram g
  ppDiagram (Fanin f g) = parens $ ppDiagram f <+>  text "|||" <+> ppDiagram g
  ppDiagram (Catch f g) = parens $ ppDiagram f <+>  text "catch" <+> ppDiagram g

showFlow :: Flow eff ex a b -> String
showFlow = render . ppFlow