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
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
------------------------------------------------------------------------------
--- This module contains operations related to module names and paths
--- used in Curry system.
---
--- @author Bernd Brassel, Michael Hanus, Bjoern Peemoeller, Finn Teegen
--- @version March 2024
------------------------------------------------------------------------------

module System.CurryPath
  ( ModuleIdent
  , splitProgramName, splitValidProgramName, isValidModuleName
  , runModuleAction, runModuleActionQuiet
  , splitModuleFileName, splitModuleIdentifiers  , joinModuleIdentifiers
  , stripCurrySuffix
  , ModulePath, modNameToPath
  , currySubdir, inCurrySubdir, inCurrySubdirModule, addCurrySubdir
  , sysLibPath, getLoadPathForModule
  , lookupModuleSourceInLoadPath, lookupModuleSource
  , curryModulesInDirectory, curryrcFileName
  , setCurryPath
  ) where

import Control.Monad       ( unless, when )
import Curry.Compiler.Distribution
                           ( curryCompiler, curryCompilerMajorVersion
                           , curryCompilerMinorVersion
                           , curryCompilerRevisionVersion
                           , installDir )
import Data.List           ( init, intercalate, last, split )
import System.Directory    ( doesDirectoryExist, doesFileExist
                           , getCurrentDirectory, getDirectoryContents
                           , getHomeDirectory, setCurrentDirectory )
import System.Environment  ( getEnv, setEnv )
import System.FilePath     ( FilePath, (</>), (<.>), addTrailingPathSeparator
                           , dropFileName, joinPath, splitDirectories
                           , splitExtension, splitFileName, splitPath
                           , splitSearchPath, takeExtension, dropExtension
                           )
import System.IOExts       ( evalCmd )
import System.Path         ( getFileInPath )

import Data.PropertyFile   ( getPropertyFromFile )

------------------------------------------------------------------------------
--- Functions for handling file names of Curry modules
------------------------------------------------------------------------------

type ModuleIdent = String

--- Splits a program name, i.e., a module name possibly prefixed by
--- a directory, into the directory and the module name.
--- A possible suffix like `.curry` or `.lcurry` is dropped from the
--- module name.
--- For instance `splitProgramName "lib/Data.Set.curry"` evaluates
--- to `("lib","Data.Set")`.
splitProgramName :: String -> (FilePath, ModuleIdent)
splitProgramName s
  | null ps
  = (".", "")
  | null (tail ps)
  = (".", head ps)
  | otherwise
  = (concat (init ps), last ps)
 where
  ps = splitPath (stripCurrySuffix s)

--- Splits a program name, i.e., a module name possibly prefixed by
--- a directory, into the directory and a *valid* module name.
--- A possible suffix like `.curry` or `.lcurry` is dropped from the
--- module name.
--- For instance `splitValidProgramName "lib/Data.Set.curry"` evaluates
--- to `("lib","Data.Set")`.
--- An error is raised if the program name is empty or the module name
--- is not valid.
splitValidProgramName :: String -> (FilePath, ModuleIdent)
splitValidProgramName s
  | null mname
  = error $ "The module name is empty."
  | not (isValidModuleName mname)
  = error $ "The program name '" ++ s ++ "' contains an invalid module name."
  | otherwise
  = (dir,mname)
 where
  (dir,mname) = splitProgramName s

--- Is the given string a valid module name?
isValidModuleName :: String -> Bool
isValidModuleName = all isModId . split (=='.')
 where
  isModId []     = False
  isModId (c:cs) = isAlpha c && all (\x -> isAlphaNum x || x `elem` "_'") cs

------------------------------------------------------------------------------
--- Executes an I/O action, which is parameterized over a module name,
--- for a given program name. If the program name is prefixed by a directory,
--- switch to this directory before executing the action, report
--- this switch on stdout, and switch back after the action.
--- A possible suffix like `.curry` or `.lcurry` is dropped from the
--- module name passed to the action.
--- An error is raised if the module name is not valid.
runModuleAction :: (String -> IO a) -> String -> IO a
runModuleAction = runModuleActionWith False

--- Executes an I/O action, which is parameterized over a module name,
--- for a given program name. If the program name is prefixed by a directory,
--- switch to this directory before executing the action and switch
--- back after the action.
--- A possible suffix like `.curry` or `.lcurry` is dropped from the
--- module name passed to the action.
--- An error is raised if the module name is not valid.
runModuleActionQuiet :: (String -> IO a) -> String -> IO a
runModuleActionQuiet = runModuleActionWith True

