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

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

module CPM.Query.RCFile
  ( readRC, rcValue )
 where

import Control.Monad     ( unless )
import Data.Char         ( toLower )
import Data.Either       ( rights )
import Data.List         ( intercalate, sort )
import System.IO         ( hPutStrLn, stderr )

import Data.PropertyFile ( readPropertyFile, updatePropertyFile )
import System.FilePath   ( FilePath, (</>), (<.>) )
import System.Directory  ( doesFileExist, getHomeDirectory, renameFile )

import CPM.Query.Configuration

--- Initial properties of the default RC template file.
defaultRCProps :: [Either String (String,String)]
defaultRCProps =
  [ Left "# Configuration file for command 'cpm-query'"
  , Left ""
  , Left "# Requests for classes, separated by comma:"
  , Left $ "# default: " ++ intercalate "," (defaultRequests Class)
  , Right ("classrequests", "")
  , Left ""
  , Left "# Requests for types, separated by comma:"
  , Left $ "# default: " ++ intercalate "," (defaultRequests Type)
  , Right ("typerequests", "")
  , Left ""
  , Left "# Requests for operations, separated by comma:"
  , Left $ "# default: " ++ intercalate "," (defaultRequests Operation)
  , Right ("operationrequests", "")
  , Left ""
  , Left "# Show all available information (no|yes):"
  , Right ("showall", "no")
  , Left ""
  , Left "# Use the curry-info web service for requests (yes|no):"
  , Right ("remote", "yes")
  , Left ""
  , Left "# URL of the web service of curry-info (used when remote=yes)"
  , Left "# (if empty: use default URL)"
  , Right ("curryinfourl", "")
  , Left ""
  ]

--- 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.
rcFileName :: IO FilePath
rcFileName = (</> ".cpmqueryrc") `fmap` getHomeDirectory

--- Reads the rc file. If it is not present, a new file will be created
--- with the contents of `defaultRC`.
readRC :: IO [(String, String)]
readRC = do
  rcname <- rcFileName
  rcexists  <- doesFileExist rcname
  catch (if rcexists
           then updateRC
           else do hPutStrLn stderr $ "Installing '" ++ rcname ++ "'..."
                   writeFile rcname defaultRC)
        (const $ return ())
  readPropertyFile rcname

--- 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 :: IO ()
updateRC = do
  rcname    <- rcFileName
  userprops <- readPropertyFile rcname
  let dfltprops = rights defaultRCProps
  unless (rcKeys userprops == rcKeys dfltprops) $ do
    hPutStrLn stderr $ "Updating '" ++ rcname ++ "'..."
    renameFile rcname $ rcname <.> "bak"
    writeFile rcname defaultRC
    mapM_ (\ (n, v) ->
             maybe (return ())
                   (\uv -> unless (uv == v) $ updatePropertyFile rcname n uv)
                   (lookup n userprops))
          dfltprops
 where
  rcKeys = sort . map fst

--- 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)

  strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace

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