module Text.Dot.FSA where
import Text.Dot
import Control.Monad (forM, forM_, when)
import Data.Maybe (fromMaybe, isNothing)
import Data.Text
import qualified Data.Text as T
import qualified Data.Text.IO as T
fsaGraph :: [Text]
-> Text
-> [Text]
-> [(Text, Text, Text)]
-> DotGraph
fsaGraph states initial accepting edges = graph_ directed $ do
nodeDec [width =: "0", height =: "0"]
rankdir leftRight
stateNodes <- forM states $ \s -> do
n <- newNode
genNode n $
if s `elem` accepting
then [label =: s, shape =: "doublecircle"]
else [label =: s]
return (s, n)
forM_ accepting $ \s -> do
when
(isNothing $ lookup s stateNodes)
(error $ "Accepting state is not in the set of states: " ++ T.unpack s)
case lookup initial stateNodes of
Nothing -> error "Initial state is not in the set of states"
Just initialNode -> do
n <- newNode
genNode n ["style" =: "invis"]
n --> initialNode
forM_ edges $ \(from, to, symbol) -> do
let fromNode = fromMaybe
(error $ "From node not found: " ++ T.unpack from)
(lookup from stateNodes)
let toNode = fromMaybe
(error $ "To node not found: " ++ T.unpack to)
(lookup to stateNodes)
genEdge fromNode toNode [label =: symbol]