Don't show curly braces on transitions
The only exception is a non-empty AllExcept condition in an NFA, because I couldn't think of a better way to represent this special case.
This commit is contained in:
parent
242184cba5
commit
701eadc914
1 changed files with 22 additions and 19 deletions
|
|
@ -26,27 +26,30 @@ import Rextra.Util
|
||||||
|
|
||||||
-- | Instances of this type class must fulfill the following rules:
|
-- | Instances of this type class must fulfill the following rules:
|
||||||
--
|
--
|
||||||
-- * The return value of 'asLabel' must never be an empty string.
|
-- * The return value of 'asNodeLabel' must never be an empty string.
|
||||||
--
|
--
|
||||||
-- * @a == b@ is equivalent to @'asLabel' a == 'asLabel' b@.
|
-- * @a == b@ is equivalent to @'asEdgeLabel' a == 'asEdgeLabel' b@.
|
||||||
class AsLabel a where
|
class AsLabel a where
|
||||||
asLabel :: a -> String
|
asNodeLabel :: a -> String
|
||||||
|
asEdgeLabel :: a -> String
|
||||||
|
asEdgeLabel = asNodeLabel
|
||||||
|
|
||||||
instance AsLabel Int where
|
instance AsLabel Int where
|
||||||
asLabel = show
|
asNodeLabel = show
|
||||||
|
|
||||||
instance AsLabel Char where
|
instance AsLabel Char where
|
||||||
asLabel c = [c]
|
asNodeLabel c = [c]
|
||||||
|
|
||||||
-- | __Warning__: Only use this if you know that no empty strings
|
-- | __Warning__: Only use this if you know that no empty strings
|
||||||
-- occur in your automaton's state names!
|
-- occur in your automaton's state names!
|
||||||
instance AsLabel [Char] where
|
instance AsLabel [Char] where
|
||||||
asLabel = id
|
asNodeLabel = id
|
||||||
|
|
||||||
instance AsLabel a => AsLabel (Set.Set a) where
|
instance AsLabel a => AsLabel (Set.Set a) where
|
||||||
asLabel s =
|
asNodeLabel s = "{" ++ asEdgeLabel s ++ "}"
|
||||||
let sublabels = map asLabel $ Set.elems s
|
asEdgeLabel s =
|
||||||
in "{" ++ intercalate "," sublabels ++ "}"
|
let sublabels = map asNodeLabel $ Set.elems s
|
||||||
|
in intercalate "," sublabels
|
||||||
|
|
||||||
{-
|
{-
|
||||||
- Displaying or saving 'DotGraph's
|
- Displaying or saving 'DotGraph's
|
||||||
|
|
@ -69,7 +72,7 @@ saveDotAsPng = saveDot Png
|
||||||
-- be invisible in the displayed graph.
|
-- be invisible in the displayed graph.
|
||||||
nodes :: (AsLabel s) => Fa state s t -> [(String, Bool)]
|
nodes :: (AsLabel s) => Fa state s t -> [(String, Bool)]
|
||||||
nodes a =
|
nodes a =
|
||||||
let normalNodes = map (\s -> (asLabel s, True)) $ Set.toList $ states a
|
let normalNodes = map (\s -> (asNodeLabel s, True)) $ Set.toList $ states a
|
||||||
entryNode = ("", False)
|
entryNode = ("", False)
|
||||||
in entryNode : normalNodes
|
in entryNode : normalNodes
|
||||||
|
|
||||||
|
|
@ -77,14 +80,14 @@ nodes a =
|
||||||
-- the applicative instance instead :D
|
-- the applicative instance instead :D
|
||||||
edges :: (Ord s, AsLabel s)
|
edges :: (Ord s, AsLabel s)
|
||||||
=> Fa state s t -> (state s t -> [(String, s)]) -> [(String, String, String)]
|
=> Fa state s t -> (state s t -> [(String, s)]) -> [(String, String, String)]
|
||||||
edges a f = ("", asLabel $ entryState a, "") : do
|
edges a f = ("", asNodeLabel $ entryState a, "") : do
|
||||||
from <- Set.toList $ states a
|
from <- Set.toList $ states a
|
||||||
(label, to) <- f $ getState a from
|
(label, to) <- f $ getState a from
|
||||||
pure (asLabel from, asLabel to, label)
|
pure (asNodeLabel from, asNodeLabel to, label)
|
||||||
|
|
||||||
faParams :: (AsLabel s) => Fa state s t -> GraphvizParams String Bool String () Bool
|
faParams :: (AsLabel s) => Fa state s t -> GraphvizParams String Bool String () Bool
|
||||||
faParams a =
|
faParams a =
|
||||||
let acceptingStates = Set.map asLabel $ exitStates a
|
let acceptingStates = Set.map asNodeLabel $ exitStates a
|
||||||
|
|
||||||
formatNode (_, False) = [style invis] -- See comment on 'nodes'
|
formatNode (_, False) = [style invis] -- See comment on 'nodes'
|
||||||
formatNode (s, True) =
|
formatNode (s, True) =
|
||||||
|
|
@ -104,7 +107,7 @@ faToDot f a = graphElemsToDot (faParams a) (nodes a) (edges a f)
|
||||||
-}
|
-}
|
||||||
|
|
||||||
dfaShowNoDefault :: (Ord s, Ord t, AsLabel t) => Dfa.State s t -> [(String, s)]
|
dfaShowNoDefault :: (Ord s, Ord t, AsLabel t) => Dfa.State s t -> [(String, s)]
|
||||||
dfaShowNoDefault = map (\(s, t) -> (asLabel t, s)) . Map.assocs . Dfa.transitionsByState
|
dfaShowNoDefault = map (\(s, t) -> (asEdgeLabel t, s)) . Map.assocs . Dfa.transitionsByState
|
||||||
|
|
||||||
dfaShowAll :: (Ord s, Ord t, AsLabel t) => Dfa.State s t -> [(String, s)]
|
dfaShowAll :: (Ord s, Ord t, AsLabel t) => Dfa.State s t -> [(String, s)]
|
||||||
dfaShowAll s = ("*", Dfa.defaultTransition s) : dfaShowNoDefault s
|
dfaShowAll s = ("*", Dfa.defaultTransition s) : dfaShowNoDefault s
|
||||||
|
|
@ -119,7 +122,7 @@ dfaShowTokens :: (Ord s, Ord t, AsLabel t) => Set.Set t -> Dfa.State s t -> [(St
|
||||||
dfaShowTokens tokens state =
|
dfaShowTokens tokens state =
|
||||||
let bareEdges = Map.assocs $ Map.fromSet (Dfa.stateTransition state) tokens
|
let bareEdges = Map.assocs $ Map.fromSet (Dfa.stateTransition state) tokens
|
||||||
groupedEdges = Map.assocs $ groupByFirst $ map swap bareEdges
|
groupedEdges = Map.assocs $ groupByFirst $ map swap bareEdges
|
||||||
in map (\(s, t) -> (asLabel t, s)) groupedEdges
|
in map (\(s, t) -> (asEdgeLabel t, s)) groupedEdges
|
||||||
|
|
||||||
dfaToDotWithTokens :: (Ord s, AsLabel s, Ord t, AsLabel t) => [t] -> Dfa.Dfa s t -> DotGraph String
|
dfaToDotWithTokens :: (Ord s, AsLabel s, Ord t, AsLabel t) => [t] -> Dfa.Dfa s t -> DotGraph String
|
||||||
dfaToDotWithTokens tokenList = faToDot $ dfaShowTokens $ Set.fromList tokenList
|
dfaToDotWithTokens tokenList = faToDot $ dfaShowTokens $ Set.fromList tokenList
|
||||||
|
|
@ -129,10 +132,10 @@ dfaToDotWithTokens tokenList = faToDot $ dfaShowTokens $ Set.fromList tokenList
|
||||||
-}
|
-}
|
||||||
|
|
||||||
showCondition :: (AsLabel t) => Nfa.TransitionCondition t -> String
|
showCondition :: (AsLabel t) => Nfa.TransitionCondition t -> String
|
||||||
showCondition (Nfa.Only s) = asLabel s
|
showCondition (Nfa.Only t) = asEdgeLabel t
|
||||||
showCondition (Nfa.AllExcept s)
|
showCondition (Nfa.AllExcept t)
|
||||||
| Set.null s = "Σ"
|
| Set.null t = "Σ"
|
||||||
| otherwise = "Σ\\" ++ asLabel s
|
| otherwise = "Σ\\" ++ asNodeLabel t
|
||||||
|
|
||||||
nfaShow :: (AsLabel t) => Nfa.State s t -> [(String, s)]
|
nfaShow :: (AsLabel t) => Nfa.State s t -> [(String, s)]
|
||||||
nfaShow state =
|
nfaShow state =
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue