fsmActions 0.2.0 → 0.3.0

raw patch · 9 files changed

+218/−153 lines, 9 filesdep ~graphvizPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: graphviz

API changes (from Hackage documentation)

Files

• Data/FsmActions.hs +42/−21
• Data/FsmActions/ActionMatrix.hs +1/−2
• Data/FsmActions/FGL.hs +0/−86
• Data/FsmActions/FsmMatrix.hs +6/−7
• Data/FsmActions/Graph.hs +162/−0
• Data/FsmActions/GraphViz.hs +0/−29
• Data/FsmActions/WellFormed.hs +4/−4
• doc/fsmActions.pdf binary
• fsmActions.cabal +3/−4

@@ -21,12 +21,16 @@     State,     DestinationSet(..),     Action(..),-    FSM(..),+    FSM,     Word(..),     -- * Simple FSM operations+    fromList,+    toList,+    delete,+    lookup,+    fsmMap,     states,     alphabet,-    fsmAction,     -- * Normalisation     normalise,     normaliseAction,@@ -51,6 +55,7 @@ import Control.Monad import qualified Data.Map as M import qualified Data.List as L+import Prelude hiding (lookup)  --import Data.FsmActions.FGL @@ -70,30 +75,45 @@     } deriving (Eq, Ord, Show)  -- | Finite state machine whose nodes are labelled with type sy.-newtype FSM sy = FSM {-      unFSM :: M.Map sy Action-    } deriving (Eq, Ord, Show)+newtype FSM sy = FSM (M.Map sy Action)+    deriving (Eq, Ord, Show)  -- | Words are lists of symbols. newtype Word sy = Word [sy]   +-- | Create an FSM from a list of symbol, Action pairs.+fromList :: Ord sy => [(sy, Action)] -> FSM sy+fromList = FSM . M.fromList++-- | Turn an FSM into a list of symbol, Action pairs.+toList :: FSM sy -> [(sy, Action)]+toList (FSM m) = M.toList m++-- | Delete a symbol and its action from an FSM.+delete :: Ord sy => sy -> FSM sy -> FSM sy+delete s (FSM m) = FSM $ M.delete s m++-- | Look up a symbol's 'Action' in an 'FSM'+lookup :: Ord sy => sy -> FSM sy -> Maybe Action+lookup sy (FSM m) = M.lookup sy m++-- | Map a function over the FSM.+fsmMap :: (sy -> Action -> a) -> FSM sy -> [a]+fsmMap f = map (uncurry f) . toList+ -- | Compute the list of states of the 'FSM'.  Only really meaningful -- if the FSM's well-formedness is not 'BadLengths'.  With current -- implementation, is just [0..n] for some n (or empty). states :: FSM sy -> [State]-states fsm = case M.elems (unFSM fsm) of-               ((Action ds):_) -> [0..length ds-1]-               _ -> []+states (FSM m) = case M.elems m of+                   ((Action ds):_) -> [0..length ds-1]+                   _ -> []  -- | Compute the alphabet of an 'FSM'. alphabet :: FSM sy -> [sy]-alphabet = M.keys . unFSM---- | Look up a symbol's 'Action' in an 'FSM'-fsmAction :: Ord sy => sy -> FSM sy -> Maybe Action-fsmAction sy = M.lookup sy . unFSM+alphabet (FSM m) = M.keys m   @@ -127,12 +147,13 @@ -- might contain symbols outside the FSM's alphabet, so the result -- could be Nothing. action :: Ord sy => FSM sy -> Word sy -> Maybe Action-action fsm (Word syms) = foldM (liftMaybe append) (fsmIdentity fsm) actions-    where actions :: [Maybe Action]-          actions = map (flip M.lookup (unFSM fsm)) syms-          liftMaybe :: (a -> a -> a) -> (a -> Maybe a -> Maybe a)-          liftMaybe f x y = case y of Nothing -> Nothing-                                      Just z -> Just $ f x z+action fsm@(FSM m) (Word syms) =+    foldM (liftMaybe append) (fsmIdentity fsm) actions+        where actions :: [Maybe Action]+              actions = map (flip M.lookup m) syms+              liftMaybe :: (a -> a -> a) -> (a -> Maybe a -> Maybe a)+              liftMaybe f x y = case y of Nothing -> Nothing+                                          Just z -> Just $ f x z  -- | Test if two 'Word's are action-equivalent over some FSM. actionEquiv :: Ord sy => FSM sy -> Word sy -> Word sy -> Bool@@ -176,13 +197,13 @@  -- | Compute whether an 'FSM' is deterministic or not. isDFSM :: FSM sy -> Bool-isDFSM = L.all isDAction . M.elems . unFSM+isDFSM (FSM m) = L.all isDAction $ M.elems m    -- | Normalise an 'FSM', i.e. normalise all its 'Actions'. normalise :: FSM sy -> FSM sy-normalise = FSM . M.map normaliseAction . unFSM+normalise (FSM m) = FSM $ M.map normaliseAction m  -- Normalise an 'Action'.  Ensures that all its 'DestinationSet's are -- non-empty (empty ones becomes singleton transitions to self),

