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
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
--------------------------------------------------------------------------
--- This module supports the configuration of the analysis system
--- and provides access to some values in Config file.
---
--- It also provides an operation to get the port number of
--- the analysis server (which is implicitly started if necessary).
---
--- @author Michael Hanus
--- @version April 2021
--------------------------------------------------------------------------

module CASS.Configuration
 ( systemBanner, baseDir, docDir, executableName
 , CConfig, debugLevel, setDebugLevel
 , getServerAddress, readRCFile, updateProperty
 , fixpointMethod, withPrelude
 , storeServerPortNumber, removeServerPortNumber
 , getDefaultPath, waitTime, numberOfWorkers
 ) where

import Control.Monad               ( unless )
import Curry.Compiler.Distribution ( curryCompiler )
import Data.List                   ( sort )
import Numeric                     ( readInt )
import System.Environment          ( getEnv )
import System.FilePath             ( FilePath, (</>), (<.>) )

import System.Process
import System.Directory

import Analysis.Logging   ( DLevel(..) )
import CASS.PackageConfig ( packagePath, packageExecutable, packageVersion )
import Data.PropertyFile  ( readPropertyFile, updatePropertyFile )

systemBanner :: String
systemBanner =
  let bannerText = "CASS: Curry Analysis Server System (Version " ++
                   packageVersion ++ " of 16/04/2021 for " ++
                   curryCompiler ++ ")"
      bannerLine = take (length bannerText) (repeat '=')
   in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine


--- The base directory of the analysis tool containing all programs
--- and documentations.
--- It is used to copy the configuration file, to the find executables
--- of the server and the workers, and to find the documentation
--- of the various analyses.
baseDir :: String
baseDir = packagePath

--- The directory containing the documentations of the various analyses.
docDir :: String
docDir = baseDir </> "docs"

--- The name of the main executable. Used to start workers in `CASS.Server`.
executableName :: String
executableName = packageExecutable

--- The address of the server when it is connected from the worker clients.
getServerAddress :: IO String
getServerAddress = return "127.0.0.1" -- run only on local machine

-- timeout for network message passing: -1 is wait time infinity
waitTime :: Int
waitTime = -1

-- Default number of workers (if the number is not found in the
-- configuration file).
defaultWorkers :: Int
defaultWorkers = 0

--------------------------------------------------------------------------
--- Configuration info used during execution of CASS.
--- It contains the properties from the rc file and the current debug level.
data CConfig = CConfig [(String,String)] DLevel

--- Returns the debug level from the current configuration.
debugLevel :: CConfig -> DLevel
debugLevel (CConfig _ dl) = dl

--- Returns the debug level from the current configuration.
setDebugLevel :: Int -> CConfig -> CConfig
setDebugLevel dl (CConfig ps _) = CConfig ps (toEnum dl)

-- Returns the fixpoint computation method from Config file
fixpointMethod :: CConfig -> String
fixpointMethod (CConfig properties _) =
  maybe "simple" id  (lookup "fixpoint" properties)

-- Get the option to analyze also the prelude from Config file
withPrelude :: CConfig -> Bool
withPrelude (CConfig properties _) =
  maybe True (/="no") (lookup "prelude" properties)

--- Gets the default load path from the property file (added at the end
--- of CURRYPATH).
getDefaultPath :: CConfig -> IO String
getDefaultPath (CConfig properties _) = do
  currypath <- getEnv "CURRYPATH"
  return $ case lookup "path" properties of
    Just value -> if all isSpace value
                    then currypath
                    else if null currypath then value
                                           else currypath ++ ':' : value
    Nothing    -> currypath

-- number of worker threads running at the same time
numberOfWorkers :: CConfig -> Int
numberOfWorkers (CConfig properties _) = do
  case lookup "numberOfWorkers" properties of
    Just value -> case readInt value of
                    [(int,_)] -> int
                    _         -> defaultWorkers
    Nothing    -> defaultWorkers

