CSPM-cspm-0.4.0.0: src/Main.hs

----------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) Fontaine 2010
-- License     :  BSD
-- 
-- Maintainer  :  Fontaine@cs.uni-duesseldorf.de
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Comand line interface for the CSPM tools.
----------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}

module Main
where

import CSPM.Interpreter
import CSPM.Interpreter.Test.CLI (evalEnv)
import CSPM.FiringRules.Trace (trace)
import CSPM.FiringRules.HelperClasses

import CSPM.LTS.MkLtsPar (mkLtsPar)
import CSPM.LTS.ToCsp (ltsToCsp)
import CSPM.LTS.ToDot (mkDotFile)

import Language.CSPM.Frontend (LexError(..),ParseError(..),RenameError(..))
import Language.CSPM.Token (pprintAlexPosn, Token(..))

import System.Console.CmdArgs
import Control.Exception
import System.Exit (exitSuccess, exitFailure)

instance EqOrd INT
instance CSP1 INT
instance CSP2 INT
instance FShow INT

-- | main-funtion for the command line.
main :: IO ()
main = do
  arguments <- cmdArgsRun argParser
  handleException $ execCommand arguments
  exitSuccess

-- definition of the command line parser
argParser :: Mode (CmdArgs Args)
argParser = cmdArgsMode $ modes [evalMode, traceMode, fdrMode, dotMode ]
  &= program "cspm"
  &= summary "cspm command line utility V0.4.0.0"

data Args = 
   Eval {
     evalContext :: Maybe FilePath
    ,evalExpr :: String
    }
  |Trace {
     src    :: FilePath
    ,entry  :: String
    }
  |FDR {
     src    :: FilePath
    ,entry  :: String
    ,out :: Maybe FilePath
    }
  |Dot {
     src    :: FilePath
    ,entry  :: String
    ,out :: Maybe FilePath
    } deriving (Data,Typeable,Show,Eq)

evalMode :: Args
evalMode = Eval {
   evalContext = def
       &= help "optional: CSPM specification to load into context"
       &= typFile 
       &= explicit &= name "s" &= name "src"
  ,evalExpr = def 
       &= help "the expression to evaluate"
       &= typ "EXPR"
       &= argPos 0
  } &= program "evaluate an expression"

traceMode :: Args
traceMode = Trace {
  src = def
    &= help "CSPM specification"
    &= typFile
    &= argPos 0
  ,entry = "MAIN"
    &= help "optional: the main process" 
    &= typ "PROCESS"
    &= explicit &= name "main" &= name "m"
  } &= program "trace a process"

fdrMode :: Args
fdrMode = FDR {
  src = def
    &= help "CSPM specification"
    &= typFile
    &= argPos 0
  ,entry = "MAIN"
    &= help "optional: the main process" 
    &= typ "PROCESS"
    &= explicit &= name "main" &= name "m"
  ,out = def
    &= help "optional: name of the generated fdr file"
    &= typFile
    &= explicit &= name "out" &= name "o"
  } &= program "compute the LTS and dump it as fdr script"

dotMode :: Args
dotMode = Dot {
  src = def
    &= help "CSPM specification"
    &= typFile
    &= argPos 0
  ,entry = "MAIN"
    &= help "optional: the main process" 
    &= typ "PROCESS"
    &= explicit &= name "main" &= name "m"
  ,out = def
    &= help "optional: name of the generated dot file"
    &= typFile
    &= explicit &= name "out" &= name "o"
  } &= program "compute the LTS and dump it as dot graph"

-- execute the command according to command line arguments
execCommand :: Args -> IO ()
execCommand Eval {..} = do
  isVerbose <- isLoud
  (val,_) <- evalEnv isVerbose evalContext evalExpr
  print val

execCommand Trace {..} = do
  (proc,sigma) <- mkProcess src entry
  trace sigma proc

execCommand FDR {..} = do
  (proc,sigma) <- mkProcess src entry
  let
    lts = mkLtsPar sigma proc
    outFile = case out of
      Just f -> f
      Nothing -> src  ++ ".fdr"
  ltsToCsp proc lts outFile
  return ()

execCommand Dot {..} = do
  (proc,sigma) <- mkProcess src entry
  let
    lts = mkLtsPar sigma proc
    outFile = case out of
      Just f -> f
      Nothing -> src ++ ".dot"
  mkDotFile outFile lts
  return ()

mkProcess :: FilePath -> String -> IO (Process, ClosureSet)
mkProcess file expr = do
  isVerbose <- isLoud
  (proc, env) <- evalEnv isVerbose (Just file) expr
  case proc of
    VProcess p -> return (p, getAllEvents env)
    _ -> error "type-error : entry-point is not a process"

-- example exception handler
handleException :: IO () -> IO ()
handleException x
  = x `catches` allHandler
  where
    allHandler = [
        Handler lexError, Handler parseError, Handler renameError
       ,Handler errCall
       ,Handler async  -- pressing CTRL c
       ,Handler ioExc  -- file not found etc
       ,Handler someExc ]
    lexError :: LexError -> IO ()
    lexError LexError {..} = do
      putStrLn "lexError"
      putStrLn $ pprintAlexPosn lexEPos
      putStrLn $ lexEMsg
      exitFailure
    parseError :: ParseError -> IO ()
    parseError ParseError {..}  = do
      putStrLn "parseError"
      putStrLn $ parseErrorMsg
      putStrLn $ pprintAlexPosn parseErrorPos
      putStrLn $ "at token : " ++ (show $ tokenString parseErrorToken)
      exitFailure
    renameError :: RenameError -> IO ()
    renameError RenameError {..} = do
      putStrLn "renameError"
      putStrLn $ renameErrorMsg
      putStrLn $ show renameErrorLoc
      exitFailure
    ioExc :: IOException -> IO ()
    ioExc err = do
      putStrLn $ show err
      exitFailure
    errCall :: ErrorCall -> IO ()
    errCall err = flip catches allHandler $ do
      putStrLn "unexpected error call"
      putStrLn $ show err
      exitFailure
    async :: AsyncException -> IO ()
    async err = do
      putStrLn "AsyncException (Pressing CRTL C ?)"
      putStrLn $ show err
      exitFailure
    someExc :: SomeException -> IO ()
    someExc err = do
      putStrLn $ show err
      exitFailure