{- | Generating and drawing graphs of FSMs. Includes: - Interface to fgl graph library (<http://hackage.haskell.org/package/fgl>). - Interface to graphviz library for dot output (<http://hackage.haskell.org/package/graphviz>). - Home-grown GML (Graph Modelling Language) output. -} -- Copyright (c) 2009 Andy Gimblett - http://www.cs.swan.ac.uk/~csandy/ -- BSD Licence (see http://www.opensource.org/licenses/bsd-license.php) -- We need these declarations for the CleanShow typeclass. {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} module Data.FsmActions.Graph ( -- * FGL graph operations. SelfLoops(..), fsmToFGL, strongCCs, weakCCs, -- * Dot and GML format output. CleanShow, fsmToDot, fsmToGML ) where import Data.Graph.Inductive.Basic (undir) import Data.Graph.Inductive.Graph (Graph, labEdges, mkGraph) import qualified Data.Graph.Inductive.PatriciaTree as P import qualified Data.Graph.Inductive.Tree as T import Data.Graph.Inductive.Query.DFS (scc) import Data.GraphViz import Text.PrettyPrint.HughesPJ import Data.FsmActions -- | When converting an 'Data.FsmActions.FSM' into a graph, do we keep -- all self-loops, or only those which are sources of nondeterminism? data SelfLoops = Keep | Trim -- | Turn an FSM into an fgl graph with labelled edges. fsmToFGL :: FSM sy -> SelfLoops -> T.Gr () sy -- Note use of T.Gr; this instance of Graph allows multiple edges -- between the same pair of nodes, which is what we _usually_ (but not -- always) want. fsmToFGL = fsmToFGL' -- Generalised FSM to graph conversion; works with any Graph instance. fsmToFGL' :: (Graph gr) => FSM sy -> SelfLoops -> gr () sy fsmToFGL' fsm selfs = mkGraph nodes edges where nodes = map (\state -> (state, ())) $ states fsm edges = fsmEdges selfs fsm -- Compute an FSM's labelled edges fsmEdges :: SelfLoops -> FSM sy -> [(State, State, sy)] fsmEdges selfs = concat . fsmMap (symbolEdges selfs) -- Given a symbol, action pair, compute the list of edges with that -- symbol. symbolEdges :: SelfLoops -> sy -> Action -> [(State, State, sy)] symbolEdges selfs s = concatMap (syStateEdges selfs s) . zipWithIndex . destinationSets -- Given a symbol, a start state, and a destination set, compute the -- list of edges leading from that state with that symbol, possibly -- taking account of a desire to trim deterministic self-loops. syStateEdges :: SelfLoops -> sy -> (State, DestinationSet) -> [(State, State, sy)] syStateEdges Keep s (src, dSet) = syStateEdges' s (src, dSet) syStateEdges Trim s (src, dSet) = if destinations dSet == [src] then [] else syStateEdges' s (src, dSet) -- Given a symbol, a start state, and a destination set, compute the -- list of edges leading from that state with that symbol. syStateEdges' :: sy -> (State, DestinationSet) -> [(State, State, sy)] syStateEdges' s (src, dSet) = map (\x -> (src, x, s)) $ destinations dSet -- Create a zip of a list with its index list. zipWithIndex :: [a] -> [(Int, a)] zipWithIndex xs = zip [0..(length xs-1)] xs -- | Compute an FSM's strongly-connected components. strongCCs :: Eq sy => FSM sy -> [[State]] strongCCs = scc . fsmToPatriciaTree Trim -- | Compute an FSM's weakly-connected components. weakCCs :: Eq sy => FSM sy -> [[State]] weakCCs = scc . undir . fsmToPatriciaTree Trim -- | The PatriciaTree instance of Graph is faster, but not generally -- useful to us because it doesn't allow multiple edges between the -- same pair of nodes. For SCC checks, however, that doesn't matter, -- so we use it. fsmToPatriciaTree :: SelfLoops -> FSM sy -> P.Gr () sy fsmToPatriciaTree = flip fsmToFGL' -- | Subclass 'Show' so that 'show' calls on 'String's and 'Char's -- don't get quotes inserted. class (Show a) => CleanShow a where cleanShow :: a -> String cleanShow = show -- by default, turn it to a String instance (Show a) => CleanShow a instance CleanShow String where cleanShow = id -- don't need to do anything for a String instance CleanShow Char where cleanShow c = cleanShow [c] -- just lift it to String -- | Turn an FSM into a 'Data.GraphViz.DotGraph', trimming any -- self-loops which aren't sources of nondeterminism. fsmToDot :: (Ord sy, CleanShow sy) => FSM sy -> DotGraph fsmToDot = fglDot . flip fsmToFGL Trim -- Turn an FGL into a DotGraph with labelled edges. fglDot :: (Ord b, CleanShow b, Graph gr) => gr a b -> DotGraph fglDot g = graphToDot g [] nodeFn edgeFn where nodeFn _ = [] edgeFn (_, _, label) = [Label $ StrLabel $ cleanShow label] -- | Turn an FSM into a GML-formatted graph', trimming any self-loops -- which aren't sources of nondeterminism. fsmToGML :: CleanShow sy => FSM sy -> Doc fsmToGML f = text "graph" <+> brackets body where body = vcat [directed, planar, fNodes, fEdges] directed = text "directed 1" planar = text "IsPlanar 1" fNodes = vcat $ map gmlNode $ states f fEdges = vcat $ map gmlEdge $ labEdges $ fsmToFGL f Trim gmlNode :: State -> Doc gmlNode i = text "node" <+> brackets (vcat [ text "id" <+> text (show i), text "label" <+> doubleQuotes (text $ show i) ]) gmlEdge :: CleanShow sy => (State, State, sy) -> Doc gmlEdge (src, dest, label) = text "edge" <+> brackets (vcat [ text "source" <+> text (show src), text "target" <+> text (show dest), text "label" <+> doubleQuotes (text $ cleanShow label) ])