@@ -24,7 +24,6 @@  import Control.Monad.Error import qualified Data.List as L-import qualified Data.Map as M import Data.Maybe (mapMaybe) import System.IO.Error (mkIOError, userErrorType) import qualified Text.ParserCombinators.Parsec as P@@ -54,7 +53,7 @@ -- appears is not defined. parseFsmActionMxFiles :: Ord sy => [(sy, FilePath)] -> IO (FSM sy) parseFsmActionMxFiles xs =-    liftM (FSM . M.fromList) $ mapM (liftMSnd parseActionMxFile) xs+    liftM fromList $ mapM (liftMSnd parseActionMxFile) xs         where liftMSnd :: Monad m => (a -> m b) -> (c, a) -> m (c, b)               liftMSnd f (x, y) = f y >>= \z -> return (x, z) 

@@ -1,86 +0,0 @@-{- |--Interface to fgl graph library (<http://hackage.haskell.org/package/fgl>).---}---- Copyright (c) 2009 Andy Gimblett - http://www.cs.swan.ac.uk/~csandy/--- BSD Licence (see http://www.opensource.org/licenses/bsd-license.php)--module Data.FsmActions.FGL (-    SelfLoops(..),-    fsmToFGL,-    strongCCs,-    weakCCs-) where--import qualified Data.Map as M-import Data.Graph.Inductive.Basic (undir)-import Data.Graph.Inductive.Graph (Graph, 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.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 = concatMap (symbolEdges selfs) . M.toList . unFSM---- Given a symbol, action pair, compute the list of edges with that--- symbol.-symbolEdges :: SelfLoops -> (sy, Action) -> [(State, State, sy)]-symbolEdges selfs (s, a) =-    concatMap (syStateEdges selfs s) $ zipWithIndex $ destinationSets a---- 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'

@@ -19,13 +19,12 @@     parseFsmMxFile,     parseFsmMx,     -- * Output-    printFsmMx,+    printFsmMx ) where  import Control.Monad.Error import Data.Char (isSpace) import qualified Data.List as L-import qualified Data.Map as M import System.IO.Error (mkIOError, userErrorType) import qualified Text.ParserCombinators.Parsec as P import Text.PrettyPrint.HughesPJ@@ -93,7 +92,7 @@ interpretFsmMx :: ([String], [[[Int]]]) -> ReadMxMonad (FSM String) interpretFsmMx (actionNames, stateLines) =      if all (== (length actionNames)) lineLengths-      then return $ normalise $ FSM $ M.fromList $ zip actionNames actions+      then return $ normalise $ fromList $ zip actionNames actions       else throwError (MxError "FSM matrix ill-formed" (show lineLengths))     where actions = map mkAction $ L.transpose stateLines           lineLengths = L.map length stateLines@@ -107,7 +106,8 @@ ppFsmMx fsm = actionRow $$ transitionRows     where -- Space-separated list of action names.           actionRow :: Doc-          actionRow = hsep $ map (text . fst) asList+          --actionRow = hsep $ map (text . fst) asList+          actionRow = hsep $ map (text . fst) $ toList fsm           -- Newline-separated list of transition rows.           transitionRows :: Doc           transitionRows = vcat $ map transitionRow transitions@@ -119,11 +119,10 @@           transition = commas . map int . destinations           -- Extract transitions from FSM.           transitions :: [[DestinationSet]]-          transitions = L.transpose $ map (destinationSets . snd) asList-          asList :: [(String, Action)]-          asList = M.toList $ unFSM fsm+          transitions = L.transpose $ map (destinationSets . snd) $ toList fsm           -- Separate a list of Docs with commas           commas :: [Doc] -> Doc           commas [] = empty           commas (x:[]) = x           commas (x:xs) = x <> comma <> commas xs+

@@ -0,0 +1,162 @@+{- |++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)+    ])

