Utils.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.CSPM.Utils
-- Copyright   :  (c) Fontaine 2008
-- License     :  BSD
-- 
-- Maintainer  :  fontaine@cs.uni-duesseldorf.de
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Some Utilities

module Language.CSPM.Utils
 (eitherToExc
 ,handleLexError
 ,handleParseError
 ,handleRenameError
 ,parseFile,testFrontend)
where

import Language.CSPM.Parser (ParseError(..),parse)
import Language.CSPM.Rename (RenameError(..),getRenaming,applyRenaming)
import Language.CSPM.Token (Token, LexError(..))
import Language.CSPM.AST (LModule)
import qualified Language.CSPM.LexHelper as Lexer
  (lexInclude,lexPlain,filterIgnoredToken)

import Control.Exception as Exception
import System.CPUTime

-- | "eitherToExe" returns the Right part of "Either" or throws the Left part as an dynamic exception.
eitherToExc :: Exception a => Either a b -> IO b
eitherToExc (Right r) = return r
eitherToExc (Left e) = throw e

-- | Handle a dymanic exception of type "LexError".
handleLexError :: (LexError -> IO a) -> IO a -> IO a
handleLexError handler proc = Exception.catch proc handler

-- | Handle a dymanic exception of type "ParseError".
handleParseError :: (ParseError -> IO a) -> IO a -> IO a
handleParseError handler proc = Exception.catch proc handler

-- | Handle a dymanic exception of type "RenameError".
handleRenameError :: (RenameError -> IO a) -> IO a -> IO a
handleRenameError handler proc = Exception.catch proc handler

-- | Lex and parse a file and return a "LModule", throw an exception in case of an error
parseFile :: FilePath -> IO LModule
parseFile fileName = do
  src <- readFile fileName
  tokenList <- Lexer.lexInclude src >>= eitherToExc
  eitherToExc $ parse fileName tokenList

testFrontend :: FilePath -> IO (LModule,LModule)
testFrontend fileName = do
  src <- readFile fileName

  putStrLn $ "Reading File " ++ fileName
  startTime <- (return $ length src) >> getCPUTime
  tokenList <- Lexer.lexInclude src >>= eitherToExc
  time_have_tokens <- getCPUTime

  ast <- eitherToExc $ parse fileName tokenList
  time_have_ast <- getCPUTime

  renaming <- eitherToExc $ getRenaming ast
  let astNew = applyRenaming renaming ast
  time_have_renaming <- getCPUTime

  putStrLn $ "Parsing OK"
  putStrLn $ "lextime : " ++ showTime (time_have_tokens - startTime)
  putStrLn $ "parsetime : " ++ showTime(time_have_ast - time_have_tokens)
  putStrLn $ "renamingtime : " ++ showTime (time_have_renaming - time_have_ast)
  putStrLn $ "total : " ++ showTime(time_have_ast - startTime)
  return (ast,astNew)
  where
    showTime :: Integer -> String
    showTime a = show (div a 1000000000) ++ "ms"