FsmMatrix.hs

{- |

Serialisation/deserialisation of 'Data.FsmActions.FSM's as FSM transition
matrices.

A 'Data.FsmActions.FSM' may be represented as an transition matrix whose
rows correspond to states of the FSM, and whose columns correspond to
its possible actions (labels on its transitions).  A given cell then
represents the transition(s) from some (row) state under some (column)
action, and contains a comma-separated list of integers: the row
numbers of the destination states.  (Of course, for a deterministic
action, there's just one, and no comma.)  Rows are numbered from 0 and
increment strictly.

-}

module Data.FsmActions.FsmMatrix (
    -- * Input
    parseFsmMxFile,
    parseFsmMx,
    -- * Output
    printFsmMx
) where

import Control.Monad.Error
import Data.Char (isSpace)
import qualified Data.List as L
import System.IO.Error (mkIOError, userErrorType)
import qualified Text.ParserCombinators.Parsec as P
import Text.PrettyPrint.HughesPJ

import Data.FsmActions
import Data.FsmActions.Error
import Data.FsmActions.WellFormed

-- | Parse an FsmMatrix-formatted FSM held in a file, by reading the
-- file and calling 'parseFsmString'.
parseFsmMxFile :: FilePath -> IO (FSM String)
parseFsmMxFile path =
    do contents <- readFile path
       let result = parseFsmMx contents
       case result of
         Right fsm -> return fsm
         Left e -> throwError (mkIOError userErrorType (show e)
                               Nothing (Just path))

-- | Parse an FsmMatrix-formatted FSM held in a string.  Includes
-- normalisation and well-formedness checks.
parseFsmMx :: String -> ReadMxMonad (FSM String)
parseFsmMx fsmString =
    case P.parse fsmMatrixParser "" fsmString of
      Right parts ->
          do fsm <- interpretFsmMx parts
             case (isWellFormed fsm) of
               WellFormed -> return fsm
               Disconnected wccs ->
                   throwError (MxError "FSM disconnected" (show wccs))
               err -> throwError (MxError "FSM matrix ill-formed" (show err))
      Left err ->
          throwError (MxError "FSM matrix parse error" (show err))

-- TODO: there are well-formedness checks here, but not when reading
-- in from action matrices.  Generalise!  Either remove the checks
-- here, or factor them out into an handy "run this after input"
-- function.

-- FsmMatrix-format parser.
fsmMatrixParser :: P.Parser ([String], [[[Int]]])
fsmMatrixParser = do actions <- actionName `P.sepEndBy` nonEOLSpace
                     P.char '\n'
                     transitionRows <- transitionRow `P.sepEndBy` P.char '\n'
                     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 = P.many1 (P.satisfy (not . isSpace))
          -- A row of transitions is a space-separated line of transitions.
          transitionRow :: P.Parser [[Int]]
          transitionRow = transition `P.sepEndBy1` nonEOLSpace
          -- A transition is a comma-separated list of states (no spaces).
          transition :: P.Parser [Int]
          transition = state `P.sepBy1` P.char ','
          -- A state is a natural number.
          state :: P.Parser Int
          state = liftM read (P.many1 P.digit)
          -- Parse whitespace that isn't an end of line.
          nonEOLSpace :: P.Parser String
          nonEOLSpace = P.many1 (P.satisfy (\c -> isSpace c && c /= '\n'))

-- Turn some FsmMatrix-formatted data into an (normalised) FSM.
interpretFsmMx :: ([String], [[[Int]]]) -> ReadMxMonad (FSM String)
interpretFsmMx (actionNames, stateLines) = 
    if all (== (length actionNames)) lineLengths
      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

-- | Pretty-print a string FSM in FsmMatrix format.
printFsmMx :: FSM String -> String
printFsmMx = show . ppFsmMx

-- Pretty printer to FsmMatrix format (building Doc not String).
ppFsmMx :: FSM String -> Doc
ppFsmMx fsm = actionRow $$ transitionRows
    where -- Space-separated list of action names.
          actionRow :: Doc
          --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
          -- Space-separated list of transitions.
          transitionRow :: [DestinationSet] -> Doc
          transitionRow = hsep . map transition
          -- Comma-separated list of state numbers.
          transition :: DestinationSet -> Doc
          transition = commas . map int . destinations
          -- Extract transitions from FSM.
          transitions :: [[DestinationSet]]
          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