1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
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.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.Server ( analyzeModuleAndPrint, mainServer )
import CASS.Registry ( registeredAnalysisInfos, registeredAnalysisNames )
import CASS.Worker ( startWorker )
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
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) cconfig (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
checkCurryInfoProp cc = do
if useCurryInfo 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 = putStrLn ("ERROR: " ++ msg) >> exitWith 1
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)"
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
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
|