{- |

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 (
) 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