mealy-decompose/src/DotWriter.hs

module DotWriter where

import Data.Monoid (Endo (..))
import Data.Partition (Block (..))
import Data.Text qualified as T

-- TODO: use `Data.Text` here instead of strings

type StringBuilder = Endo String

string :: String -> StringBuilder
string = Endo . (++)

toString :: StringBuilder -> String
toString = flip appEndo []

class ToDot s where
  toDot :: s -> StringBuilder

instance ToDot String where
  toDot = string

instance ToDot T.Text where
  toDot = string . T.unpack

instance ToDot a => ToDot (Maybe a) where
  -- should be chosen not to conflict with possible outputs
  toDot Nothing = string "nil"
  toDot (Just a) = toDot a

instance ToDot Block where
  -- only works nicely when non-negative
  toDot b = string "s" <> string (show b)

transitionToDot :: (ToDot s, ToDot i, ToDot o) => (s, i, o, s) -> StringBuilder
transitionToDot (s, i, o, t) =
  toDot s
    <> string " -> "
    <> toDot t
    <> string " [label=\""
    <> toDot i
    <> string " / "
    <> toDot o
    <> string "\"]"

mealyToDot :: (ToDot s, ToDot i, ToDot o) => String -> [(s, i, o, s)] -> StringBuilder
mealyToDot name transitions =
  string "digraph "
    <> string name
    <> string " {\n"
    <> foldMap transitionToDotSep transitions
    <> string "}\n"
 where
  transitionToDotSep t = string "  " <> transitionToDot t <> string "\n"