--- Executes an I/O action, which is parameterized over a module name,
--- for a given program name. If the program name is prefixed by a directory,
--- switch to this directory before executing the action and switch
--- back after the action.
--- If the first argument is `True`, the directy switch is reported on stdout.
--- A possible suffix like `.curry` or `.lcurry` is dropped from the
--- module name passed to the action.
--- An error is raised if the module name is not valid.
runModuleActionWith :: Bool -> (String -> IO a) -> String -> IO a
runModuleActionWith quiet modaction progname = do
  let (progdir,mname) = splitValidProgramName progname
  curdir <- getCurrentDirectory
  unless (progdir == ".") $ do
    unless quiet $ putStrLn $ "Switching to directory '" ++ progdir ++ "'..."
    setCurrentDirectory progdir
  result <- modaction mname
  unless (progdir == ".") $ setCurrentDirectory curdir
  return result

------------------------------------------------------------------------------
--- Split the `FilePath` of a module into the directory prefix and the
--- `FilePath` corresponding to the module name.
--- For instance, the call `splitModuleFileName "Data.Set" "lib/Data/Set.curry"`
--- evaluates to `("lib", "Data/Set.curry")`.
--- This can be useful to compute output directories while retaining the
--- hierarchical module structure.
splitModuleFileName :: ModuleIdent -> FilePath -> (FilePath, FilePath)
splitModuleFileName mid fn = case splitModuleIdentifiers mid of
  [_] -> splitFileName fn
  ms  -> let (base, ext) = splitExtension fn
             dirs        = splitDirectories base
             (pre , suf) = splitAt (length dirs - length ms) dirs
             path        = if null pre
                             then ""
                             else addTrailingPathSeparator (joinPath pre)
         in  (path, joinPath suf <.> ext)

--- Split up the components of a module identifier. For instance,
--- `splitModuleIdentifiers "Data.Set"` evaluates to `["Data", "Set"]`.
splitModuleIdentifiers :: ModuleIdent -> [String]
splitModuleIdentifiers = split (=='.')

--- Join the components of a module identifier. For instance,
--- `joinModuleIdentifiers ["Data", "Set"]` evaluates to `"Data.Set"`.
joinModuleIdentifiers :: [String] -> ModuleIdent
joinModuleIdentifiers = foldr1 combine
  where combine xs ys = xs ++ '.' : ys

--- Strips the suffix `.curry` or `.lcurry` from a file name.
stripCurrySuffix :: String -> String
stripCurrySuffix s =
  if takeExtension s `elem` [".curry",".lcurry"]
    then dropExtension s
    else s

--- A module path consists of a directory prefix (which can be omitted)
--- and a module name (which can be hierarchical). For instance, the
--- following strings are module paths in Unix-based systems:
---
---     HTML
---     Data.Number.Int
---     curry/Data.Number.Int
type ModulePath = String

--- Transforms a hierarchical module name into a path name, i.e.,
--- replace the dots in the name by directory separator chars.
modNameToPath :: ModuleIdent -> String
modNameToPath = foldr1 (</>) . split (=='.')

--- Name of the sub directory where auxiliary files (.fint, .fcy, etc)
--- are stored. Note that the name of this directory depends
--- on the compiler to avoid confusion when using different compilers.
--- For instance, when using PAKCS 3.2.0, `currySubdir` evaluates
--- to `".curry/pakcs-3.2.0"`.
currySubdir :: FilePath
currySubdir =
  ".curry" </> curryCompiler ++ "-" ++
  intercalate "."
    (map show [curryCompilerMajorVersion, curryCompilerMinorVersion,
               curryCompilerRevisionVersion])

--- Transforms a path to a module name into a file name
--- by adding the result of 'currySubDir' to the path and transforming
--- a hierarchical module name into a path.
--- For instance, when using PAKCS 3.2.0, `inCurrySubdir "mylib/Data.Char"`
--- evaluates to `"mylib/.curry/pakcs-3.2.0/Data/Char"`.
inCurrySubdir :: FilePath -> FilePath
inCurrySubdir filename =
  let (base,file) = splitFileName filename
   in base </> currySubdir </> modNameToPath file

--- Transforms a file name by adding the currySubDir to the file name.
--- This version respects hierarchical module names.
inCurrySubdirModule :: ModuleIdent -> FilePath -> FilePath
inCurrySubdirModule m fn = let (dirP, modP) = splitModuleFileName m fn
                           in  dirP </> currySubdir </> modP

--- Transforms a directory name into the name of the corresponding
--- sub directory containing auxiliary files.
addCurrySubdir :: FilePath -> FilePath
addCurrySubdir dir = dir </> currySubdir

------------------------------------------------------------------------------
--- Finding files in correspondence to compiler load path
------------------------------------------------------------------------------

--- Returns the current path (list of directory names) of the
--- system libraries.
sysLibPath :: [String]
sysLibPath = case curryCompiler of
  "kmcc"  -> [installDir </> "libs" </> "src"]
  "kics"  -> [installDir </> "src" </> "lib"]
  _       -> [installDir </> "lib"]

