fsmActions 0.4.2 → 0.4.3
raw patch · 9 files changed
+64/−67 lines, 9 filesdep ~fgldep ~graphvizdep ~parsecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: fgl, graphviz, parsec
API changes (from Hackage documentation)
Files
- Data/FsmActions.hs +10/−10
- Data/FsmActions/ActionMatrix.hs +15/−20
- Data/FsmActions/FsmEdges.hs +8/−8
- Data/FsmActions/FsmMatrix.hs +12/−11
- Data/FsmActions/Graph.hs +10/−6
- Data/FsmActions/IO.hs +2/−5
- Data/FsmActions/WellFormed.hs +3/−3
- doc/fsmActions.pdf binary
- fsmActions.cabal +4/−4
Data/FsmActions.hs view
@@ -108,8 +108,8 @@ -- implementation, is just [0..n] for some n (or empty). states :: FSM sy -> [State] states (FSM m) = case M.elems m of- ((Action ds):_) -> [0..length ds-1]- _ -> []+ (Action ds:_) -> [0..length ds-1]+ _ -> [] -- | Compute the alphabet of an 'FSM'. alphabet :: FSM sy -> [sy]@@ -128,14 +128,14 @@ -- | Append two 'Action's, ie compute the 'Action' corresponding to -- the application of the first followed by the second. append :: Action -> Action -> Action-append (Action d1) a2 = Action $ map (flip appendAtState a2) d1+append (Action d1) a2 = Action $ map (`appendAtState` a2) d1 -- Given the 'DestinationSet' for some state, and an 'Action', compute -- the 'DestinationSet' reached by following the 'Action' from each -- each state in the 'DestinationSet', and collecting the results. appendAtState :: DestinationSet -> Action -> DestinationSet appendAtState (DestinationSet xs) a2 =- collect $ L.map destinations $ map (actionLookup a2) xs+ collect $ L.map (destinations . actionLookup a2) xs where collect = DestinationSet . L.nub . L.sort . L.concat -- | Compute the 'DestinationSet' reached by following some 'Action'@@ -150,8 +150,8 @@ 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)+ actions = map (`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 @@ -168,9 +168,9 @@ destinationSet :: Ord sy => FSM sy -> State -> Word sy -> Maybe DestinationSet destinationSet fsm src word = if (src >= 0) && (src < length (states fsm))- then case (action fsm word) of Just (Action ds) -> Just $ ds !! src- _ -> Nothing- + then case action fsm word of Just (Action ds) -> Just $ ds !! src+ _ -> Nothing+ else Nothing -- | Test if two 'Word's are destination-equivalent at some 'State' of@@ -193,7 +193,7 @@ -- | Test if an 'Action' is deterministic or not. isDAction :: Action -> Bool isDAction (Action destSets) =- all (\x -> (length (destinations x) == 1)) destSets+ all (\x -> length (destinations x) == 1) destSets -- | Compute whether an 'FSM' is deterministic or not. isDFSM :: FSM sy -> Bool
Data/FsmActions/ActionMatrix.hs view
@@ -44,12 +44,13 @@ import Control.Exception import Control.Monad.Error import qualified Data.List as L+import Data.Maybe (fromMaybe, mapMaybe) import Data.String.Utils-import Data.Maybe (mapMaybe) import System.FilePath-import qualified Text.ParserCombinators.Parsec as P-import qualified Text.ParserCombinators.Parsec.Language as L-import qualified Text.ParserCombinators.Parsec.Token as T+import qualified Text.Parsec as P+import qualified Text.Parsec.Language as L+import Text.Parsec.String+import qualified Text.Parsec.Token as T import Text.PrettyPrint.HughesPJ import Data.FsmActions@@ -97,16 +98,16 @@ Left err -> throw $ FsmError "FSM action specs parse error" (show err) -- | Parser for fsmActionSpec strings.-fsmActionSpecParser :: P.Parser [(String, FilePath)]+fsmActionSpecParser :: Parser [(String, FilePath)] fsmActionSpecParser = P.sepEndBy1 lineParser (T.semi l)- where lineParser :: P.Parser (String, FilePath)+ where lineParser :: Parser (String, FilePath) lineParser = do T.whiteSpace l label <- T.stringLiteral l mxPath <- T.stringLiteral l return (label, mxPath) l :: T.TokenParser st l = T.makeTokenParser L.emptyDef {- L.commentLine = "--"+ T.commentLine = "--" } -- | Given a (symbol, path) association list, compute an@@ -152,19 +153,16 @@ -- The string being parsed should contain newline-separated rows, -- where each row contains comma-separated cells, where each cell is a -- 0 or a 1. Trailing newlines are ignored.-actionMxParser :: P.Parser ActionMatrix+actionMxParser :: Parser ActionMatrix actionMxParser = do rows <- parseRow `P.sepEndBy1` P.char '\n' P.skipMany $ P.char '\n' -- Ignore any trailing newlines P.eof return rows- where parseRow :: P.Parser [Bool]+ where parseRow :: Parser [Bool] parseRow = parseCell `P.sepBy1` P.char ','- parseCell :: P.Parser Bool- parseCell = P.choice [ do P.char '0'- return False- , do P.char '1'- return True- ]+ parseCell :: Parser Bool+ parseCell = P.choice [ P.char '0' >> return False+ , P.char '1' >> return True] -- | Given an 'ActionMatrix', compute the corresponding -- 'Data.FsmActions.Action'.@@ -207,17 +205,14 @@ -- the action matrix as a string. If label lookup fails, -- compute a default path from the label. getActionData pd l a = (l, mxPath, printActionMx a)- where mxPath = case L.lookup l pd of- Just x -> x- Nothing -> defaultPath l+ where mxPath = fromMaybe (defaultPath l) (L.lookup l pd) -- | Compute the default path for a symbol; we take the symbol, -- replace various undesirable characters with underscores, and append -- ".actionmx". defaultPath :: String -> FilePath defaultPath s = addExtension clean ".actionmx"- where -- There's got to be a nicer way to do this!?- clean = foldr ($) s (map (flip replace "_") undesirable)+ where clean = foldr (`replace` "-") s undesirable -- This is slightly cock-eyed: we define a string of -- undesirable characters, each of which will be replaced -- with an underscore. However, the replace function we're
Data/FsmActions/FsmEdges.hs view
@@ -21,13 +21,13 @@ ) where import Control.Exception-import Control.Monad.Error import qualified Data.Graph.Inductive.Graph as G import Data.Graph.Inductive.Tree (Gr) import Data.List-import qualified Text.ParserCombinators.Parsec as P-import qualified Text.ParserCombinators.Parsec.Language as L-import qualified Text.ParserCombinators.Parsec.Token as T+import qualified Text.Parsec as P+import qualified Text.Parsec.Language as L+import Text.Parsec.String+import qualified Text.Parsec.Token as T import Text.PrettyPrint.HughesPJ import Data.FsmActions@@ -64,13 +64,13 @@ Left err -> throw $ FsmError "FSM edges parse error" (show err) -- FsmEdges-format parser.-fsmEdgesParser :: P.Parser [Edge]+fsmEdgesParser :: Parser [Edge] fsmEdgesParser = T.braces l $ T.commaSep l fsmEdgeParser- where fsmEdgeParser :: P.Parser Edge+ where fsmEdgeParser :: Parser Edge fsmEdgeParser = T.braces l $ do source <- T.natural l- T.symbol l "->"+ _ <- T.symbol l "->" destination <- T.natural l- T.comma l+ _ <- T.comma l label <- T.identifier l return $ Edge source destination label l :: T.TokenParser st
Data/FsmActions/FsmMatrix.hs view
@@ -28,7 +28,8 @@ import Control.Monad.Error import Data.Char (isSpace) import qualified Data.List as L-import qualified Text.ParserCombinators.Parsec as P+import qualified Text.Parsec as P+import Text.Parsec.String import Text.PrettyPrint.HughesPJ import Data.FsmActions@@ -60,33 +61,33 @@ Left err -> throw $ FsmError "FSM matrix parse error" (show err) -- FsmMatrix-format parser.-fsmMatrixParser :: P.Parser ([String], [[[Int]]])+fsmMatrixParser :: Parser ([String], [[[Int]]]) fsmMatrixParser = do actions <- actionName `P.sepEndBy` nonEOLSpace- P.char '\n'+ _ <- P.char '\n' transitionRows <- transitionRow `P.sepEndBy` P.char '\n'- P.many (P.satisfy isSpace) -- Parse trailing whitespace.+ _ <- P.many (P.satisfy isSpace) -- Parse trailing whitespace. P.eof return (actions, transitionRows) where -- An action name is a string of non-whitespace characters.- actionName :: P.Parser String+ actionName :: Parser String actionName = P.many1 (P.satisfy (not . isSpace)) -- A row of transitions is a space-separated line of transitions.- transitionRow :: P.Parser [[Int]]+ transitionRow :: Parser [[Int]] transitionRow = transition `P.sepEndBy1` nonEOLSpace -- A transition is a comma-separated list of states (no spaces).- transition :: P.Parser [Int]+ transition :: Parser [Int] transition = state `P.sepBy1` P.char ',' -- A state is a natural number.- state :: P.Parser Int+ state :: Parser Int state = liftM read (P.many1 P.digit) -- Parse whitespace that isn't an end of line.- nonEOLSpace :: P.Parser String+ nonEOLSpace :: Parser String nonEOLSpace = P.many1 (P.satisfy (\c -> isSpace c && c /= '\n')) -- Turn some FsmMatrix-formatted data into an (normalised) FSM. interpretFsmMx :: ([String], [[[Int]]]) -> ReadFsmMonad (FSM String)-interpretFsmMx (actionNames, stateLines) = - if all (== (length actionNames)) lineLengths+interpretFsmMx (actionNames, stateLines) =+ if all (== length actionNames) lineLengths then return $ normalise $ fromList $ zip actionNames actions else throwError (FsmError "FSM matrix ill-formed" (show lineLengths)) where actions = map mkAction $ L.transpose stateLines
Data/FsmActions/Graph.hs view
@@ -44,10 +44,10 @@ import Data.Graph.Inductive.Graph (Graph, labEdges, labNodes, Node, LNode, mkGraph) import qualified Data.Graph.Inductive.PatriciaTree as P-import qualified Data.Graph.Inductive.Tree as T +import qualified Data.Graph.Inductive.Tree as T import Data.Graph.Inductive.Query.DFS (scc) import Data.GraphViz-import Data.List (foldr, nub, sort)+import Data.List (nub, sort) import qualified Data.Map as M import Data.Map.Utils (forceLookupM) import Text.PrettyPrint.HughesPJ@@ -145,8 +145,12 @@ -- Turn an FGL into a DotGraph with labelled edges. fglDot :: (Ord b, CleanShow b, Graph gr) => gr a b -> DotGraph Int-fglDot g = graphToDot True g [] nodeFn edgeFn- where nodeFn _ = []+fglDot g = graphToDot parms g+ where parms = nonClusteredParams {+ isDirected = True+ , fmtNode = const []+ , fmtEdge = edgeFn+ } edgeFn (_, _, label) = [Label $ StrLabel $ cleanShow label] @@ -208,8 +212,8 @@ mkActions :: Ord sy => DestsMap sy -> NodeMap -> [Node] -> [sy] -> [(sy, Action)]-mkActions destsMap nodeMap srcs ls =- map (mkAction destsMap nodeMap srcs) ls+mkActions destsMap nodeMap srcs =+ map $ mkAction destsMap nodeMap srcs mkAction :: Ord sy => DestsMap sy -> NodeMap -> [Node] -> sy -> (sy, Action)
Data/FsmActions/IO.hs view
@@ -23,8 +23,8 @@ import Data.Either import Data.List import qualified Data.Map as M+import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.List as L-import Data.Maybe (mapMaybe) import System.FilePath import Data.FsmActions@@ -114,7 +114,4 @@ FsmActionMatrices -> saveActionMxFsm fsm p [] FsmEdges -> saveFsmEdges fsm p FsmMatrix -> saveFsmMx fsm p- where format = case format' of- Just f -> f- -- None specified: use first guess.- Nothing -> head $ fsmFormats p+ where format = fromMaybe (head $ fsmFormats p) format'
Data/FsmActions/WellFormed.hs view
@@ -50,14 +50,14 @@ | length wccs /= 1 = Disconnected wccs | otherwise = WellFormed where -- All (symbol, Action length) pairs in FSM.- actionLengths = fsmMap (\s -> \a -> (s, aLength a)) fsm+ actionLengths = fsmMap (\s a -> (s, aLength a)) fsm -- Submap containing only Actions with bad destinations. -- 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.- flatten (Action xs) = L.concat $ map destinations xs+ flatten (Action xs) = L.concatMap destinations xs -- Check if a destination is bad (negative or too high). badDest x = (x<0) || (x >= length (states fsm)) -- Compute the length of an action@@ -75,7 +75,7 @@ polishFSM :: (Ord sy, Show sy) => FSM sy -> ReadFsmMonad (FSM sy) polishFSM fsm = let norm = normalise fsm in- case (isWellFormed norm) of+ case isWellFormed norm of WellFormed -> return norm Disconnected wccs -> throwError (FsmError "FSM disconnected" (show wccs))
doc/fsmActions.pdf view
binary file changed (140850 → 215660 bytes)
fsmActions.cabal view
@@ -1,5 +1,5 @@ Name: fsmActions-Version: 0.4.2+Version: 0.4.3 Stability: Alpha Synopsis: Finite state machines and FSM actions Description:@@ -26,9 +26,9 @@ Library Build-Depends: base >= 3 && < 5, containers, filepath,- fgl == 5.4.2.2,- graphviz >= 2999.6.0.0 && <= 2999.9.0.0,- MissingH, mtl, parsec, pretty+ fgl >= 5.4.2.3,+ graphviz >= 2999.11.0.0,+ MissingH, mtl, parsec >= 3, pretty Exposed-modules: Data.FsmActions, Data.FsmActions.ActionMatrix, Data.FsmActions.Error,