Commit c72e1df7 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated: command "add" installs also packages, "search" more flexible

parent c7a5c9ac
...@@ -390,6 +390,18 @@ Prelude> :load JSON.Data ...@@ -390,6 +390,18 @@ Prelude> :load JSON.Data
JSON.Data> JSON.Data>
\end{lstlisting} \end{lstlisting}
% %
The default behavior of the \code{add} command is to add the dependency
\emph{and} install all dependencies, i.e., the previous commands
can be reduced as follows:
%
\begin{lstlisting}
> cypm add json
> cypm curry
...
Prelude> :load JSON.Data
JSON.Data>
\end{lstlisting}
\subsection{Replacing Dependencies with Local Versions} \subsection{Replacing Dependencies with Local Versions}
\label{sec:cpm-link} \label{sec:cpm-link}
...@@ -1043,6 +1055,13 @@ of the current package or in the meta-package ...@@ -1043,6 +1055,13 @@ of the current package or in the meta-package
The option \ccode{--force} allows to overwrite existing dependencies The option \ccode{--force} allows to overwrite existing dependencies
in the package description file. in the package description file.
\item[\fbox{\code{add $package$ [--force]}}]
Adds the package $package$ as a new dependency and install
the new dependencies. Thus, this abbreviates the two commands
\begin{lstlisting}
cypm add $package$ && cypm install
\end{lstlisting}
\item[\fbox{\code{upload [--notagging] [--force]}}] \item[\fbox{\code{upload [--notagging] [--force]}}]
Uploads the current package to the central package index Uploads the current package to the central package index
so that it can be used by other developers via CPM so that it can be used by other developers via CPM
......
...@@ -59,7 +59,7 @@ cpmBanner :: String ...@@ -59,7 +59,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine] cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where where
bannerText = bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 10/12/2018)" "Curry Package Manager <curry-language.org/tools/cpm> (version of 17/01/2019)"
bannerLine = take (length bannerText) (repeat '-') bannerLine = take (length bannerText) (repeat '-')
main :: IO () main :: IO ()
...@@ -124,6 +124,10 @@ data Options = Options ...@@ -124,6 +124,10 @@ data Options = Options
, optWithTime :: Bool , optWithTime :: Bool
, optCommand :: Command } , optCommand :: Command }
-- The default options: no command, no timing, info log level
defaultOptions :: Options
defaultOptions = Options Info [] False NoCommand
data Command data Command
= NoCommand = NoCommand
| Config ConfigOptions | Config ConfigOptions
...@@ -365,9 +369,7 @@ applyEither (f:fs) z = case f z of ...@@ -365,9 +369,7 @@ applyEither (f:fs) z = case f z of
Right z' -> applyEither fs z' Right z' -> applyEither fs z'
applyParse :: [Options -> Either String Options] -> Either String Options applyParse :: [Options -> Either String Options] -> Either String Options
applyParse fs = applyEither fs defaultOpts applyParse fs = applyEither fs defaultOptions
where
defaultOpts = Options Info [] False NoCommand
(>.>) :: Either String a -> (a -> b) -> Either String b (>.>) :: Either String a -> (a -> b) -> Either String b
a >.> f = case a of a >.> f = case a of
...@@ -744,7 +746,7 @@ optionParser allargs = optParser ...@@ -744,7 +746,7 @@ optionParser allargs = optParser
Add (addOpts a) { addDependency = True } }) Add (addOpts a) { addDependency = True } })
( short "d" ( short "d"
<> long "dependency" <> long "dependency"
<> help "Add a dependency to the current package" ) <> help "Add only dependency to the current package" )
<.> flag (\a -> Right $ a { optCommand = <.> flag (\a -> Right $ a { optCommand =
Add (addOpts a) { forceAdd = True } }) Add (addOpts a) { forceAdd = True } })
( short "f" ( short "f"
...@@ -752,8 +754,8 @@ optionParser allargs = optParser ...@@ -752,8 +754,8 @@ optionParser allargs = optParser
<> help "Force, i.e., overwrite existing package" ) <> help "Force, i.e., overwrite existing package" )
<.> arg (\s a -> Right $ a { optCommand = <.> arg (\s a -> Right $ a { optCommand =
Add (addOpts a) { addSource = s } }) Add (addOpts a) { addSource = s } })
( metavar "PACKAGE" ( metavar "PACKAGE"
<> help "The package directory or name to be added" ) <> help "The package name (or directory for option '-p') to be added" )
-- Check if operating system executables we depend on are present on the -- Check if operating system executables we depend on are present on the
-- current system. Since this takes some time, it is only checked with -- current system. Since this takes some time, it is only checked with
...@@ -891,7 +893,7 @@ installCmd (InstallOptions (Just pkg) vers pre _ _) cfg = do ...@@ -891,7 +893,7 @@ installCmd (InstallOptions (Just pkg) vers pre _ _) cfg = do
fileExists <- doesFileExist pkg fileExists <- doesFileExist pkg
if fileExists if fileExists
then installFromZip cfg pkg then installFromZip cfg pkg
else installapp (CheckoutOptions pkg vers pre) cfg else installApp (CheckoutOptions pkg vers pre) cfg
installCmd (InstallOptions Nothing (Just _) _ _ _) _ = installCmd (InstallOptions Nothing (Just _) _ _ _) _ =
failIO "Must specify package name" failIO "Must specify package name"
...@@ -903,9 +905,10 @@ installCmd (InstallOptions Nothing (Just _) _ _ _) _ = ...@@ -903,9 +905,10 @@ installCmd (InstallOptions Nothing (Just _) _ _ _) _ =
--- Internal note: the installed package should not be cleaned or removed --- Internal note: the installed package should not be cleaned or removed
--- after the installation since its execution might refer (via the --- after the installation since its execution might refer (via the
--- config module) to some data stored in the package. --- config module) to some data stored in the package.
installapp :: CheckoutOptions -> Config -> IO (ErrorLogger ()) installApp :: CheckoutOptions -> Config -> IO (ErrorLogger ())
installapp opts cfg = do installApp opts cfg = do
let apppkgdir = appPackageDir cfg let apppkgdir = appPackageDir cfg
copname = coPackage opts
copkgdir = apppkgdir </> coPackage opts copkgdir = apppkgdir </> coPackage opts
curdir <- getCurrentDirectory curdir <- getCurrentDirectory
removeDirectoryComplete copkgdir removeDirectoryComplete copkgdir
...@@ -915,13 +918,15 @@ installapp opts cfg = do ...@@ -915,13 +918,15 @@ installapp opts cfg = do
log Debug ("Change into directory " ++ copkgdir) |> log Debug ("Change into directory " ++ copkgdir) |>
(setCurrentDirectory copkgdir >> succeedIO ()) |> (setCurrentDirectory copkgdir >> succeedIO ()) |>
loadPackageSpec "." |>= \pkg -> loadPackageSpec "." |>= \pkg ->
maybe (setCurrentDirectory curdir >> maybe
removeDirectoryComplete copkgdir >> (setCurrentDirectory curdir >>
failIO ("Package '" ++ name pkg ++ removeDirectoryComplete copkgdir >>
"' does not contain an executable, nothing installed.")) failIO ("Package '" ++ name pkg ++
(\_ -> installCmd (InstallOptions Nothing Nothing False True False) "' has no executable, nothing installed.\n" ++
cfg) "Hint: use 'cypm add " ++ copname ++
(executableSpec pkg) "' to add new dependency and install it."))
(\_ -> installCmd (InstallOptions Nothing Nothing False True False) cfg)
(executableSpec pkg)
) )
--- Checks the compiler compatibility. --- Checks the compiler compatibility.
...@@ -951,19 +956,11 @@ installExecutable cfg pkg = ...@@ -951,19 +956,11 @@ installExecutable cfg pkg =
in compiler (ExecOptions cmd) cfg |> in compiler (ExecOptions cmd) cfg |>
log Info ("Installing executable '" ++ name ++ "' into '" ++ log Info ("Installing executable '" ++ name ++ "' into '" ++
bindir ++ "'") |> bindir ++ "'") |>
(whenFileExists binexec (backupExistingBin binexec) >> (-- renaming might not work across file systems, hence we move:
-- renaming might not work across file systems, hence we move:
showExecCmd (unwords ["mv", mainmod, binexec]) >> showExecCmd (unwords ["mv", mainmod, binexec]) >>
checkPath path bindir)) checkPath path bindir))
(executableSpec pkg) (executableSpec pkg)
where where
backupExistingBin binexec = do
let binexecbak = binexec ++ ".bak"
showExecCmd $ "rm -f " ++ binexecbak
renameFile binexec binexecbak
infoMessage $ "Existing executable '" ++ binexec ++ "' saved to '" ++
binexecbak ++ "'."
checkPath path bindir = checkPath path bindir =
if bindir `elem` splitSearchPath path if bindir `elem` splitSearchPath path
then succeedIO () then succeedIO ()
...@@ -1125,11 +1122,14 @@ linkCmd (LinkOptions src) cfg = ...@@ -1125,11 +1122,14 @@ linkCmd (LinkOptions src) cfg =
--- any other package. --- any other package.
--- Option `--dependency`: add the package name as a dependency to the --- Option `--dependency`: add the package name as a dependency to the
--- current package --- current package
--- No option: like `--package` followed by `install` command
addCmd :: AddOptions -> Config -> IO (ErrorLogger ()) addCmd :: AddOptions -> Config -> IO (ErrorLogger ())
addCmd (AddOptions addpkg adddep pkg force) config addCmd (AddOptions addpkg adddep pkg force) config
| addpkg = addPackageToRepository config pkg force True | addpkg = addPackageToRepository config pkg force True
| adddep = addDependencyCmd pkg force config | adddep = addDependencyCmd pkg force config
| otherwise = log Critical "Option --package or --dependency missing!" | otherwise = addDependencyCmd pkg force config |>
installCmd (installOpts defaultOptions) config
useForce :: String useForce :: String
useForce = "Use option '-f' or '--force' to overwrite it." useForce = "Use option '-f' or '--force' to overwrite it."
......
...@@ -84,8 +84,10 @@ searchExportedModules cfg pat = ...@@ -84,8 +84,10 @@ searchExportedModules cfg pat =
) >>= return . filterExpModules . allPackages ) >>= return . filterExpModules . allPackages
where where
pattern = "%" ++ pat ++ "%" pattern = "%" ++ pat ++ "%"
lpat = map toLower pat
filterExpModules = filter (\p -> pat `elem` exportedModules p) filterExpModules = filter (\p -> any (\m -> lpat `isInfixOf` (map toLower m))
(exportedModules p))
toPackage (nm,vs,syn,cmp,exps) = toPackage (nm,vs,syn,cmp,exps) =
emptyPackage { name = nm emptyPackage { name = nm
...@@ -110,9 +112,9 @@ searchExecutable cfg pat = ...@@ -110,9 +112,9 @@ searchExecutable cfg pat =
) >>= return . filterExec . allPackages ) >>= return . filterExec . allPackages
where where
pattern = "%" ++ pat ++ "%" pattern = "%" ++ pat ++ "%"
s = map toLower pat lpat = map toLower pat
filterExec = filter (\p -> s `isInfixOf` (map toLower $ execOfPackage p)) filterExec = filter (\p -> lpat `isInfixOf` (map toLower $ execOfPackage p))
toPackage (nm,vs,syn,cmp,exec) = toPackage (nm,vs,syn,cmp,exec) =
emptyPackage { name = nm emptyPackage { name = nm
......
...@@ -84,8 +84,10 @@ searchExportedModules cfg pat = ...@@ -84,8 +84,10 @@ searchExportedModules cfg pat =
) >>= return . filterExpModules . allPackages ) >>= return . filterExpModules . allPackages
where where
pattern = "%" ++ pat ++ "%" pattern = "%" ++ pat ++ "%"
lpat = map toLower pat
filterExpModules = filter (\p -> pat `elem` exportedModules p) filterExpModules = filter (\p -> any (\m -> lpat `isInfixOf` (map toLower m))
(exportedModules p))
toPackage (nm,vs,syn,cmp,exps) = toPackage (nm,vs,syn,cmp,exps) =
emptyPackage { name = nm emptyPackage { name = nm
...@@ -110,9 +112,9 @@ searchExecutable cfg pat = ...@@ -110,9 +112,9 @@ searchExecutable cfg pat =
) >>= return . filterExec . allPackages ) >>= return . filterExec . allPackages
where where
pattern = "%" ++ pat ++ "%" pattern = "%" ++ pat ++ "%"
s = map toLower pat lpat = map toLower pat
filterExec = filter (\p -> s `isInfixOf` (map toLower $ execOfPackage p)) filterExec = filter (\p -> lpat `isInfixOf` (map toLower $ execOfPackage p))
toPackage (nm,vs,syn,cmp,exec) = toPackage (nm,vs,syn,cmp,exec) =
emptyPackage { name = nm emptyPackage { name = nm
......
...@@ -249,7 +249,7 @@ prune p = filterTree (not . p) ...@@ -249,7 +249,7 @@ prune p = filterTree (not . p)
--- Shows a textual representation of a tree. --- Shows a textual representation of a tree.
showTree :: Tree Doc -> String showTree :: Tree Doc -> String
showTree = pPrint . ppTree showTree t = "Package dependencies:\n" ++ pPrint (ppTree t)
--- Pretty prints a tree of Docs into a single Doc. --- Pretty prints a tree of Docs into a single Doc.
ppTree :: Tree Doc -> Doc ppTree :: Tree Doc -> Doc
...@@ -686,7 +686,7 @@ test_prefersLocalPackageCacheEvenIfOlder = ...@@ -686,7 +686,7 @@ test_prefersLocalPackageCacheEvenIfOlder =
db = addPackage (addPackage emptySet b101 FromLocalCache) b105 FromRepository db = addPackage (addPackage emptySet b101 FromLocalCache) b105 FromRepository
test_reportsCompilerIncompatibility :: Prop test_reportsCompilerIncompatibility :: Prop
test_reportsCompilerIncompatibility = showResult result -=- "The package json-1.0.0, dependency constraint json = 1.0.0, is not compatible to the current compiler. It was activated because:\nsample\n |- json (json = 1.0.0)" test_reportsCompilerIncompatibility = showResult result -=- "The package json-1.0.0, dependency constraint json = 1.0.0, is not compatible to the current compiler. It was activated because:\nPackage dependencies:\nsample\n |- json (json = 1.0.0)"
where result = resolve defaultConfig pkg db where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "= 1.0.0"] pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "= 1.0.0"]
json = cPackageCC "json" (1, 0, 0, Nothing) [cCC "nocompiler" "= 1.0.0"] json = cPackageCC "json" (1, 0, 0, Nothing) [cCC "nocompiler" "= 1.0.0"]
......
Copyright (c) 2017, <AUTHOR NAME> Copyright (c) 2019, <AUTHOR NAME>
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
......
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