Config.curry 12.6 KB
Newer Older
Michael Hanus's avatar
Michael Hanus committed
1
------------------------------------------------------------------------------
Michael Hanus's avatar
Michael Hanus committed
2
3
4
--- This module defines the data type for CPM's configuration options, the 
--- default values for all options, and functions for reading the user's .cpmrc
--- file and merging its contents into the default options.
Michael Hanus's avatar
Michael Hanus committed
5
------------------------------------------------------------------------------
Michael Hanus's avatar
Michael Hanus committed
6
7
8

module CPM.Config 
  ( Config ( Config, packageInstallDir, binInstallDir, repositoryDir
Michael Hanus's avatar
Michael Hanus committed
9
           , appPackageDir, packageIndexURL, homePackageDir, curryExec
Michael Hanus's avatar
Michael Hanus committed
10
           , compilerVersion, compilerBaseVersion, baseVersion )
Michael Hanus's avatar
Michael Hanus committed
11
12
  , readConfigurationWith, defaultConfig
  , showConfiguration, showCompilerVersion ) where
Michael Hanus's avatar
Michael Hanus committed
13

Michael Hanus's avatar
Michael Hanus committed
14
import Char         ( toUpper )
Michael Hanus's avatar
Michael Hanus committed
15
16
import Directory    ( doesDirectoryExist, createDirectoryIfMissing
                    , getHomeDirectory )
Michael Hanus's avatar
Michael Hanus committed
17
import qualified Distribution as Dist
Michael Hanus's avatar
Michael Hanus committed
18
19
20
21
22
23
import FilePath     ( (</>), isAbsolute )
import Function     ( (***) )
import IOExts       ( evalCmd )
import List         ( split, splitOn, intersperse )
import Maybe        ( mapMaybe )
import Read         ( readInt )
Michael Hanus's avatar
Michael Hanus committed
24

Michael Hanus's avatar
Michael Hanus committed
25
26
import Data.PropertyFile ( readPropertyFile )
import System.Path       ( getFileInPath )
Michael Hanus's avatar
Michael Hanus committed
27

Michael Hanus's avatar
Michael Hanus committed
28
import CPM.ErrorLogger
Michael Hanus's avatar
Michael Hanus committed
29
import CPM.FileUtil ( ifFileExists )
Michael Hanus's avatar
Michael Hanus committed
30
import CPM.Helpers  ( strip )
Michael Hanus's avatar
Michael Hanus committed
31

Michael Hanus's avatar
Michael Hanus committed
32
33
34
--- The default location of the central package index.
packageIndexDefaultURL :: String
packageIndexDefaultURL =
Michael Hanus's avatar
Michael Hanus committed
35
  "https://git.ps.informatik.uni-kiel.de/curry-packages/cpm-index.git"
Michael Hanus's avatar
Michael Hanus committed
36
37
-- If you have an ssh access to git.ps.informatik.uni-kiel.de:
-- "ssh://git@git.ps.informatik.uni-kiel.de:55055/curry-packages/cpm-index.git"
Michael Hanus's avatar
Michael Hanus committed
38
39
40
41
42
43
44
45
46

--- Data type containing the main configuration of CPM.
data Config = Config {
    --- The directory where locally installed packages are stored
    packageInstallDir :: String
    --- The directory where executable of locally installed packages are stored
  , binInstallDir :: String
    --- Directory where the package repository is stored
  , repositoryDir :: String
Michael Hanus's avatar
Michael Hanus committed
47
    --- Directory where the application packages are stored (cmd 'install')
Michael Hanus's avatar
Michael Hanus committed
48
  , appPackageDir :: String
Michael Hanus's avatar
Michael Hanus committed
49
    --- URL to the package index repository
Michael Hanus's avatar
Michael Hanus committed
50
  , packageIndexURL :: String
Michael Hanus's avatar
Michael Hanus committed
51
52
    --- The directory where the default home package is stored
  , homePackageDir :: String
Michael Hanus's avatar
Michael Hanus committed
53
54
    --- The executable of the Curry system used to compile and check packages
  , curryExec :: String
Michael Hanus's avatar
Michael Hanus committed
55
56
    --- The compiler version (name,major,minor,rev) used to compile packages
  , compilerVersion :: (String,Int,Int,Int)
Michael Hanus's avatar
Michael Hanus committed
57
    --- The version of the base libraries used by the compiler
Michael Hanus's avatar
Michael Hanus committed
58
59
  , compilerBaseVersion :: String
    --- The version of the base libraries to be used for package installations
Michael Hanus's avatar
Michael Hanus committed
60
  , baseVersion :: String
Michael Hanus's avatar
Michael Hanus committed
61
62
63
64
65
66
67
68
69
  }

--- CPM's default configuration values. These are used if no .cpmrc file is found
--- or a new value for the option is not specified in the .cpmrc file.
defaultConfig :: Config
defaultConfig = Config
  { packageInstallDir      = "$HOME/.cpm/packages"
  , binInstallDir          = "$HOME/.cpm/bin"
  , repositoryDir          = "$HOME/.cpm/index" 
Michael Hanus's avatar
Michael Hanus committed
70
  , appPackageDir          = ""
Michael Hanus's avatar
Michael Hanus committed
71
  , packageIndexURL        = packageIndexDefaultURL
Michael Hanus's avatar
Michael Hanus committed
72
  , homePackageDir         = ""
Michael Hanus's avatar
Michael Hanus committed
73
74
75
  , curryExec              = Dist.installDir </> "bin" </> Dist.curryCompiler
  , compilerVersion        = ( Dist.curryCompiler
                             , Dist.curryCompilerMajorVersion
Michael Hanus's avatar
Michael Hanus committed
76
77
                             , Dist.curryCompilerMinorVersion
                             , Dist.curryCompilerRevisionVersion )
Michael Hanus's avatar
Michael Hanus committed
78
79
  , compilerBaseVersion    = Dist.baseVersion
  , baseVersion            = ""
80
81
  }

Michael Hanus's avatar
Michael Hanus committed
82
83
84
--- Shows the configuration.
showConfiguration :: Config -> String
showConfiguration cfg = unlines
Michael Hanus's avatar
Michael Hanus committed
85
  [ "Compiler version       : " ++ showCompilerVersion cfg
Michael Hanus's avatar
Michael Hanus committed
86
  , "Compiler base version  : " ++ compilerBaseVersion cfg
Michael Hanus's avatar
Michael Hanus committed
87
88
89
90
91
92
  , "BASE_VERSION           : " ++ baseVersion         cfg
  , "CURRY_BIN              : " ++ curryExec           cfg
  , "REPOSITORY_PATH        : " ++ repositoryDir       cfg
  , "PACKAGE_INSTALL_PATH   : " ++ packageInstallDir   cfg
  , "BIN_INSTALL_PATH       : " ++ binInstallDir       cfg
  , "APP_PACKAGE_PATH       : " ++ appPackageDir       cfg
Michael Hanus's avatar
Michael Hanus committed
93
  , "HOME_PACKAGE_PATH      : " ++ homePackageDir      cfg
Michael Hanus's avatar
Michael Hanus committed
94
  , "PACKAGE_INDEX_URL      : " ++ packageIndexURL     cfg
Michael Hanus's avatar
Michael Hanus committed
95
96
  ]
  
97
98
99
--- Shows the compiler version in the configuration.
showCompilerVersion :: Config -> String
showCompilerVersion cfg =
Michael Hanus's avatar
Michael Hanus committed
100
101
102
103
104
105
106
  let (cname,cmaj,cmin,crev) = compilerVersion cfg
  in cname ++ ' ' : showVersionNumer (cmaj,cmin,crev)

--- Shows a version consisting of major/minor,revision number.
showVersionNumer :: (Int,Int,Int) -> String
showVersionNumer (maj,min,rev) =
  show maj ++ "." ++ show min ++ "." ++ show rev
107

Michael Hanus's avatar
Michael Hanus committed
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
--- Sets an existing compiler executable in the configuration.
--- Try to use the predefined CURRYBIN value.
--- If it is an absolute path name but does not exists,
--- try to find the executable "curry" in the path.
setCompilerExecutable :: Config -> IO Config
setCompilerExecutable cfg = do
  let exec = curryExec cfg
  if isAbsolute exec
    then ifFileExists exec (return cfg) (findExecutable "curry")
    else findExecutable exec
 where
  findExecutable exec =
    getFileInPath exec >>=
    maybe (error $ "Executable '" ++ exec ++ "' not found in path!")
          (\absexec -> return cfg { curryExec = absexec })

Michael Hanus's avatar
Michael Hanus committed
124
125
126
127
128
129
--- Sets the `appPackageDir` depending on the compiler version.
setAppPackageDir :: Config -> IO Config
setAppPackageDir cfg
  | null (appPackageDir cfg)
  = do homedir <- getHomeDirectory
       let cpmdir = homedir </> ".cpm"
Michael Hanus's avatar
Michael Hanus committed
130
131
           (cname,cmaj,cmin,crev) = compilerVersion cfg
           cmpname = cname ++ "_" ++ showVersionNumer (cmaj,cmin,crev)
Michael Hanus's avatar
Michael Hanus committed
132
133
134
       return cfg { appPackageDir = cpmdir </> "apps_" ++ cmpname }
  | otherwise = return cfg

Michael Hanus's avatar
Michael Hanus committed
135
136
137
138
139
--- Sets the `homePackageDir` depending on the compiler version.
setHomePackageDir :: Config -> IO Config
setHomePackageDir cfg
  | null (homePackageDir cfg)
  = do homedir <- getHomeDirectory
