Garmelon/rextra
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Mark entry state

Browse source
This commit is contained in:
Joscha 2019-10-26 20:07:52 +00:00
parent 027ffa58ab
commit e8168e5f35
1 changed files with 40 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

45
src/Rextra/Visualize.hs
View file

@ -1,6 +1,12 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module Rextra.Visualize where module Rextra.Visualize
( showDot
, saveDot
, saveDotAsPng
, dfaToDot
, nfaToDot
) where
import Control.Monad import Control.Monad
import Data.Graph.Inductive import Data.Graph.Inductive
@ -32,20 +38,30 @@ convertDfaState (from, state) =
defaultEdge = (from, Dfa.defaultTransition state, "**") defaultEdge = (from, Dfa.defaultTransition state, "**")
in defaultEdge : normalEdges in defaultEdge : normalEdges
-- | Convert a 'Dfa.Dfa' to a 'Gr' graph.
--
-- This function assumes that no node has a negative name.
dfaToGraph :: Dfa.Dfa Int Char -> Gr () String dfaToGraph :: Dfa.Dfa Int Char -> Gr () String
dfaToGraph dfa = dfaToGraph dfa =
let stateMap = Dfa.stateMap dfa let stateMap = Dfa.stateMap dfa
startNode = (-1, ())
startEdge = (-1, Dfa.entryState dfa, "")
nodes = map (\k -> (k, ())) $ Map.keys stateMap nodes = map (\k -> (k, ())) $ Map.keys stateMap
edges = concatMap convertDfaState $ Map.assocs stateMap edges = concatMap convertDfaState $ Map.assocs stateMap
in mkGraph nodes edges in mkGraph (startNode : nodes) (startEdge : edges)
dfaAttributes :: Labellable el => Dfa.Dfa Int t -> GraphvizParams Int nl el () nl dfaAttributes :: Labellable el => Dfa.Dfa Int t -> GraphvizParams Int nl el () nl
dfaAttributes dfa = dfaAttributes dfa =
let exitStates = Dfa.exitStates dfa let exitStates = Dfa.exitStates dfa
fmtNode (n, l) = if n `Set.member` exitStates
then [shape DoubleCircle] fmtNode (-1, _) = [style invis] -- Start node
else [shape Circle] fmtNode ( n, _)
fmtEdge (n1, n2, l) = [toLabel l] | n `Set.member` exitStates = [shape DoubleCircle]
| otherwise = [shape Circle]
fmtEdge (-1, _, _) = [] -- Start edge
fmtEdge ( _, _, l) = [toLabel l]
in nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge } in nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge }
dfaToDot :: Dfa.Dfa Int Char -> DotGraph Node dfaToDot :: Dfa.Dfa Int Char -> DotGraph Node
@ -75,9 +91,11 @@ convertNfaState (from, state) =
nfaToGraph :: Nfa.Nfa Int Char -> Gr () String nfaToGraph :: Nfa.Nfa Int Char -> Gr () String
nfaToGraph nfa = nfaToGraph nfa =
let stateMap = Nfa.stateMap nfa let stateMap = Nfa.stateMap nfa
startNode = (-1, ())
startEdge = (-1, Nfa.entryState nfa, "")
nodes = map (\k -> (k, ())) $ Map.keys stateMap nodes = map (\k -> (k, ())) $ Map.keys stateMap
edges = concatMap convertNfaState $ Map.assocs stateMap edges = concatMap convertNfaState $ Map.assocs stateMap
in mkGraph nodes edges in mkGraph (startNode : nodes) (startEdge : edges)
anyNfaToGraph :: (Ord s) => Nfa.Nfa s Char -> Gr () String anyNfaToGraph :: (Ord s) => Nfa.Nfa s Char -> Gr () String
anyNfaToGraph = nfaToGraph . Nfa.rename anyNfaToGraph = nfaToGraph . Nfa.rename
@ -85,10 +103,15 @@ anyNfaToGraph = nfaToGraph . Nfa.rename
nfaAttributes :: Labellable el => Nfa.Nfa Int t -> GraphvizParams Int nl el () nl nfaAttributes :: Labellable el => Nfa.Nfa Int t -> GraphvizParams Int nl el () nl
nfaAttributes nfa = nfaAttributes nfa =
let exitStates = Nfa.exitStates nfa let exitStates = Nfa.exitStates nfa
fmtNode (n, l) = if n `Set.member` exitStates
then [shape DoubleCircle] fmtNode (-1, _) = [style invis] -- Start node
else [shape Circle] fmtNode ( n, _)
fmtEdge (n1, n2, l) = [toLabel l] | n `Set.member` exitStates = [shape DoubleCircle]
| otherwise = [shape Circle]
fmtEdge (-1, _, _) = [] -- Start edge
fmtEdge ( _, _, l) = [toLabel l]
in nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge } in nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge }
nfaToDot :: Nfa.Nfa Int Char -> DotGraph Node nfaToDot :: Nfa.Nfa Int Char -> DotGraph Node