Visualize the automata using GraphViz

package.yaml

@@ -23,6 +23,8 @@ dependencies:
 - base >= 4.7 && < 5
 - transformers >= 0.5.6 && < 0.6
 - containers >= 0.6 && < 0.7
+- graphviz >= 2999.20 && < 2999.21
+- fgl >= 5.7 && < 5.8
 # algebraic-graphs >= 0.4 && < 0.5
 
 library:

src/Rextra/Automaton.hs

@@ -45,10 +45,10 @@ dfaStateToNfaState s =
 dfaToNfa :: (Ord s, Ord t) => Dfa.Dfa s t -> Nfa.Nfa s t
 dfaToNfa dfa =
   let stateMap = Dfa.stateMap dfa
-      exitingStates = map fst . filter (\(s, state) -> Dfa.accepting state) $ Map.assocs stateMap
+      exitStates = Dfa.exitStates dfa
       nfaStateMap = Map.map dfaStateToNfaState stateMap
   -- The NFA was created from a valid DFA, so it will be valid too.
-  in  fromJust $ Nfa.nfa nfaStateMap (Dfa.entryState dfa) (Set.fromList exitingStates)
+  in  fromJust $ Nfa.nfa nfaStateMap (Dfa.entryState dfa) exitStates
 
 {-
  - Converting a NFA to a DFA

src/Rextra/Dfa.hs

@@ -9,6 +9,7 @@ module Rextra.Dfa (
   -- ** Properties
   , stateMap
   , entryState
+  , exitStates
   -- ** Executing
   , transition
   , execute
@@ -34,6 +35,13 @@ data Dfa s t = Dfa
 getState :: (Ord s) => Dfa s t -> s -> State s t
 getState dfa s = stateMap dfa Map.! s
 
+exitStates :: (Ord s) => Dfa s t -> Set.Set s
+exitStates dfa = Set.fromList
+               . map fst
+               . filter (accepting . snd)
+               . Map.assocs
+               $ stateMap dfa
+
 data State s t = State
   { transitions       :: Map.Map t s
   , defaultTransition :: s

src/Rextra/Nfa.hs

@@ -34,6 +34,7 @@ module Rextra.Nfa (
 import           Data.List
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+
 import           Rextra.Util
 
 {-

src/Rextra/Visualize.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE TupleSections #-}
+
+module Rextra.Visualize where
+
+import           Data.Graph.Inductive
+import           Data.GraphViz
+import           Data.List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import qualified Rextra.Dfa as Dfa
+import qualified Rextra.Nfa as Nfa
+import           Rextra.Util
+
+{-
+ - Visualizing DFAs
+ -}
+
+convertDfaState :: (Int, Dfa.State Int Char) -> [LEdge String]
+convertDfaState (from, state) =
+  let normalEdges = map (\(t, to) -> (from, to, [t])) . Map.assocs $ Dfa.transitions state
+      defaultEdge = (from, Dfa.defaultTransition state, "default")
+  in  defaultEdge : normalEdges
+
+dfaToGraph :: Dfa.Dfa Int Char -> Gr () String
+dfaToGraph dfa =
+  let stateMap = Dfa.stateMap dfa
+      nodes    = map (\k -> (k, ())) $ Map.keys stateMap
+      edges    = concatMap convertDfaState $ Map.assocs stateMap
+  in  mkGraph nodes edges
+
+dfaAttributes :: Labellable el => Dfa.Dfa Int t -> GraphvizParams Int nl el () nl
+dfaAttributes dfa =
+  let exitStates = Dfa.exitStates dfa
+      fmtNode (n, l) = if n `Set.member` exitStates
+        then [shape DoubleCircle]
+        else [shape Circle]
+      fmtEdge (n1, n2, l) = [toLabel l]
+  in  nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge }
+
+showDfa :: Dfa.Dfa Int Char -> IO ()
+showDfa dfa = runGraphvizCanvas' (graphToDot (dfaAttributes dfa) (dfaToGraph dfa)) Gtk
+
+{-
+ - Visualizing NFAs
+ -}
+
+labelFromSet :: Set.Set Char -> String
+labelFromSet charSet = "{" ++ intersperse ',' (Set.toList charSet) ++ "}"
+
+labelFromCondition :: Nfa.TransitionCondition Char -> String
+labelFromCondition (Nfa.Only charSet)      = labelFromSet charSet
+labelFromCondition (Nfa.AllExcept charSet)
+  | Set.null charSet = "Σ"
+  | otherwise        = "Σ\\" ++ labelFromSet charSet
+
+convertNfaState :: (Int, Nfa.State Int Char) -> [LEdge String]
+convertNfaState (from, state) =
+  let transitions        = Nfa.transitions state
+      transitionEdges    = map (\(cond, to) -> (from, to, labelFromCondition cond)) transitions
+      epsilonTransitions = Set.toList $ Nfa.epsilonTransitions state
+      epsilonEdges       = map (\to -> (from, to, "ε")) epsilonTransitions
+  in transitionEdges ++ epsilonEdges
+
+nfaToGraph :: Nfa.Nfa Int Char -> Gr () String
+nfaToGraph nfa =
+  let stateMap = Nfa.stateMap nfa
+      nodes    = map (\k -> (k, ())) $ Map.keys stateMap
+      edges    = concatMap convertNfaState $ Map.assocs stateMap
+  in  mkGraph nodes edges
+
+anyNfaToGraph :: (Ord s) => Nfa.Nfa s Char -> Gr () String
+anyNfaToGraph = nfaToGraph . Nfa.rename
+
+nfaAttributes :: Labellable el => Nfa.Nfa Int t -> GraphvizParams Int nl el () nl
+nfaAttributes nfa =
+  let exitStates = Nfa.exitStates nfa
+      fmtNode (n, l) = if n `Set.member` exitStates
+        then [shape DoubleCircle]
+        else [shape Circle]
+      fmtEdge (n1, n2, l) = [toLabel l]
+  in  nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge }
+
+showNfa :: Nfa.Nfa Int Char -> IO ()
+showNfa nfa = runGraphvizCanvas' (graphToDot (nfaAttributes nfa) (nfaToGraph nfa)) Gtk