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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
module CASS.Main ( main ) where
import Data.Char ( toLower )
import Data.List ( isPrefixOf, sort )
import Control.Monad ( when, unless )
import System.FilePath ( (</>), (<.>) )
import System.Process ( exitWith )
import System.Environment ( getArgs )
import System.Console.GetOpt
import Numeric ( readNat )
import Analysis.Files ( deleteAllAnalysisFiles )
import Analysis.Logging ( debugMessage )
import CASS.Doc ( getAnalysisDoc )
import CASS.Server ( analyzeModuleAndPrint, mainServer )
import CASS.Configuration
import CASS.Registry ( registeredAnalysisInfos, registeredAnalysisNames )
import CASS.Worker ( startWorker )
import System.CurryPath ( stripCurrySuffix )
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) (deleteFiles args)
when ((optServer opts && not (null args)) ||
(not (optServer opts) && length args /= 2))
(error "Illegal arguments (try `-h' for help)" >> exitWith 1)
when (optWorker opts && length args /= 2)
(error "Illegal arguments (try `-h' for help)" >> exitWith 1)
let cconfig1 = foldr (uncurry updateProperty) cconfig (optProp opts)
verb = optVerb opts
cconfig2 = if verb >= 0
then setDebugLevel verb cconfig1
else cconfig1
dl = debugLevel cconfig2
debugMessage dl 1 systemBanner
if optServer opts
then mainServer cconfig2
(let p = optPort opts in if p == 0 then Nothing else Just p)
else
if optWorker opts
then startWorker cconfig2 (head args) (read (args!!1))
else do
let [ananame,mname] = args
fullananame <- checkAnalysisName ananame
debugMessage dl 1 $
"Computing results for analysis `" ++ fullananame ++ "'"
analyzeModuleAndPrint cconfig2 fullananame (stripCurrySuffix mname)
(optAll opts) (optReAna opts)
where
deleteFiles args = case args of
[aname] -> do fullaname <- checkAnalysisName aname
putStrLn $ "Deleting files for analysis `" ++ fullaname ++ "'"
deleteAllAnalysisFiles fullaname
exitWith 0
[] -> error "Missing analysis name!"
_ -> error "Too many arguments (only analysis name should be given)!"
checkAnalysisName :: String -> IO String
checkAnalysisName aname = case matchedNames of
[] -> error $ "Unknown analysis name `"++ aname ++ "' " ++ tryCmt
[raname] -> return raname
(_:_:_) -> error $ "Analysis name `"++ aname ++ "' not unique " ++ tryCmt ++
":\nPossible names are: " ++ unwords matchedNames
where
matchedNames = filter (isPrefixOf (map toLower aname) . map toLower)
registeredAnalysisNames
tryCmt = "(try `-h' for help)"
data Options = Options
{ optHelp :: Bool
, optVerb :: Int
, optServer :: Bool
, optWorker :: Bool
, optPort :: Int
, optAll :: Bool
, optReAna :: Bool
, optDelete :: Bool
, optProp :: [(String,String)]
}
defaultOptions :: Options
defaultOptions = Options
{ optHelp = False
, optVerb = -1
, optServer = False
, optWorker = False
, optPort = 0
, optAll = False
, optReAna = False
, optDelete = False
, optProp = []
}
options :: [OptDescr (Options -> Options)]
options =
[ Option "h?" ["help"] (NoArg (\opts -> opts { optHelp = True }))
"print help and exit"
, Option "q" ["quiet"] (NoArg (\opts -> opts { optVerb = 0 }))
"run quietly (no output)"
, Option "v" ["verbosity"]
(ReqArg (safeReadNat checkVerb) "<n>")
"verbosity/debug level:\n0: quiet (same as `-q')\n1: show worker activity, e.g., timings\n2: show server communication\n3: ...and show read/store information\n4: ...show also stored/computed analysis data\n(default: see debugLevel in ~/.curryanalysisrc)"
, Option "a" ["all"]
(NoArg (\opts -> opts { optAll = True }))
"show-analysis results for all operations\n(i.e., also for non-exported operations)"
, Option "r" ["reanalyze"]
(NoArg (\opts -> opts { optReAna = True }))
"force re-analysis \n(i.e., ignore old analysis information)"
, Option "d" ["delete"]
(NoArg (\opts -> opts { optDelete = True }))
"delete existing analysis results"
, Option "s" ["server"]
(NoArg (\opts -> opts { optServer = True }))
"start analysis system in server mode"
, Option "w" ["worker"]
(NoArg (\opts -> opts { optWorker = True }))
"start analysis system in worker mode"
, Option "p" ["port"]
(ReqArg (safeReadNat (\n opts -> opts { optPort = n })) "<n>")
"port number for communication\n(only for server mode;\n if omitted, a free port number is selected)"
, Option "D" []
(ReqArg checkSetProperty "name=v")
"set property (of ~/.curryanalysisrc)\n`name' as `v'"
]
where
safeReadNat opttrans s opts = case readNat s of
[(n,"")] -> opttrans n opts
_ -> error "Illegal number argument (try `-h' for help)"
checkVerb n opts = if n>=0 && n<5
then opts { optVerb = n }
else error "Illegal verbosity level (try `-h' for help)"
checkSetProperty s opts =
let (key,eqvalue) = break (=='=') s
in if null eqvalue
then error "Illegal property setting (try `-h' for help)"
else opts { optProp = optProp opts ++ [(key,tail eqvalue)] }
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
|