--- Returns the current path (list of directory names) that is
--- used for loading modules w.r.t. a given module path.
--- The directory prefix of the module path (or "." if there is
--- no such prefix) is the first element of the load path and the
--- remaining elements are determined by the environment variable
--- CURRYRPATH and the entry "libraries" of the system's rc file.
getLoadPathForModule :: ModulePath -> IO [String]
getLoadPathForModule modpath = do
  rcfile <- curryrcFileName
  mblib  <- getPropertyFromFile rcfile "libraries"
  let fileDir = dropFileName modpath
  currypath <- getEnv "CURRYPATH"
  let llib = maybe []
                   (\l -> if null l then [] else splitSearchPath l)
                   mblib
  return $ fileDir :
           (if null currypath then [] else splitSearchPath currypath) ++
           llib ++ sysLibPath

--- Returns a directory name and the actual source file name for
--- a given module name (where a possible `curry` suffix is stripped off)
--- by looking up the module source in the current load path.
--- If the module is hierarchical, the directory is the top directory
--- of the hierarchy.
--- Returns Nothing if there is no corresponding source file.
lookupModuleSourceInLoadPath :: ModulePath -> IO (Maybe (String,String))
lookupModuleSourceInLoadPath modpath = do
  loadpath <- getLoadPathForModule modpath
  lookupModuleSource loadpath modpath

--- Returns a directory name and the actual source file name for
--- a given module name (where a possible `curry` suffix is stripped off)
--- by looking up the module source in the load path provided as the
--- first argument.
--- If the module is hierarchical, the directory is the top directory
--- of the hierarchy.
--- Returns Nothing if there is no corresponding source file.
lookupModuleSource :: [String] -> String -> IO (Maybe (String,String))
lookupModuleSource loadpath mods =
  if isValidModuleName mod
    then lookupSourceInPath loadpath
    else return Nothing
 where
  mod      = stripCurrySuffix mods
  fnlcurry = modNameToPath mod ++ ".lcurry"
  fncurry  = modNameToPath mod ++ ".curry"

  lookupSourceInPath [] = return Nothing
  lookupSourceInPath (dir:dirs) = do
    lcurryExists <- doesFileExist (dir </> fnlcurry)
    if lcurryExists
      then return (Just (dir, dir </> fnlcurry))
      else do
        curryExists <- doesFileExist (dir </> fncurry)
        if curryExists then return (Just (dir, dir </> fncurry))
                       else lookupSourceInPath dirs

------------------------------------------------------------------------------
--- Gets the names of all Curry modules contained in a given directory.
--- Modules in subdirectories are returned as hierarchical module names.
curryModulesInDirectory :: String -> IO [String]
curryModulesInDirectory dir = getModules "" dir
 where
  getModules p d = do
    exdir <- doesDirectoryExist d
    entries <- if exdir then getDirectoryContents d else return []
    let realentries = filter (\f -> length f >= 1 && head f /= '.') entries
        newprogs    = filter isCurryFile realentries
    subdirs <- mapM (\e -> do b <- doesDirectoryExist (d </> e)
                              return $ if b then [e] else [])
                    realentries
               >>= return . concat
    subdirentries <- mapM (\s -> getModules (p ++ s ++ ".") (d </> s)) subdirs
    return $ map ((p ++) . stripCurrySuffix) newprogs ++ concat subdirentries

  isCurryFile f = takeExtension f `elem` [".curry",".lcurry"]

------------------------------------------------------------------------------
--- The name of the file specifying resource configuration parameters of the
--- current distribution.
--- This file must have the usual format of property files.
curryrcFileName :: IO FilePath
curryrcFileName = getHomeDirectory >>= return . (</> rcFile)
  where rcFile = '.' : curryCompiler ++ "rc"

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

--- If the environment variable `CURRYPATH` is not already set
--- (i.e., not null), set it to the value computed by `cypm deps --path`
--- in order to allow invoking tools without `cypm exec ...`.
--- If the first argument is `False`, the computed path value is printed.
--- If the second argument is not null, its value is taken as the executable
--- for CPM, otherwise the executable `cypm` is searched in the current path
--- (environment variable `PATH`).
setCurryPath :: Bool -> String -> IO ()
setCurryPath quiet cpmexec = do
  cp <- getEnv "CURRYPATH"
  if null cp
    then
      (if null cpmexec then getFileInPath "cypm" else return (Just cpmexec)) >>=
      maybe
        (return ())
        (\cpm -> do
          putStrLnNQ $
            "Computing CURRYPATH with '" ++ cpm ++ "'..."
          (rc,out,err) <- evalCmd cpm ["deps","--path"] ""
          if rc==0
            then do let cpath = strip out
                    putStrLnNQ $ "CURRYPATH=" ++ cpath
                    setEnv "CURRYPATH" cpath
            else putStrLn $ "ERROR during computing CURRYPATH with 'cypm':\n"
                                ++ out ++ err )
    else putStrLnNQ $ "CURRYPATH=" ++ cp
 where
  putStrLnNQ s = unless quiet $ putStrLn s

  -- Remove leading and trailing whitespace
  strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace

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