{- | Serialisation/deserialisation of 'Data.FsmActions.FSM's and 'Data.FsmActions.Action's as adjacency matrices. An 'Data.FsmActions.Action' may be represented as an adjacency matrix of 0s and 1s. The rows and columns of the matrix correspond to states of the 'Data.FA.Core.FSM': a 1 in a cell indicates that the 'Data.FsmActions.Action' causes a transition from the \'row\' state to the \'column\' state. If any of the rows in the matrix contain more than one 1, the corresponding 'Data.FsmActions.Action' is a nondeterministic: an 'Data.FsmActions.NAction'. -} -- TODO: tests, working properly for empty strings, single element -- rows, etc. module Data.FsmActions.ActionMatrix ( readFSMFromMxFiles, readAdjMxFromFile, readAdjMxFromString ) where import Control.Monad.Error import qualified Data.ByteString.Char8 as B import qualified Data.List as L import qualified Data.Map as M import Data.Maybe (mapMaybe) import System.IO.Error (mkIOError, userErrorType) import Data.FsmActions import Data.FsmActions.Error -- | This module's internal represenation of adjacency matrices is as -- nested lists of booleans. These are only ever used as intermediate -- data structures, and should not be generated or manipulated -- directly. If you want to work with actions, use the Core -- 'Data.FsmActions.Action' type. If you want serialised matrices for -- storage or transmission, convert them to strings of 0s and 1s using -- the functions in this module. type AdjacencyMatrix = [AdjacencyMatrixRow] type AdjacencyMatrixRow = [AdjacencyMatrixCell] type AdjacencyMatrixCell = Bool -- | Given a list of (symbol, path) pairs, compute an -- 'Data.FsmActions.FSM' whose actions are read from matrices in each of -- the paths using 'readAdjMxFromFile' (and associated with their -- corresponding symbols). -- -- Note that if the same symbol appears multiple times, only one -- instance will appear in the 'Data.FsmActions.FSM'; the choice of which -- appears is not defined. --readFSMFromMxFiles :: Ord sy => [(sy, String)] -> IO (FSM sy) readFSMFromMxFiles :: Ord sy => [(sy, String)] -> IO (FSM sy) readFSMFromMxFiles xs = liftM (FSM . M.fromList) $ mapM (liftMSnd readAdjMxFromFile) xs where liftMSnd :: Monad m => (a -> m b) -> (c, a) -> m (c, b) liftMSnd f (x, y) = f y >>= \z -> return (x, z) -- | Read an action matrix from a specified file; uses -- 'readAdjMxFromString' to interpret the file contents. readAdjMxFromFile :: String -> IO Action readAdjMxFromFile path = do contents <- B.readFile path let act = readAdjMxFromString contents -- Catch error and act appropriately case act of Right a -> return a Left e -> throwError (mkIOError userErrorType (show e) Nothing (Just path)) -- | Given a bytestring we expect to contain a serialisation of an -- adjacency matrix, compute the corresponding 'Data.FsmActions.Action'. -- -- The serialisation format for an 'Data.FsmActions.Action' on an -- /n/-state 'Data.FsmActions.FSM' is as follows: there are /n/ -- (newline-separated) lines, each containing /n/ (comma-separated) 0s -- or 1s. No other characters are allowed (not even whitespace), and -- it is an error for any of the rows to contain anything other than -- /n/ cells. (Note that /n/ is not specified, but inferred from the -- number of lines in the string). readAdjMxFromString :: B.ByteString -> ReadMxMonad Action readAdjMxFromString s = splitMxString s >>= parseActionMatrix -- | Turn a string into an adjacency matrix. splitMxString :: B.ByteString -> ReadMxMonad AdjacencyMatrix splitMxString = mapM readMxRow . B.lines readMxRow :: B.ByteString -> ReadMxMonad AdjacencyMatrixRow readMxRow = mapM readMxCell . B.split ',' readMxCell :: B.ByteString -> ReadMxMonad AdjacencyMatrixCell readMxCell cell = if cell == B.singleton '0' then return False else if cell == B.singleton '1' then return True else throwError (MxError "Bad cell in matrix string" (show cell)) -- | Given an 'AdjacencyMatrix', compute the corresponding -- 'Data.FsmActions.Action'. parseActionMatrix :: AdjacencyMatrix -> ReadMxMonad Action parseActionMatrix rows = if all (== length transitions) rowLengths -- check matrix is square then return $ normaliseAction $ mkAction transitions else throwError (MxError "action matrix is not square (see row lengths)" (show rowLengths)) where transitions = L.map parseActionMatrixRow rows rowLengths = L.map length rows -- | Given an 'AdjacencyMatrixRow', compute the list of indices of -- cells in the row which are set (i.e. which represent transitions). parseActionMatrixRow :: AdjacencyMatrixRow -> [Int] parseActionMatrixRow xs = mapMaybe isSet (withIdxs xs) where -- | Zip the cells of a list together with their indices. withIdxs ys = zip ys [0..(length ys-1)] -- | Iff the cell is set, include its index.. isSet (cell, index) = if cell then Just index else Nothing