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

------------------------------------------------------------------------------
--- Some operations to handle the CASS resource configuration file
--- that is stored in `$HOME/.cassrc`
---
--- @author  Michael Hanus
--- @version January 2025
------------------------------------------------------------------------------

module CASS.RCFile
  ( readRCFile, updateProperty )
 where

import Control.Monad     ( unless )
import Data.Either       ( rights )
import Data.List         ( sort )
import Numeric           ( readInt )
import System.IO         ( hPutStrLn, stderr )

import Analysis.Logging  ( DLevel(..), debugMessage )
import Data.PropertyFile ( readPropertyFile, updatePropertyFile )
import System.FilePath   ( FilePath, (</>), (<.>) )
import System.Directory  ( doesDirectoryExist, doesFileExist, getHomeDirectory
                         , renameFile )

import CASS.Configuration (CConfig(..), ccProps, setDebugLevel)

------------------------------------------------------------------------------
--- Initial properties of the default RC template file.
defaultRCProps :: [Either String (String,String)]
defaultRCProps =
  [ Left "# Configuration file for 'cass' (Curry Analysis Server System)"
  , Left ""
  , Left "# The initial default path when the system is started:"
  , Left "# (this path is added at the end of an existing CURRYPATH value)"
  , Right ("path", "")
  , Left ""
  , Left "# The number of workers (if 0, no further processes are started):"
  , Right ("numberOfWorkers", "0")
  , Left ""
  , Left "# Use the tool `curry-info` to import existing analysis infos?"
  , Left "# no  : do not use it"
  , Left "# yes : use the local installation of `curry-info`"
  , Left "# cgi : use the CGI web server of `curry-info`"
  , Right ("curryinfo", "no")
  , Left ""
  , Left "# The method to compute the fixpoint in dependency analyses. Values:"
  , Left "# simple   : simple fixpoint iteration"
  , Left "# wlist    : fixpoint iteration with working lists"
  , Left "# wlistscc : fixpoint iteration with working lists where strongly connected"
  , Left "#            components are computed to guide the individual iterations"
  , Right ("fixpoint", "wlist")
  , Left ""
  , Left "# The command used to wrap the server when the system is started"
  , Left "# in server mode:"
  , Right ("terminalCommand", "gnome-terminal -e")
  , Left ""
  , Left "# The debugging level (between 0 and 4) to show more infos."
  , Left "# Meaning of the debug level:"
  , Left "# 0 : show nothing"
  , Left "# 1 : show worker activity, e.g., timings"
  , Left "# 2 : show server communication"
  , Left "# 3 : ...and show read/store information"
  , Left "# 4 : ...show also stored/computed analysis data"
  , Right ("debugLevel", "0")
  , Left ""
  , Left "# Should the prelude be analyzed? Usually, it should be 'yes'."
  , Left "# The value 'no' is only reasonable for experimental purposes"
  , Left "# (e.g., to test new analyses on small programs)."
  , Right ("prelude", "yes")
  ]

--- The contents of the default RC template file.
defaultRC :: String
defaultRC = unlines $
  map (either id (\ (k,v) -> k ++ "=" ++ v)) defaultRCProps

--- Location of the rc file of a user.
-- Name of user property file:
propertyFileName :: IO String
propertyFileName = (</> ".cassrc") `fmap` getHomeDirectory

--- Install user property file if it does not exist.
installPropertyFile :: IO ()
installPropertyFile = do
  fname <- propertyFileName
  pfexists <- doesFileExist fname
  unless pfexists $ do
    writeFile fname defaultRC
    hPutStrLn stderr $
      "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
     cc@(CConfig userprops dl) <- readPropertiesAndStoreLocally
     let distprops = rights defaultRCProps
     unless (rcKeys userprops == rcKeys distprops) $ do
       rcName <- propertyFileName
       debugMessage dl 1 $ "Updating '" ++ rcName ++ "'..."
       renameFile rcName $ rcName <.> "bak"
       writeFile rcName defaultRC
       mapM_ (\ (n, v) -> maybe (return ())
                 (\uv -> if uv == v then return ()
                                    else updatePropertyFile rcName n uv)
                 (lookup n userprops))
             distprops
     return cc
 where
  rcKeys = sort . map fst

--- Reads the user property file or, if it does not exist,
--- the default property file of CASS,
--- and return the configuration with the properties.
readPropertiesAndStoreLocally :: IO CConfig
readPropertiesAndStoreLocally = do
  userpfn    <- propertyFileName
  hasuserpfn <- doesFileExist userpfn
  props      <- if hasuserpfn
                  then readPropertyFile userpfn
                  else return $ rights defaultRCProps
  return $ updateDebugLevel (CConfig props Quiet)

--- Updates the debug level from the current properties.
updateDebugLevel :: CConfig -> CConfig
updateDebugLevel cc =
  case lookup "debugLevel" (ccProps cc) 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 cc = cc { ccProps = replaceKeyValue pn pv (ccProps cc) }

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

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