|
sourcecode:
|
module CASS.Main ( main ) where
import Data.Char ( toLower )
import Data.List ( isPrefixOf, isSuffixOf, sort, init )
import Control.Monad ( when, unless )
import System.CurryPath ( stripCurrySuffix )
import System.FilePath ( (</>), (<.>) )
import System.IO ( hPutStrLn, stderr )
import System.Path ( fileInPath )
import System.Process ( exitWith )
import System.Environment ( getArgs )
import System.Console.GetOpt
import Analysis.Files ( deleteAllAnalysisFiles )
import Analysis.Logging ( debugMessage )
import CASS.Configuration
import CASS.Doc ( getAnalysisDoc )
import CASS.Options
import CASS.RCFile ( readRCFile, updateProperty )
import CASS.Server ( analyzeModuleAndPrint, mainServer )
import CASS.Registry ( registeredAnalysisInfos, registeredAnalysisNames )
import CASS.Worker ( startWorker )
--- Main function to start the analysis system.
--- With option -s or --server, the server is started on a socket.
--- Otherwise, it is started in batch mode to analyze a single module.
main :: IO ()
main = do
argv <- getArgs
let (funopts, args, opterrors) = getOpt Permute options argv
let opts = foldl (flip id) defaultOptions funopts
unless (null opterrors)
(putStr (unlines opterrors) >> putStr usageText >> exitWith 1)
cconfig <- readRCFile
let cconfig0 = cconfig { ccOptions = opts }
when (optHelp opts) (printHelp args >> exitWith 1)
when (optDelete opts) (deleteFilesAndExit args)
when ((optServer opts && not (null args)) ||
(not (optServer opts) && length args /= 2))
(writeErrorAndExit "Illegal arguments (try `-h' for help)")
when (optWorker opts && length args /= 2)
(writeErrorAndExit "Illegal arguments (try `-h' for help)")
let cconfig1 = foldr (uncurry updateProperty) cconfig0 (optProp opts)
verb = optVerb opts
cconfig2 = if verb >= 0 then setDebugLevel verb cconfig1
else cconfig1
cconfig3 <- checkCurryInfoProp cconfig2
let dl = debugLevel cconfig3
debugMessage dl 1 systemBanner
if optServer opts
then mainServer cconfig3
(let p = optPort opts in if p == 0 then Nothing else Just p)
else
if optWorker opts
then startWorker cconfig3 (head args) (read (args!!1))
else do
let [ananame,mname] = args
fullananame <- checkAnalysisName ananame
debugMessage dl 1 $
"Computing results for analysis `" ++ fullananame ++ "'"
analyzeModuleAndPrint cconfig3 fullananame (stripCurrySuffix mname)
(optAll opts) (optFormat opts) (optGenerated opts) (optReAna opts)
where
-- Set curryinfo property to `no` if executable `curry-info` does not exist
checkCurryInfoProp cc = do
if useCurryInfo cc && not (useCurryInfoWeb cc)
then do excurryinfo <- fileInPath "curry-info"
if excurryinfo
then return cc
else do debugMessage (ccDebugLevel cc) 1
"Do not use 'curry-info' since executable not found."
return $ updateProperty "curryinfo" "no" cc
else return cc
deleteFilesAndExit args = case args of
[aname] -> do fullaname <- checkAnalysisName aname
putStrLn $ "Deleting files for analysis `" ++ fullaname ++ "'"
deleteAllAnalysisFiles fullaname
exitWith 0
[] -> writeErrorAndExit "Missing analysis name!"
_ -> writeErrorAndExit
"Too many arguments (only analysis name should be given)!"
writeErrorAndExit :: String -> IO _
writeErrorAndExit msg = hPutStrLn stderr ("ERROR: " ++ msg) >> exitWith 1
-- Checks whether a given analysis name is a unique abbreviation
-- of a registered analysis name and return the registered name.
-- Otherwise, raise an error.
checkAnalysisName :: String -> IO String
checkAnalysisName aname = case matchedNames of
[] -> writeErrorAndExit $
"Unknown analysis name `"++ aname ++ "' " ++ tryCmt
[raname] -> return raname
(_:_:_) -> writeErrorAndExit $
"Analysis name `"++ aname ++ "' not unique " ++ tryCmt ++
":\nPossible names are: " ++ unwords matchedNames
where
laname = map toLower aname
exactMatches = filter ((== laname) . map toLower)
registeredAnalysisNames
prefixMatches = filter (isPrefixOf laname . map toLower)
registeredAnalysisNames
matchedNames = if null exactMatches then prefixMatches else exactMatches
tryCmt = "(try `-h' for help)"
--------------------------------------------------------------------------
-- Printing help:
printHelp :: [String] -> IO ()
printHelp args =
if null args
then putStrLn $ systemBanner ++ "\n" ++ usageText
else do aname <- checkAnalysisName (head args)
getAnalysisDoc aname >>=
maybe (putStrLn $
"Sorry, no documentation for analysis `" ++ aname ++ "'")
putStrLn
-- Help text
usageText :: String
usageText =
usageInfo ("Usage: cass <options> <analysis name> <module name>\n" ++
" or: cass <options> [-s|--server]\n" ++
" or: cass [-w|--worker] <host> <port>\n")
options ++
unlines ("" : "Registered analyses names:" :
"(use option `-h <analysis name>' for more documentation)" :
"" : map showAnaInfo (sort registeredAnalysisInfos))
where
maxName = foldr1 max (map (length . fst) registeredAnalysisInfos) + 1
showAnaInfo (n,t) = n ++ take (maxName - length n) (repeat ' ') ++ ": " ++ t
--------------------------------------------------------------------------
|