@@ -1,29 +0,0 @@-{- |--GraphViz (dot) rendering using the graphviz library.---}---- Copyright (c) 2009 Andy Gimblett - http://www.cs.swan.ac.uk/~csandy/--- BSD Licence (see http://www.opensource.org/licenses/bsd-license.php)--module Data.FsmActions.GraphViz (-    fsmToDot-) where--import Data.GraphViz-import Data.Graph.Inductive.Graph (Graph)--import Data.FsmActions-import Data.FsmActions.FGL---- | Turn an FSM into a 'Data.GraphViz.DotGraph', trimming any--- self-loops which aren't sources of nondeterminism.-fsmToDot :: (Ord sy, Show sy) => FSM sy -> DotGraph-fsmToDot = fglDot . flip fsmToFGL Trim---- Turn an FGL into a DotGraph with labelled edges.-fglDot :: (Ord b, Show b, Graph gr) => gr a b -> DotGraph-fglDot g = graphToDot g [] nodeFn edgeFn-    where nodeFn _ = []-          edgeFn (_, _, label) = [Label $ Left $ show label]

@@ -12,7 +12,6 @@     isWellFormed, ) where -import Control.Arrow (second) {- -- We use a PatriciaTree because we care about speed, and it doesn't -- matter if duplicate edges are lost when checked for SCCs.@@ -22,7 +21,7 @@ import qualified Data.List as L  import Data.FsmActions-import Data.FsmActions.FGL+import Data.FsmActions.Graph  -- | An 'FSM' is well-formed if all its actions are the same length, -- none of its actions contain destinations which are out of range,@@ -53,9 +52,10 @@     | length wccs /= 1 = Disconnected wccs     | otherwise = WellFormed     where -- All (symbol, Action length) pairs in FSM.-          actionLengths = L.map (second aLength) (M.toList $ unFSM fsm)+          actionLengths = fsmMap (\s -> \a -> (s, aLength a)) fsm           -- Submap containing only Actions with bad destinations.-          badParts = M.filter isBad $ unFSM fsm+          -- XXX Re-improve this function; add natural map to FSM?+          badParts = M.filter isBad $ M.fromList $ toList fsm           -- Check if an Action has any bad destinations.           isBad a = any badDest (flatten a)               where -- Flatten lists of destination states in an Action.

binary file changed (139729 → 143688 bytes)

@@ -1,5 +1,5 @@ Name:                   fsmActions-Version:                0.2.0+Version:                0.3.0 Stability:              Alpha Synopsis:               Finite state machines and FSM actions Description:@@ -26,12 +26,11 @@  Library   Build-Depends: base >= 3 && < 5, containers, fgl, graphviz-                        >=2999.0.0.0, mtl, parsec, pretty+                        >=2999.1.0.1, mtl, parsec, pretty   Exposed-modules:      Data.FsmActions,                         Data.FsmActions.ActionMatrix,                         Data.FsmActions.Error,-                        Data.FsmActions.FGL,                         Data.FsmActions.FsmMatrix,-                        Data.FsmActions.GraphViz,+                        Data.FsmActions.Graph,                         Data.FsmActions.WellFormed   ghc-options:          -fwarn-tabs -Wall