Main.hs

module Main where

import Control.Monad
import Control.Monad.Trans
import Data.List
import System.Console.GetOpt
import System.Directory
import System.Environment
import System.FilePath
import System.Exit
import System.IO

import qualified Paths_cspmchecker as C
import Data.Version (showVersion)

import CSPM
import qualified CSPM.CommandLineOptions as CSPM
import CSPM.PrettyPrinter
import Monad
import Util.Annotated
import Util.Exception
import Util.PrettyPrint

countSuccesses :: [Checker Bool] -> Checker ()
countSuccesses tasks = do
    results <- sequence tasks
    let 
        failed = length $ filter id results
        succeeded = length $ filter id results
        total = length tasks
    if failed+succeeded > 1 then do
        liftIO $ putStrLn $ show succeeded++" files succeeded out of "++show total
    else return ()

getFilesFromDir :: FilePath -> IO [FilePath]
getFilesFromDir path = do
    all <- getDirectoryContents path
    let all' = [path++"/"++f | f <- all]
    files <- filterM doesFileExist all'
    dirs <- filterM doesDirectoryExist all'
    let 
        dirs' = filter (\f -> not $ (isSuffixOf "." f) 
                                    || (isSuffixOf ".." f)) dirs
        files' = filter (isSuffixOf ".csp") files
    fss <- mapM getFilesFromDir [dir | dir <- dirs']
    return $ files'++concat fss

doFile :: Options -> FilePath -> Checker Bool
doFile opts fp = do
    liftIO $ putStr $ "Checking "++fp++"....."
    res <- tryM $ convertExceptionsToPanics $ do
        CSPM.setOptions (cspmOptions opts)
        ms <- parseFile fp
        rms <- CSPM.renameFile ms
        typeCheckFile rms
        return ()
    ws <- getState lastWarnings
    resetCSPM
    case res of
        Left e -> do
            printError ("\n"++show e)
            return False
        Right _ -> do
            liftIO $ putStrLn $ "Ok"
            if ws /= [] then printError (show (prettyPrint ws))
            else return ()
            return True

printError :: String -> Checker ()
printError s = liftIO $ putStrLn $ "\ESC[1;31m\STX"++s++"\ESC[0m\STX"

data Options = Options {
        recursive :: Bool,
        help :: Bool,
        printVersion :: Bool,
        cspmOptions :: CSPM.Options
    }

defaultOptions :: Options
defaultOptions = Options { 
        recursive = False, 
        help = False,
        printVersion = False,
        cspmOptions = CSPM.defaultOptions
    }

options :: [OptDescr (Options -> Options)]
options = [
    Option ['v'] ["version"] 
        (NoArg (\o -> o { printVersion = True }))
        "Print out the version number",
    Option ['r'] ["recursive"] 
        (NoArg (\o -> o { recursive = True })) 
        "If the input file is a directory, check all files contained in all subdirectories",
    Option ['h'] ["help"] 
        (NoArg (\o -> o { help = True })) 
        "Display usage message"
    ]
    ++ CSPM.allOptions cspmOptions (\ opts x -> opts { cspmOptions = x })

header :: String
header = "Usage: cspmchecker [OPTION...] files..."

main :: IO ()
main = do
    args <- getArgs
    st <- initCheckerState
    runChecker st $ case getOpt RequireOrder options args of
        (_,_,e:es) -> liftIO $ putStr $ concat (e:es) ++ usageInfo header options
        (o,files, []) -> do
            let opts = foldl (flip id) defaultOptions o
            case (opts, files) of
                (Options { printVersion = True }, []) ->
                    liftIO $ putStrLn $ show $ 
                        text "cspmchecker version" <+> text (showVersion C.version)
                        $$
                        text "using libcspm version" <+> text (showVersion getLibCSPMVersion)
                (Options { help = True }, []) -> 
                    liftIO $ putStr $ usageInfo header options
                (Options { recursive = True }, dirs) -> do
                    tasks <- mapM (liftIO . getFilesFromDir) dirs
                    countSuccesses (map (doFile opts) (concat tasks))
                (_, []) -> 
                    liftIO $ putStr $ usageInfo header options
                (_, files) -> 
                    countSuccesses (map (doFile opts) files)