Commit 2f4c10b2 authored by Michael Hanus 's avatar Michael Hanus

Package configuration field "configModule" added

parent df8c86fa
......@@ -217,8 +217,8 @@ one can check out the most recent version and install the tool:
%
\begin{lstlisting}
> cpm checkout makefile
$\ldots$ Package 'makefile-0.0.1' checked out $\ldots$
> cd makefile-0.0.1
$\ldots$ Package 'makefile-1.3.4' checked out into directory 'makefile'.
> cd makefile
> cpm install
$\ldots$
INFO Installing executable `curry-genmake' into `/home/joe/.cpm/bin'
......@@ -549,13 +549,14 @@ for this package.
of a package from the global package cache.
\item[\fbox{\code{checkout $package$ [--$pre$]}}]
Checks out the newest version of a package into a local directory
Checks out the newest version of a package
into the local directory \code{$package$}
in order to test its operations or install a binary of the package..
\code{--$pre$} enables the installation of pre-release versions.
\item[\fbox{\code{checkout $package$ $version$}}]
Checks out a specific version of a package
into the local directory \code{$package$-$version$}
into the local directory \code{$package$}
in order to test its operations or install a binary of the package..
\item[\fbox{\code{upgrade}}]
......@@ -619,6 +620,14 @@ to the compiler.
\item[\fbox{\code{link $source$}}] Can be used to replace a dependency of the
current package using a local copy, see Section~\ref{sec:cpm-link} for details.
\item[\fbox{\code{clean}}] Cleans the current package from the
generated auxiliariy files, e.g., intermediate Curry files,
installed dependent packages, etc.
Note that a binary installed in the CPM \code{bin} directory
(by the \code{install} command) will not be removed.
Hence, this command can be used to clean an application package
after installing the application.
\item[\fbox{\code{new}}] Asks a few questions and creates a new package.
\end{description}
......@@ -702,6 +711,25 @@ test modules is not provided).
Note that modules not in this list are still accessible to consumers
of the package.
\item[\fbox{\code{configModule}}]
A module name into which some information about the package configuration
(location of the package directory, name of the executable, see below)
is written when the package is installed.
This could be useful if the package needs some data files
stored in this package during run time.
For instance, a possible specification could be as follows:
%
\begin{lstlisting}
{
...,
"configModule": "CPM.PackageConfig",
...
}
\end{lstlisting}
%
In this case, the package configuration is written into the Curry
file \code{src/CPM/PackageConfig.curry}.
\item[\fbox{\code{executable}}]
A JSON object specifying the name of the executable and the main module
if this package contains also an executable application.
......
......@@ -18,6 +18,7 @@ module CPM.ErrorLogger
, failIO
, log
, showLogEntry
, debugMessage
) where
import Global
......@@ -174,4 +175,8 @@ log lvl msg =
else
return $ ([LogEntry lvl msg], Right ())
where
showTime t = show (t `div` 1000) ++ "." ++ show ((t `mod` 1000) `div` 10)
\ No newline at end of file
showTime t = show (t `div` 1000) ++ "." ++ show ((t `mod` 1000) `div` 10)
--- Prints a debug message in the standard IO monad.
debugMessage :: String -> IO ()
debugMessage msg = (log Debug msg |> succeedIO ()) >> done
......@@ -17,15 +17,16 @@ module CPM.FileUtil
, inDirectory
, recreateDirectory
, removeDirectoryComplete
, safeReadFile
) where
import Directory ( doesFileExist, getCurrentDirectory, setCurrentDirectory
, getTemporaryDirectory, doesDirectoryExist, createDirectory
, createDirectoryIfMissing)
import System (system, getEnviron)
import IOExts (evalCmd)
import FilePath (FilePath, replaceFileName, (</>), searchPathSeparator)
import List (intercalate, splitOn)
import System ( system, getEnviron )
import IOExts ( evalCmd, readCompleteFile )
import FilePath ( FilePath, replaceFileName, (</>), searchPathSeparator )
import List ( intercalate, splitOn )
--- Joins a list of directories into a search path.
joinSearchPath :: [FilePath] -> String
......@@ -90,12 +91,12 @@ tempDir = do
--- directory.
inTempDir :: IO b -> IO b
inTempDir b = do
t <- getTemporaryDirectory
exists <- doesDirectoryExist (t </> "cpm")
t <- tempDir
exists <- doesDirectoryExist t
if exists
then return ()
else createDirectory (t </> "cpm")
inDirectory (t </> "cpm") b
else createDirectory t
inDirectory t b
--- Executes an IO action with the current directory set to a specific
--- directory.
......@@ -119,3 +120,10 @@ removeDirectoryComplete :: String -> IO ()
removeDirectoryComplete dir = do
exists <- doesDirectoryExist dir
when exists $ system ("rm -Rf " ++ quote dir) >> done
--- Reads the complete contents of a file and catches any error
--- (which is returned).
safeReadFile :: String -> IO (Either IOError String)
safeReadFile fname = do
catch (readCompleteFile fname >>= return . Right)
(return . Left)
This diff is collapsed.
......@@ -136,6 +136,7 @@ data Package = Package {
, compilerCompatibility :: [CompilerCompatibility]
, source :: Maybe PackageSource
, exportedModules :: [String]
, configModule :: Maybe String
, executableSpec :: Maybe PackageExecutable
, testSuite :: Maybe PackageTests
}
......@@ -160,6 +161,7 @@ emptyPackage = Package {
, compilerCompatibility = []
, source = Nothing
, exportedModules = []
, configModule = Nothing
, executableSpec = Nothing
, testSuite = Nothing
}
......@@ -194,6 +196,7 @@ loadPackageSpec dir = do
exists <- doesFileExist packageFile
if exists
then do
debugMessage $ "Reading package specification '" ++ packageFile ++ "'..."
contents <- readFile packageFile
case readPackageSpec contents of
Left err -> failIO err
......@@ -324,19 +327,21 @@ readPackageSpec s = case parseJSON s of
--- Reads a package spec from the key-value-pairs of a JObject.
packageSpecFromJObject :: [(String, JValue)] -> Either String Package
packageSpecFromJObject kv = mandatoryString "name" $ \name ->
mandatoryString "version" $ \versionS ->
mandatoryString "author" $ \author ->
optionalString "maintainer" $ \maintainer ->
mandatoryString "synopsis" $ \synopsis ->
optionalString "description" $ \description ->
packageSpecFromJObject kv =
mandatoryString "name" kv $ \name ->
mandatoryString "version" kv $ \versionS ->
mandatoryString "author" kv $ \author ->
optionalString "maintainer" kv $ \maintainer ->
mandatoryString "synopsis" kv $ \synopsis ->
optionalString "description" kv $ \description ->
getStringList "A category" "category" $ \categories ->
optionalString "license" $ \license ->
optionalString "licenseFile" $ \licenseFile ->
optionalString "copyright" $ \copyright ->
optionalString "homepage" $ \homepage ->
optionalString "bugReports" $ \bugReports ->
optionalString "repository" $ \repository ->
optionalString "license" kv $ \license ->
optionalString "licenseFile" kv $ \licenseFile ->
optionalString "copyright" kv $ \copyright ->
optionalString "homepage" kv $ \homepage ->
optionalString "bugReports" kv $ \bugReports ->
optionalString "repository" kv $ \repository ->
optionalString "configModule" kv $ \configModule ->
mustBeVersion versionS $ \version ->
getDependencies $ \dependencies ->
getSource $ \source ->
......@@ -362,35 +367,11 @@ packageSpecFromJObject kv = mandatoryString "name" $ \name ->
, compilerCompatibility = compilerCompatibility
, source = source
, exportedModules = exportedModules
, configModule = configModule
, executableSpec = executable
, testSuite = testsuite
}
where
mandatoryString :: String -> (String -> Either String a) -> Either String a
mandatoryString k f = case lookup k kv of
Nothing -> Left $ "Mandatory field missing: '" ++ k ++ "'"
Just (JString s) -> f s
Just (JObject _) -> Left $ "Expected a string, got an object" ++ forKey
Just (JArray _) -> Left $ "Expected a string, got an array" ++ forKey
Just (JNumber _) -> Left $ "Expected a string, got a number" ++ forKey
Just JTrue -> Left $ "Expected a string, got 'true'" ++ forKey
Just JFalse -> Left $ "Expected a string, got 'false'" ++ forKey
Just JNull -> Left $ "Expected a string, got 'null'" ++ forKey
where forKey = " for key '" ++ k ++ "'"
optionalString :: String -> (Maybe String -> Either String a)
-> Either String a
optionalString k f = case lookup k kv of
Nothing -> f Nothing
Just (JString s) -> f (Just s)
Just (JObject _) -> Left $ "Expected a string, got an object" ++ forKey
Just (JArray _) -> Left $ "Expected a string, got an array" ++ forKey
Just (JNumber _) -> Left $ "Expected a string, got a number" ++ forKey
Just JTrue -> Left $ "Expected a string, got 'true'" ++ forKey
Just JFalse -> Left $ "Expected a string, got 'false'" ++ forKey
Just JNull -> Left $ "Expected a string, got 'null'" ++ forKey
where forKey = " for key '" ++ k ++ "'"
mustBeVersion :: String -> (Version -> Either String a) -> Either String a
mustBeVersion s f = case readVersion s of
Nothing -> Left $ "'" ++ s ++ "' is not a valid version specification."
......@@ -410,7 +391,8 @@ packageSpecFromJObject kv = mandatoryString "name" $ \name ->
Just JNull -> Left $ "Expected an object, got 'null'" ++ forKey
where forKey = " for key 'dependencies'"
getCompilerCompatibility :: ([CompilerCompatibility] -> Either String a) -> Either String a
getCompilerCompatibility :: ([CompilerCompatibility] -> Either String a)
-> Either String a
getCompilerCompatibility f = case lookup "compilerCompatibility" kv of
Nothing -> f []
Just (JObject ds) -> case compilerCompatibilityFromJObject ds of
......@@ -480,6 +462,32 @@ packageSpecFromJObject kv = mandatoryString "name" $ \name ->
Just JNull -> Left $ "Expected an object, got 'null'" ++ forKey
where forKey = " for key 'testsuite'"
mandatoryString :: String -> [(String, JValue)]
-> (String -> Either String a) -> Either String a
mandatoryString k kv f = case lookup k kv of
Nothing -> Left $ "Mandatory field missing: '" ++ k ++ "'"
Just (JString s) -> f s
Just (JObject _) -> Left $ "Expected a string, got an object" ++ forKey
Just (JArray _) -> Left $ "Expected a string, got an array" ++ forKey
Just (JNumber _) -> Left $ "Expected a string, got a number" ++ forKey
Just JTrue -> Left $ "Expected a string, got 'true'" ++ forKey
Just JFalse -> Left $ "Expected a string, got 'false'" ++ forKey
Just JNull -> Left $ "Expected a string, got 'null'" ++ forKey
where forKey = " for key '" ++ k ++ "'"
optionalString :: String -> [(String, JValue)]
-> (Maybe String -> Either String a) -> Either String a
optionalString k kv f = case lookup k kv of
Nothing -> f Nothing
Just (JString s) -> f (Just s)
Just (JObject _) -> Left $ "Expected a string, got an object" ++ forKey
Just (JArray _) -> Left $ "Expected a string, got an array" ++ forKey
Just (JNumber _) -> Left $ "Expected a string, got a number" ++ forKey
Just JTrue -> Left $ "Expected a string, got 'true'" ++ forKey
Just JFalse -> Left $ "Expected a string, got 'false'" ++ forKey
Just JNull -> Left $ "Expected a string, got 'null'" ++ forKey
where forKey = " for key '" ++ k ++ "'"
test_specFromJObject_mandatoryFields :: Test.EasyCheck.Prop
test_specFromJObject_mandatoryFields =
is (packageSpecFromJObject obj)
......@@ -574,13 +582,10 @@ revisionFromJObject kv = case lookup "tag" kv of
--- Read executable specification from the key-value-pairs of a JObject.
execSpecFromJObject :: [(String, JValue)] -> Either String PackageExecutable
execSpecFromJObject kv = case lookup "name" kv of
Nothing -> Left $ "Name of executable not provided"
Just (JString name) -> case lookup "main" kv of
Nothing -> Right $ PackageExecutable name "Main"
Just (JString main) -> Right $ PackageExecutable name main
Just _ -> Left $ "Main module of executable must be a string"
Just _ -> Left "Name of executable must be a string"
execSpecFromJObject kv =
mandatoryString "name" kv $ \name ->
optionalString "main" kv $ \main ->
Right $ PackageExecutable name (maybe "" id main)
--- Read a test suite specification from the key-value-pairs of a JObject.
testSuiteFromJObject :: [(String, JValue)] -> Either String PackageTests
......
......@@ -232,16 +232,18 @@ checkoutPackage :: Config -> Repository -> GlobalCache -> Package
-> IO (ErrorLogger ())
checkoutPackage cfg _ _ pkg = do
sexists <- doesDirectoryExist pkgDir
texists <- doesDirectoryExist pkgId
texists <- doesDirectoryExist codir
if texists
then log Error $ "Package '" ++ pkgId ++ "' already checked out."
then log Error $ "Local package directory '" ++ codir ++ "' already exists."
else if sexists
then copyDirectory pkgDir pkgId >> log Info logMsg
then copyDirectory pkgDir codir >> log Info logMsg
else log Error $ "Package '" ++ pkgId ++ "' is not installed."
where
pkgDir = packageInstallDir cfg </> pkgId
pkgId = packageId pkg
logMsg = "Package '" ++ pkgId ++ "' checked out into local directory."
pkgDir = packageInstallDir cfg </> pkgId
codir = name pkg
logMsg = "Package '" ++ pkgId ++ "' checked out into directory '" ++
codir ++ "'."
--- Removes a package from the global package cache.
uninstallPackage :: Config -> Repository -> GlobalCache -> String -> Version
......@@ -265,15 +267,18 @@ tryFindPackage gc name ver = case findVersion gc name ver of
--- Tries to read package specifications from a GC directory structure.
readInstalledPackagesFromDir :: String -> IO (Either String GlobalCache)
readInstalledPackagesFromDir path = do
debugMessage $ "Reading global package cache from '" ++ path ++ "'..."
pkgDirs <- getDirectoryContents path
pkgPaths <- return $ map (path </>) $ filter (not . isPrefixOf ".") pkgDirs
specPaths <- return $ map (</> "package.json") pkgPaths
specs <- mapIO readPackageSpecFromFile specPaths
if length (lefts specs) /= 0
then return $ Left $ intercalate "; " (lefts specs)
else return $ Right $ GlobalCache (rights specs)
if null (lefts specs)
then do debugMessage "Finished reading global package cache"
return (Right $ GlobalCache (rights specs))
else return (Left $ intercalate "; " (lefts specs))
where
readPackageSpecIO = liftIO readPackageSpec
readPackageSpecFromFile f = do
spec <- readPackageSpecIO $ readFile f
return $ case spec of
......
......@@ -7,18 +7,21 @@ module CPM.PackageCache.Runtime
, dependencyPaths
, copyPackages
, cacheDirectory
, writePackageConfig
) where
import FilePath ((</>))
import FileGoodies (baseName)
import Directory (createDirectoryIfMissing, copyFile, getDirectoryContents
, doesDirectoryExist, doesFileExist)
import List (intercalate)
import FilePath ( (</>), (<.>) )
import FileGoodies ( baseName )
import Directory ( createDirectoryIfMissing, copyFile, getDirectoryContents
, getAbsolutePath, doesDirectoryExist, doesFileExist )
import List ( intercalate, split )
import CPM.Config (Config)
import CPM.Config (Config, binInstallDir)
import CPM.ErrorLogger
import CPM.PackageCache.Global (installedPackageDir)
import CPM.Package (Package, packageId)
import CPM.FileUtil (copyDirectoryFollowingSymlinks, recreateDirectory)
import CPM.Package ( Package, packageId, PackageExecutable(..)
, configModule, executableSpec )
import CPM.FileUtil ( copyDirectoryFollowingSymlinks, recreateDirectory )
import CPM.PackageCache.Local as LocalCache
-- Each package needs its own copy of all dependencies since KiCS2 and PACKS
......@@ -43,7 +46,7 @@ cacheDirectory dir pkg = dir </> ".cpm" </> "packages" </> packageId pkg
--- Copies a set of packages from the local package cache to the runtime
--- package cache.
copyPackages :: Config -> [Package] -> String -> IO ()
copyPackages _ pkgs dir = mapIO copyPackage pkgs >> return ()
copyPackages cfg pkgs dir = mapIO copyPackage pkgs >> return ()
where
copyPackage pkg = do
cdir <- ensureCacheDirectory dir
......@@ -51,8 +54,10 @@ copyPackages _ pkgs dir = mapIO copyPackage pkgs >> return ()
recreateDirectory destDir
pkgDirExists <- doesDirectoryExist pkgDir
if pkgDirExists
then copyDirectoryFollowingSymlinks pkgDir cdir
else error $ "Package " ++ (packageId pkg) ++ " could not be found in package cache."
then copyDirectoryFollowingSymlinks pkgDir cdir >>
writePackageConfig cfg destDir pkg |> succeedIO ()
else error $ "Package " ++ packageId pkg ++
" could not be found in package cache."
where
pkgDir = LocalCache.packageDir dir pkg
......@@ -62,3 +67,37 @@ ensureCacheDirectory dir = do
createDirectoryIfMissing True packagesDir
return packagesDir
where packagesDir = dir </> ".cpm" </> "packages"
--- Writes the package configuration module (if specified) into the
--- the package sources.
writePackageConfig :: Config -> String -> Package -> IO (ErrorLogger ())
writePackageConfig cfg pkgdir pkg =
maybe (succeedIO ())
(\ configmod ->
let binname = maybe "" (\ (PackageExecutable n _) -> n)
(executableSpec pkg)
in if null configmod
then succeedIO ()
else writeConfigFile configmod binname)
(configModule pkg)
where
writeConfigFile configmod binname = do
let configfile = pkgdir </> "src" </> foldr1 (</>) (split (=='.') configmod)
<.> ".curry"
abspkgdir <- getAbsolutePath pkgdir
writeFile configfile $ unlines $
[ "module " ++ configmod ++ " where"
, ""
, "--- Package location."
, "packagePath :: String"
, "packagePath = \"" ++ abspkgdir ++ "\""
] ++
if null binname
then []
else [ ""
, "--- Location of the executable installed by this package."
, "packageExecutable :: String"
, "packageExecutable = \"" ++ binInstallDir cfg </> binname ++ "\""
]
log Debug $ "Config module '" ++ configfile ++ "' written."
......@@ -137,9 +137,10 @@ upgradeSinglePackage cfg repo gc dir pkgName = loadPackageSpec dir |>=
--- Installs the dependencies of a package.
installLocalDependencies :: Config -> Repository -> GC.GlobalCache -> String
-> IO (ErrorLogger (Package,[Package]))
installLocalDependencies cfg repo gc dir = loadPackageSpec dir |>=
\pkgSpec -> resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir |>=
\result -> GC.installMissingDependencies cfg gc (resolvedPackages result) |>
installLocalDependencies cfg repo gc dir =
loadPackageSpec dir |>= \pkgSpec ->
resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir |>= \result ->
GC.installMissingDependencies cfg gc (resolvedPackages result) |>
log Info (showDependencies result) |>
copyDependencies cfg gc pkgSpec (resolvedPackages result) dir |>
succeedIO (pkgSpec, resolvedPackages result)
......@@ -201,8 +202,8 @@ renderPackageInfo allinfos _ gc pkg = pPrint doc
doc = vcat $ [ heading, rule, installed, ver, auth, maintnr, synop
, cats, deps, compilers, descr ] ++
if allinfos
then [ expmods, execspec, testsuite, src, licns, copyrt
, homepg, reposy, bugrep]
then [ expmods, cfgmod, execspec, testsuite, src, licns
, copyrt, homepg, reposy, bugrep]
else []
pkgId = packageId pkg
......@@ -231,8 +232,9 @@ renderPackageInfo allinfos _ gc pkg = pPrint doc
execspec = case executableSpec pkg of
Nothing -> empty
Just (PackageExecutable n m) ->
fill maxLen (bold (text "Executable")) <+> text n <$$>
fill maxLen (bold (text "Main module")) <+> text m
bold (text "Executable") <$$>
indent 4 (bold (text "Name ") <+> text n) <$$>
indent 4 (bold (text "Main module ") <+> text m)
testsuite = case testSuite pkg of
Nothing -> empty
......@@ -246,12 +248,13 @@ renderPackageInfo allinfos _ gc pkg = pPrint doc
else fill maxLen (bold (text "Test modules"))<$$>
indent 4 (fillSep (map text mods)))
descr = showParaField description "Description"
licns = showParaField license "License"
copyrt = showParaField copyright "Copyright"
homepg = showLineField homepage "Homepage"
reposy = showLineField repository "Repository"
bugrep = showLineField bugReports "Bug reports"
descr = showParaField description "Description"
licns = showParaField license "License"
copyrt = showParaField copyright "Copyright"
homepg = showLineField homepage "Homepage"
reposy = showLineField repository "Repository"
bugrep = showLineField bugReports "Bug reports"
cfgmod = showLineField configModule "Config module"
src = case source pkg of
Nothing -> empty
......
......@@ -110,20 +110,24 @@ readRepository cfg = readRepositoryFrom (repositoryDir cfg)
--- @param path the location of the repository
readRepositoryFrom :: String -> IO (Repository, [String])
readRepositoryFrom path = do
debugMessage $ "Reading repository index from '" ++ path ++ "'..."
pkgDirs <- getDirectoryContents path
pkgPaths <- return $ map (path </>) $ filter dirOrSpec pkgDirs
verDirs <- mapIO getDirectoryContents pkgPaths
verPaths <- return $ concat $ map (\(d, p) -> map (d </>) (filter dirOrSpec p)) $ zip pkgPaths verDirs
specPaths <- return $ map (</> "package.json") verPaths
specs <- mapIO readPackageFile specPaths
when (null (lefts specs)) $ debugMessage "Finished reading repository"
return $ (Repository $ rights specs, lefts specs)
where
readPackageSpecIO = liftIO readPackageSpec
readPackageFile f = do
spec <- readPackageSpecIO $ readFile f
return $ case spec of
Left err -> Left $ "Problem reading '" ++ f ++ "': " ++ err
Right s -> Right s
dirOrSpec d = (not $ isPrefixOf "." d) && takeExtension d /= ".md"
--- Updates the package index from the central Git repository.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment