------------------------------------------------------------------------------ --- This module contains operations related to module names, paths, and --- packages used in a Curry system (with the Curry Package Manager CPM). --- --- @author Bernd Brassel, Michael Hanus, Bjoern Peemoeller, Finn Teegen --- @version December 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 , getPackageVersionOfModule, getPackageVersionOfDirectory , setCurryPath, setCurryPathIfNecessary , packageSpecFile ) where import Control.Monad ( unless, when ) import Curry.Compiler.Distribution ( baseVersion, curryCompiler , curryCompilerMajorVersion , curryCompilerMinorVersion , curryCompilerRevisionVersion , installDir ) import Data.List ( init, intercalate, last, split ) import System.Directory ( doesDirectoryExist, doesFileExist , getCurrentDirectory, getDirectoryContents , getHomeDirectory, getModificationTime , setCurrentDirectory ) import System.Environment ( getEnv, setEnv ) import System.FilePath ( FilePath, (), (<.>), addTrailingPathSeparator , dropFileName, joinPath, splitDirectories , splitExtension, splitFileName, splitPath , splitSearchPath, takeExtension, dropExtension ) import System.IOExts ( evalCmd, readCompleteFile ) 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" ------------------------------------------------------------------------------ -- Operations related to Curry packages maintained by the -- Curry package manager CPM. --- Checks whether a module name is part of a package and --- returns the package name and package version. --- For instance, in a package containing a dependency to package --- `process` with version `3.0.0`, the call --- --- getPackageVersionOfModule "System.Process" --- --- returns --- --- Just "process" "3.0.0" --- --- `Nothing` is returned if there is no package to which this module --- belongs. --- --- For this purpose, the source file of the module is looked up --- (and an error is raised if this module cannot be found) and --- it is checked whether there is a `package.json` file under the --- directory of the source file and the directory name is a valid package id. getPackageVersionOfModule :: String -> IO (Maybe (String,String)) getPackageVersionOfModule mname = do mbsrc <- lookupModuleSourceInLoadPath mname case mbsrc of Nothing -> error $ "Module '" ++ mname ++ "' not found in load path!" Just (dirname,_) -> getPackageVersionOfDirectory dirname --- Checks whether a directory path is part of a package and returns --- the package name and package version. For instance, --- --- getPackageVersionOfDirectory "/home/joe/mytool/.cpm/packages/process-3.0.0/src" --- --- returns --- --- Just "process" "3.0.0" --- --- For this purpose, it is checked whether there is a `package.json` file --- under the directory and the directory name is a valid package id. getPackageVersionOfDirectory :: FilePath -> IO (Maybe (String,String)) getPackageVersionOfDirectory path = if sysLibPath == [path] then return (Just ("base",baseVersion)) else getPackageSpecPath path >>= return . maybe Nothing (\pdir -> splitPkgId "" (last (splitDirectories pdir))) where splitPkgId oldpn s = let (pname,hvers) = break (=='-') s newpn = if null oldpn then pname else oldpn ++ "-" ++ pname in if null hvers then Nothing else let vers = tail hvers in if isVersionId vers then Just (newpn,vers) else splitPkgId newpn vers isVersionId vs = case split (=='.') vs of (maj:min:patch:_) -> all (all isDigit) [maj, min, take 1 patch] _ -> False --- Returns, for a given directory, the directory path containing --- a package specification. getPackageSpecPath :: FilePath -> IO (Maybe FilePath) getPackageSpecPath dir = getPkgSpecPath (splitDirectories dir) where getPkgSpecPath [] = return Nothing getPkgSpecPath dirnames@(_:_) = do expkg <- doesFileExist (joinPath (dirnames ++ [packageSpecFile])) if expkg then return (Just (joinPath dirnames)) else getPkgSpecPath (init dirnames) --- 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 --- If the environment variable `CURRYPATH` is not already set --- (i.e., not null), set it to the value stored in CPM's `CURRYPATH_CACHE` --- file or set it by `System.CurryPath.setCurryPath` --- (which uses `cypm deps --path` to compute its value). setCurryPathIfNecessary :: IO () setCurryPathIfNecessary = do cp <- getEnv "CURRYPATH" when (null cp) $ do cdir <- getCurrentDirectory getPackageSpecPath cdir >>= maybe setCurryPathByCPM loadCurryPathFromCache where loadCurryPathFromCache specdir = do let cachefile = specdir ".cpm" "CURRYPATH_CACHE" excache <- doesFileExist cachefile if excache then do cftime <- getModificationTime cachefile pftime <- getModificationTime (specdir packageSpecFile) if cftime > pftime then do cnt <- readCompleteFile cachefile let cpath = head (lines cnt) setEnv "CURRYPATH" cpath else setCurryPathByCPM else setCurryPathByCPM setCurryPathByCPM = setCurryPath True "" --- The name of the package specification file in JSON format. packageSpecFile :: String packageSpecFile = "package.json" ------------------------------------------------------------------------------