--------------------------------------------------------------------------
-- Name of user property file:
propertyFileName :: IO String
propertyFileName = getHomeDirectory >>= return . (</> ".curryanalysisrc")

defaultPropertyFileName :: String
defaultPropertyFileName = baseDir </> "curryanalysisrc"

--- Install user property file if it does not exist.
installPropertyFile :: IO ()
installPropertyFile = do
  fname <- propertyFileName
  pfexists <- doesFileExist fname
  unless pfexists $ do
    copyFile defaultPropertyFileName fname
    putStrLn $ "New analysis configuration file '" ++ fname ++ "' installed."

--- Reads the rc file (and try to install a user copy of it if it does not
--- exist) and returns its definition. Additionally, the definitions
--- are compared with the default property file of the CASS distribution.
--- If the set of variables is different, the rc file of the user is updated
--- with the distribution but the user's definitions are kept.
readRCFile :: IO CConfig
readRCFile = do
  hashomedir <- getHomeDirectory >>= doesDirectoryExist
  if not hashomedir
   then readPropertiesAndStoreLocally
   else do
     installPropertyFile
     CConfig userprops dl <- readPropertiesAndStoreLocally
     distprops <- readPropertyFile defaultPropertyFileName
     unless (rcKeys userprops == rcKeys distprops) $ do
       rcName <- propertyFileName
       putStrLn $ "Updating '" ++ rcName ++ "'..."
       renameFile rcName $ rcName <.> "bak"
       copyFile defaultPropertyFileName rcName
       mapM_ (\ (n, v) -> maybe (return ())
                 (\uv -> if uv == v then return ()
                                    else updatePropertyFile rcName n uv)
                 (lookup n userprops))
             distprops
     return (CConfig userprops dl)

rcKeys :: [(String, String)] -> [String]
rcKeys = sort . map fst

--- Reads the user property file or, if it does not exist,
--- the default property file of CASS,
--- and store the properties in a global variable for next access.
readPropertiesAndStoreLocally :: IO CConfig
readPropertiesAndStoreLocally = do
  userpfn    <- propertyFileName
  hasuserpfn <- doesFileExist userpfn
  props      <- readPropertyFile
                  (if hasuserpfn then userpfn else defaultPropertyFileName)
  return $ updateDebugLevel (CConfig props Quiet)

--- Updates the debug level from the current properties.
updateDebugLevel :: CConfig -> CConfig
updateDebugLevel cc@(CConfig properties _) =
  case lookup "debugLevel" properties of
    Just value -> case readInt value of
                    [(dl,_)] -> setDebugLevel dl cc
                    _        -> cc
    Nothing    -> cc

-- Updates a property.
updateProperty :: String -> String -> CConfig -> CConfig
updateProperty pn pv (CConfig currprops dl) =
  let newprops = replaceKeyValue pn pv currprops
  in updateDebugLevel (CConfig newprops dl)

replaceKeyValue :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
replaceKeyValue k v []            = [(k,v)]
replaceKeyValue k v ((k1,v1):kvs) =
  if k == k1 then (k,v) : kvs
             else (k1,v1) : replaceKeyValue k v kvs


--------------------------------------------------------------------------
--- Gets the name of file containing the current server port and pid
--- ($HOME has to be set)
getServerPortFileName :: IO String
getServerPortFileName = do
  homeDir <- getHomeDirectory
  return $ homeDir++"/.curryanalysis.port"

--- Stores the current server port number together with the pid of
--- the server process.
storeServerPortNumber :: Int -> IO ()
storeServerPortNumber portnum = do
  mypid <- getPID
  serverPortFileName <- getServerPortFileName
  writeFile serverPortFileName (show (portnum,mypid))

--- Removes the currently stored server port number.
removeServerPortNumber :: IO ()
removeServerPortNumber = getServerPortFileName >>= removeFile

readServerPortPid :: IO (Int,Int)
readServerPortPid = getServerPortFileName >>= readFile >>= return . read

--------------------------------------------------------------------------