|
sourcecode:
|
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"
------------------------------------------------------------------------------
|