Michael Hanus's avatar
Michael Hanus committed
140
141
142
       let cpmdir = homedir </> ".cpm"
       excpmdir <- doesDirectoryExist cpmdir
       if excpmdir
Michael Hanus's avatar
Michael Hanus committed
143
144
145
         then let (cname,cmaj,cmin,crev) = compilerVersion cfg
                  cvname     = cname ++ "-" ++ showVersionNumer (cmaj,cmin,crev)
                  homepkgdir = cpmdir </> cvname ++ "-homepackage"
Michael Hanus's avatar
Michael Hanus committed
146
              in return cfg { homePackageDir = homepkgdir }
Michael Hanus's avatar
Michael Hanus committed
147
         else return cfg
Michael Hanus's avatar
Michael Hanus committed
148
149
  | otherwise = return cfg

150
151
--- Sets the correct compiler version in the configuration.
setCompilerVersion :: Config -> IO Config
Michael Hanus's avatar
Michael Hanus committed
152
153
setCompilerVersion cfg0 = do
  cfg <- setCompilerExecutable cfg0
Michael Hanus's avatar
Michael Hanus committed
154
  let initbase = baseVersion cfg
Michael Hanus's avatar
Michael Hanus committed
155
156
  if curryExec cfg == Dist.installDir </> "bin" </> Dist.curryCompiler
    then return cfg { compilerVersion = currVersion
Michael Hanus's avatar
Michael Hanus committed
157
158
159
160
                    , compilerBaseVersion = Dist.baseVersion
                    , baseVersion         = if null initbase
                                              then Dist.baseVersion
                                              else initbase }
161
    else do (sname,svers,sbver) <- getCompilerVersion (curryExec cfg)
162
163
            let cname = strip sname
                cvers = strip svers
Michael Hanus's avatar
Michael Hanus committed
164
                bvers = strip sbver
Michael Hanus's avatar
Michael Hanus committed
165
166
                (majs:mins:revs:_) = split (=='.') cvers
            debugMessage $ unwords ["Compiler version:",cname,cvers]
Michael Hanus's avatar
Michael Hanus committed
167
            debugMessage $ "Base lib version: " ++ bvers
Michael Hanus's avatar
Michael Hanus committed
168
169
            return cfg { compilerVersion = (cname, readInt majs,
                                            readInt mins, readInt revs)
Michael Hanus's avatar
Michael Hanus committed
170
171
172
173
                       , compilerBaseVersion = bvers
                       , baseVersion         = if null initbase
                                                 then bvers
                                                 else initbase }
174
 where
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
  getCompilerVersion currybin = do
    debugMessage $ "Getting version information from " ++ currybin
    (r,s,e) <- evalCmd currybin
                 ["--compiler-name","--numeric-version","--base-version"] ""
    if r>0
      then error $ "Cannot determine compiler version:\n" ++ e
      else case lines s of
        [sname,svers,sbver] -> return (sname,svers,sbver)
        _ -> do debugMessage $ "Query version information again..."
                (c1,sname,e1) <- evalCmd currybin ["--compiler-name"] ""
                (c2,svers,e2) <- evalCmd currybin ["--numeric-version"] ""
                (c3,sbver,e3) <- evalCmd currybin ["--base-version"] ""
                when (c1 > 0 || c2 > 0 || c3 > 0) $
                  error $ "Cannot determine compiler version:\n" ++
                          unlines (filter (not . null) [e1,e2,e3])
                return (sname,svers,sbver)

Michael Hanus's avatar
Michael Hanus committed
192
  currVersion = (Dist.curryCompiler, Dist.curryCompilerMajorVersion,
Michael Hanus's avatar
Michael Hanus committed
193
194
                                     Dist.curryCompilerMinorVersion
                                   , Dist.curryCompilerRevisionVersion)
Michael Hanus's avatar
Michael Hanus committed
195

Michael Hanus's avatar
Michael Hanus committed
196
197
198
--- Reads the .cpmrc file from the user's home directory (if present) and
--- merges its contents and some given default settings (first argument)
--- into the configuration used by CPM.
Michael Hanus's avatar
Michael Hanus committed
199
--- Resolves the $HOME variable after merging and creates
Michael Hanus's avatar
Michael Hanus committed
200
201
202
--- any missing directories. May return an error using `Left`.
readConfigurationWith :: [(String,String)] -> IO (Either String Config)
readConfigurationWith defsettings = do
Michael Hanus's avatar
Michael Hanus committed
203
204
205
206
  home <- getHomeDirectory
  configFile <- return $ home </> ".cpmrc"
  settingsFromFile <-
    ifFileExists configFile
Michael Hanus's avatar
Michael Hanus committed
207
                 (readPropertyFile configFile >>= return . stripProps)
