{- |

High-level input/output interface for finite state machines.

This module allows one to load and save FSMs, where the format to be
used may be either explicitly specified, or guessed according to the
filename's extension.

-}

-- Copyright (c) 2009 Andy Gimblett - http://www.cs.swan.ac.uk/~csandy/
-- BSD Licence (see http://www.opensource.org/licenses/bsd-license.php)

module Data.FsmActions.IO (
    FsmIO(..),
    fsmFormats,
    loadFsm,
    saveFsm
) where

import Control.Exception
import Data.Char (toLower)
import Data.Either
import Data.List
import qualified Data.Map as M
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.List as L
import System.FilePath

import Data.FsmActions
import Data.FsmActions.ActionMatrix
import Data.FsmActions.Error
import Data.FsmActions.FsmEdges
import Data.FsmActions.FsmMatrix

-- | Known FSM I/O formats.
data FsmIO =
           -- | ActionMatrix format: use
           -- 'Data.FsmActions.ActionMatrix.loadActionMxFsm' and
           -- 'Data.FsmActions.ActionMatrix.saveActionMxFsm'; filename
           -- extensions: actions, actionspec, actionmxs,
           -- actionmatrices, fsmactions.
             FsmActionMatrices
           -- | FsmEdges format: use
           -- 'Data.FsmActions.FsmEdges.loadFsmEdges' and
           -- 'Data.FsmActions.FsmEdges.saveFsmEdges'; filename
           -- extensions: edges, fsmedges, graph, mathematica.
           | FsmEdges
           -- | FsmMatrix format: use
           -- 'Data.FsmActions.FsmMatrix.loadFsmMx' and
           -- 'Data.FsmActions.FsmMatrix.saveFsmMx'; filename
           -- extensions: mx, matrix, fsmmx, fsmmatrix, fsm.
           | FsmMatrix
    deriving (Bounded, Enum, Eq, Ord, Show)

-- | Mapping from 'FsmIO' formats to lists of expected filename
-- extensions for those formats.
fsmIOExts :: M.Map FsmIO [String]
fsmIOExts = M.fromList [
       (FsmActionMatrices, ["actions", "actionspec", "actionmxs",
                            "actionmatrices", "fsmactions",
                            "fsmactionmxs"])
      ,(FsmEdges, ["edges", "fsmedges", "graph", "mathematica"])

      ,(FsmMatrix, ["mx", "matrix", "fsmmx", "fsmmatrix", "fsm"])
      ]

-- | Given a path, return a list of all 'FsmIO' formats, with guesses
-- (according to the file extension) at the front.
fsmFormats :: FilePath -> [FsmIO]
fsmFormats path = guesses ++ ([minBound..maxBound] \\ guesses)
    where guesses = seek `rLookup` fsmIOExts
          (_, ext) = splitExtension path
          seek = L.map toLower (tail ext)

-- | Reverse lookup in map from keys to lists of values.
rLookup :: (Ord k, Eq v) => v -> M.Map k [v] -> [k]
rLookup val m = mapMaybe (uncurry seek) $ M.toList m
    where seek key vs = if val `elem` vs then Just key else Nothing

-- | Read an 'Data.FsmActions.FSM' from a file.  If the user specifies
-- any 'FsmIO' formats, try each of those in turn; otherwise, try
-- every format known, using the filename extension to guess which to
-- try first.
--
-- The returned value is either the resultant 'Data.FsmActions.FSM',
-- or the error message produced by trying to load it with the _first_
-- format (so in the case of guessing formats, if the guess is wrong
-- and the file is corrupt, you might get an unhelpful error message).
loadFsm :: FilePath -> [FsmIO] -> IO (Either FsmError (FSM String))
loadFsm p formats' =
    do results <- mapM (uncurry tryLoadFsm) $ zip (repeat p) formats
       let success = rights results
       case success of
         (fsm:_) -> return $ Right fsm
         _ -> return $ Left $ head $ lefts results
    where formats = if L.null formats' then fsmFormats p
                                       else formats'

-- | Try loading an FSM from a file with a particular format.
tryLoadFsm :: FilePath -> FsmIO -> IO (Either FsmError (FSM String))
tryLoadFsm p f = try (case f of
                        FsmActionMatrices -> loadActionMxFsm p
                        FsmEdges -> loadFsmEdges p
                        FsmMatrix -> loadFsmMx p)

-- | Save an 'Data.FsmActions.FSM' to a file.  If the user specifies
-- an 'FsmIO' format, it is used; otherwise, it is guessed from the
-- filename extension (and failing that, the first guess, ie
-- 'FsmActionMatrices', is used).
saveFsm :: FSM String -> FilePath -> Maybe FsmIO -> IO ()
saveFsm fsm p format' =
    case format of
      FsmActionMatrices -> saveActionMxFsm fsm p []
      FsmEdges -> saveFsmEdges fsm p
      FsmMatrix -> saveFsmMx fsm p
    where format = fromMaybe (head $ fsmFormats p) format'