{- |

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 (
    -- * I/O
    loadFsmMx,
    saveFsmMx,
    -- * Parsing
    parseFsmMx,
    -- * Pretty-printing
    printFsmMx
) where

import Control.Exception
import Control.Monad.Error
import Data.Char (isSpace)
import qualified Data.List as L
import qualified Text.ParserCombinators.Parsec as P
import Text.PrettyPrint.HughesPJ

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

-- | Load an 'Data.FsmActions.FSM' from an FsmMatrix file.
loadFsmMx :: FilePath -> IO (FSM String)
loadFsmMx path =
    do contents <- readFile path
       let result = parseFsmMx contents
       case result of
         Right fsm -> return fsm
         Left e -> throw $ FsmError (show e) path

-- | Save an 'Data.FsmActions.FSM' to an FsmMatrix file.
saveFsmMx :: FSM String -> FilePath -> IO ()
saveFsmMx fsm mxPath = do let mx = printFsmMx fsm
                          writeFile mxPath mx



-- | Parse an FsmMatrix-formatted FSM held in a string.  Includes
-- normalisation and well-formedness checks.
parseFsmMx :: String -> ReadFsmMonad (FSM String)
parseFsmMx fsmString =
    case P.parse fsmMatrixParser "" fsmString of
      Right parts -> interpretFsmMx parts >>= polishFSM
      Left err -> throw $ FsmError "FSM matrix parse error" (show err)

-- 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]]]) -> ReadFsmMonad (FSM String)
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
          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