module Text.Dot.FSA where
import Text.Dot
import Text.Dot.Class
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
data FSA = FSA {
fsaStates :: [Text]
, fsaInitial :: Text
, fsaAccepting :: [Text]
, fsaEdges :: [(Text, Text, Text)]
} deriving (Show, Eq)
data FSARenderConfig = FSARenderConfig
instance Graph FSA FSARenderConfig where
defaultGenConfig = FSARenderConfig
genGraph _ (FSA states initial accepting edges) = 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]
fsaGraph :: FSA -> DotGraph
fsaGraph g = graph_ directed $ genGraph FSARenderConfig g