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

------------------------------------------------------------------------------
--- Some operations to handle the REPL resource configuration file
--- that is stored in $HOME/.<compiler-name>rc
---
--- @author  Michael Hanus
--- @version April 2021
------------------------------------------------------------------------------

module REPL.RCFile
  ( readRC, rcValue, setRCProperty, extractRCArgs, updateRCDefs )
 where

import Control.Monad     ( unless )
import Data.Char         ( toLower, isSpace )
import Data.List         ( isPrefixOf, partition, sort )

import Data.PropertyFile
import System.FilePath   ( FilePath, (</>), (<.>) )
import System.Directory  ( getHomeDirectory, doesFileExist, copyFile
                         , renameFile )
import REPL.Compiler
import REPL.PkgConfig    ( packagePath )
import REPL.Utils        ( strip )

--- Returns the location of the default rc template file.
--- If the Curry compiler has its own, return this one, otherwise
--- return the template from this package.
getDefaultRC :: CCDescription -> IO FilePath
getDefaultRC cd = do
  let cmprc = ccHome cd </> ccName cd ++ "rc.default"
  excmprc <- doesFileExist cmprc
  if excmprc then return cmprc
             else return (packagePath </> "curryrc.default")

--- Location of the rc file of a user.
--- After bootstrapping, one can also use Distribution.rcFileName
--- The name of the file specifying configuration parameters of the
--- current distribution. This file must have the usual format of
--- property files (see description in module PropertyFile).
rcFileName :: CCDescription -> IO FilePath
rcFileName cd = (</> "." ++ ccName cd ++ "rc") `fmap` getHomeDirectory

--- Reads the rc file. If it is not present, the standard file
--- from the distribution will be copied.
readRC :: CCDescription -> IO [(String, String)]
readRC cd = do
  rcname <- rcFileName cd
  rcdefname <- getDefaultRC cd
  rcexists  <- doesFileExist rcname
  catch (if rcexists
           then updateRC cd rcdefname
           else do putStrLn $ "Installing '" ++ rcname ++ "'..."
                   copyFile rcdefname rcname)
        (const $ return ())
  readPropertyFile rcname

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

--- Reads the rc file (which must be present) and compares the definitions
--- with the distribution rc file. If the set of variables is different,
--- update the rc file with the distribution but keep the user's definitions.
updateRC :: CCDescription -> String -> IO ()
updateRC cd defaultrc = do
  rcname    <- rcFileName cd
  userprops <- readPropertyFile rcname
  distprops <- readPropertyFile defaultrc
  unless (rcKeys userprops == rcKeys distprops) $ do
    putStrLn $ "Updating '" ++ rcname ++ "'..."
    renameFile rcname $ rcname <.> "bak"
    copyFile defaultrc rcname
    mapM_ (\ (n, v) -> maybe (return ())
             (\uv -> unless (uv == v) $ updatePropertyFile rcname n uv)
             (lookup n userprops))
          distprops

--- Sets a property in the rc file.
setRCProperty :: CCDescription -> String -> String -> IO ()
setRCProperty cd pname pval = do
  readRC cd -- just be to sure that rc file exists and is up-to-date
  rcname <- rcFileName cd
  updatePropertyFile rcname pname pval

--- Look up a configuration variable in the list of variables from the rc file.
--- Uppercase/lowercase is ignored for the variable names and the empty
--- string is returned for an undefined variable.
rcValue :: [(String, String)] -> String -> String
rcValue rcdefs var = strip $ maybe "" id $
  lookup (map toLower var) (map (first (map toLower)) rcdefs)
 where
  first f (x, y) = (f x, y)

--- Extract from a list of command-line arguments rc properties
--- of the from "-Dprop=val" and return the remaining arguments
--- and the extracted properties.
extractRCArgs :: [String] -> ([String],[(String,String)])
extractRCArgs args =
  let (dargs,otherargs) = partition ("-D" `isPrefixOf`) args
  in (otherargs, map splitDefs (map (drop 2) dargs))
 where
  splitDefs darg = case break (== '=') darg of
    (var,_:val) -> (var,val)
    _           -> (darg,"")

--- Update list of rc properties w.r.t. a list new properties.
updateRCDefs :: [(String,String)] -> [(String,String)] -> [(String,String)]
updateRCDefs orgdefs newdefs =
  map (\ (name,val) -> (name, maybe val id (lookup name newdefs))) orgdefs

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