Michael Hanus's avatar
Michael Hanus committed
208
209
210
211
212
                 (return [])
  let mergedSettings = mergeConfigSettings defaultConfig
                         (settingsFromFile ++ stripProps defsettings)
  case mergedSettings of
    Left e   -> return $ Left e
213
214
    Right s0 -> do s1 <- replaceHome s0
                   s2 <- setCompilerVersion s1
Michael Hanus's avatar
Michael Hanus committed
215
216
217
218
                   s3 <- setAppPackageDir   s2
                   s4 <- setHomePackageDir  s3
                   createDirectories s4
                   return $ Right s4
Michael Hanus's avatar
Michael Hanus committed
219
220
221
222
223
224
225
226

replaceHome :: Config -> IO Config
replaceHome cfg = do
  homeDir <- getHomeDirectory
  return $ cfg {
      packageInstallDir = replaceHome' homeDir (packageInstallDir cfg)
    , binInstallDir     = replaceHome' homeDir (binInstallDir cfg)
    , repositoryDir     = replaceHome' homeDir (repositoryDir cfg)
Michael Hanus's avatar
Michael Hanus committed
227
    , appPackageDir     = replaceHome' homeDir (appPackageDir cfg)
Michael Hanus's avatar
Michael Hanus committed
228
229
230
231
232
233
234
235
236
  }
 where
  replaceHome' h s = concat $ intersperse h $ splitOn "$HOME" s

createDirectories :: Config -> IO ()
createDirectories cfg = do
  createDirectoryIfMissing True (packageInstallDir cfg)
  createDirectoryIfMissing True (binInstallDir cfg)
  createDirectoryIfMissing True (repositoryDir cfg)
Michael Hanus's avatar
Michael Hanus committed
237
  createDirectoryIfMissing True (appPackageDir cfg)
Michael Hanus's avatar
Michael Hanus committed
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

--- Merges configuration options from a configuration file or argument options
--- into a configuration record. May return an error using Left.
---
--- @param cfg - the configuration record to merge into
--- @param opts - the options to merge
mergeConfigSettings :: Config -> [(String, String)] -> Either String Config
mergeConfigSettings cfg props = applyEither setters cfg
 where
  setters = map maybeApply props
  maybeApply (k, v) = case lookup k keySetters of
    Nothing -> \_ -> Left $ "Unknown .cpmrc property: " ++ k ++ "\n\n" ++
                            "The following .cpmrc properties are allowed:\n" ++
                            unlines (map fst keySetters)
    Just  s -> \c -> Right $ s v c

Michael Hanus's avatar
Michael Hanus committed
254
255
--- Removes leading and trailing whitespaces from option keys and values
--- and transforms option keys to uppercase where underscores are removed.
Michael Hanus's avatar
Michael Hanus committed
256
257
258
---
--- @param opts - the options
stripProps :: [(String, String)] -> [(String, String)]
Michael Hanus's avatar
Michael Hanus committed
259
stripProps = map ((map toUpper . filter (/='_') . strip) *** strip) 
260

Michael Hanus's avatar
Michael Hanus committed
261
262
263
264
--- A map from option names to functions that will update a configuration
--- record with a value for that option.
keySetters :: [(String, String -> Config -> Config)]
keySetters =
Michael Hanus's avatar
Michael Hanus committed
265
266
  [ ("APPPACKAGEPATH"     , \v c -> c { appPackageDir     = v })
  , ("BASEVERSION"        , \v c -> c { baseVersion       = v })
Michael Hanus's avatar
Michael Hanus committed
267
268
  , ("BININSTALLPATH"     , \v c -> c { binInstallDir     = v })
  , ("CURRYBIN"           , \v c -> c { curryExec         = v })
Michael Hanus's avatar
Michael Hanus committed
269
270
271
272
  , ("HOMEPACKAGEPATH"    , \v c -> c { homePackageDir    = v })
  , ("PACKAGEINDEXURL"    , \v c -> c { packageIndexURL   = v })
  , ("PACKAGEINSTALLPATH" , \v c -> c { packageInstallDir = v })
  , ("REPOSITORYPATH"     , \v c -> c { repositoryDir     = v })
Michael Hanus's avatar
Michael Hanus committed
273
274
275
276
277
278
279
280
281
282
283
284
285
286
  ]

--- Sequentially applies a list of functions that transform a value to a value
--- of that type (i.e. a fold). Each function can error out with a Left, in 
--- which case no further applications are done and the Left is returned from
--- the overall application of applyEither.
---
--- @param fs - the list of functions
--- @param v - the initial value
applyEither :: [a -> Either c a] -> a -> Either c a
applyEither [] z = Right z
applyEither (f:fs) z = case f z of
  Left err -> Left err
  Right z' -> applyEither fs z'
Michael Hanus's avatar
Michael Hanus committed
287
288

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