Skip to content

GitLab

Commit 50abf574 authored by Michael Hanus's avatar Michael Hanus
Browse files

CPM updated

parent be83699c
Hide whitespace changes
Inline Side-by-side
cpm/src/CPM/Main.curry
View file @ 50abf574
......@@ -13,6 +13,7 @@ import Directory ( doesFileExist, getAbsolutePath, doesDirectoryExist
import Distribution ( stripCurrySuffix, addCurrySubdir )
import Either
import FilePath ( (</>), splitSearchPath, takeExtension )
import qualified HTML as H
import IO ( hFlush, stdout )
import List ( groupBy, intercalate, nub, split, splitOn )
import Sort ( sortBy )
......@@ -45,7 +46,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 20/04/2017)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 25/04/2017)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -171,12 +172,15 @@ data UninstallOptions = UninstallOptions
data InfoOptions = InfoOptions
{ infoPackage :: Maybe String
, infoVersion :: Maybe Version
, infoAll :: Bool }
, infoAll :: Bool
, infoPlain :: Bool -- plain output, no bold/color
}
data ListOptions = ListOptions
{ listAll :: Bool -- list all versions of each package
, listCSV :: Bool -- list in CSV format
, listCat :: Bool -- list all categories
{ listAll :: Bool -- list all versions of each package
, listCSV :: Bool -- list in CSV format
, listHTML :: Bool -- list in HTML format
, listCat :: Bool -- list all categories
}
data SearchOptions = SearchOptions
......@@ -227,12 +231,12 @@ uninstallOpts s = case optCommand s of
infoOpts :: Options -> InfoOptions
infoOpts s = case optCommand s of
PkgInfo opts -> opts
_ -> InfoOptions Nothing Nothing False
_ -> InfoOptions Nothing Nothing False False
listOpts :: Options -> ListOptions
listOpts s = case optCommand s of
List opts -> opts
_ -> ListOptions False False False
_ -> ListOptions False False False False
searchOpts :: Options -> SearchOptions
searchOpts s = case optCommand s of
......@@ -327,10 +331,6 @@ optionParser = optParser
(help "Install the application provided by a package.")
Right
(checkoutArgs InstallApp)
<|> command "installbin" -- deprecated: TODO: remove in the future
(help "Deprecated, use command 'installapp'.")
Right
(checkoutArgs InstallApp)
<|> command "install" (help "Install a package.")
(\a -> Right $ a { optCommand = Install (installOpts a) })
installArgs
......@@ -463,7 +463,12 @@ optionParser = optParser
{ infoAll = True } })
( short "a"
<> long "all"
<> help "Show all infos"
<> help "Show all infos" )
<.> flag (\a -> Right $ a { optCommand = PkgInfo (infoOpts a)
{ infoPlain = True } })
( short "p"
<> long "plain"
<> help "Plain output (no control characters for bold or colors)"
<> optional )
testArgs =
......@@ -505,18 +510,23 @@ optionParser = optParser
"Do not use automatic termination analysis for safe behavior checking")
listArgs =
flag (\a -> Right $ a { optCommand = List (listOpts a)
{ listAll = True } })
flag (\a -> Right $ a { optCommand =
List (listOpts a) { listAll = True } })
( short "a"
<> long "all"
<> help "Show all versions" )
<.> flag (\a -> Right $ a { optCommand = List (listOpts a)
{ listCSV = True } })
<.> flag (\a -> Right $ a { optCommand =
List (listOpts a) { listCSV = True } })
( short "t"
<> long "csv"
<> help "Show in CSV table format" )
<.> flag (\a -> Right $ a { optCommand = List (listOpts a)
{ listCat = True } })
<.> flag (\a -> Right $ a { optCommand =
List (listOpts a) { listHTML = True } })
( short "x"
<> long "html"
<> help "Show in HTML format" )
<.> flag (\a -> Right $ a { optCommand =
List (listOpts a) { listCat = True } })
( short "c"
<> long "category"
<> help "Show all categories" )
......@@ -563,24 +573,26 @@ deps cfg repo gc =
info :: InfoOptions -> Config -> Repository -> GlobalCache
-> IO (ErrorLogger ())
info (InfoOptions Nothing Nothing allinfos) _ repo gc =
info (InfoOptions Nothing Nothing allinfos plain) _ _ gc =
tryFindLocalPackageSpec "." |>= \specDir ->
loadPackageSpec specDir |>= printInfo allinfos repo gc
info (InfoOptions (Just pkg) Nothing allinfos) cfg repo gc =
loadPackageSpec specDir |>= printInfo allinfos plain gc
info (InfoOptions (Just pkg) Nothing allinfos plain) cfg repo gc =
case findLatestVersion cfg repo pkg False of
Nothing -> failIO $
"Package '" ++ pkg ++ "' not found in package repository."
Just p -> printInfo allinfos repo gc p
info (InfoOptions (Just pkg) (Just v) allinfos) _ repo gc =
Just p -> printInfo allinfos plain gc p
info (InfoOptions (Just pkg) (Just v) allinfos plain) _ repo gc =
case findVersion repo pkg v of
Nothing -> failIO $ "Package '" ++ pkg ++ "-" ++ (showVersion v) ++
"' not found in package repository."
Just p -> printInfo allinfos repo gc p
info (InfoOptions Nothing (Just _) _) _ _ _ = failIO "Must specify package name"
Just p -> printInfo allinfos plain gc p
info (InfoOptions Nothing (Just _) _ _) _ _ _ =
failIO "Must specify package name"
printInfo :: Bool -> Repository -> GlobalCache -> Package -> IO (ErrorLogger ())
printInfo allinfos repo gc pkg =
putStrLn (renderPackageInfo allinfos repo gc pkg) >> succeedIO ()
printInfo :: Bool -> Bool -> GlobalCache -> Package
-> IO (ErrorLogger ())
printInfo allinfos plain gc pkg =
putStrLn (renderPackageInfo allinfos plain gc pkg) >> succeedIO ()
compiler :: CompilerOptions -> Config -> IO Repository -> IO GlobalCache
......@@ -748,9 +760,14 @@ tryFindVersion pkg ver repo = case findVersion repo pkg ver of
--- Lists all (compiler-compatible) packages in the given repository.
listCmd :: ListOptions -> Config -> Repository -> IO (ErrorLogger ())
listCmd (ListOptions lv csv cat) cfg repo =
if cat then putStr (renderCats catgroups) >> succeedIO ()
else putStr (renderPkgs allpkgs) >> succeedIO ()
listCmd (ListOptions lv csv html cat) cfg repo =
let listresult = if cat then renderCats catgroups
else
if html
then renderHtml "Curry Packages in the CPM Repository"
[packageVersionsAsHtmlTable allpkgs]
else renderPkgs allpkgs
in putStr listresult >> succeedIO ()
where
-- all packages (and versions if `lv`)
allpkgs = concatMap (if lv then id else ((:[]) . head))
......@@ -769,16 +786,18 @@ listCmd (ListOptions lv csv cat) cfg repo =
if null nocatps then []
else [("???", nub $ sortBy (<=) nocatps)]
renderHtml title hexps = H.showHtmlPage (H.standardPage title hexps)
renderPkgs pkgs =
let (colsizes,rows) = packageVersionAsTable pkgs
in renderTable colsizes rows
renderCats catgrps =
let namelen = foldl max 8 $ map (length . fst) catgrps
let namelen = foldl max 2 $ map (length . fst) catgrps
header = [ ["Category", "Packages"]
, ["--------", "--------"]]
rows = header ++ map (\ (c,ns) -> [c, unwords ns]) catgrps
in renderTable [namelen + 4, 76 - namelen] rows
in renderTable [namelen + 2, 78 - namelen] rows
renderTable colsizes rows =
if csv then showCSV (head rows : drop 2 rows)
......@@ -789,13 +808,23 @@ listCmd (ListOptions lv csv cat) cfg repo =
packageVersionAsTable :: [Package] -> ([Int],[[String]])
packageVersionAsTable pkgs = (colsizes, rows)
where
namelen = foldl max 4 $ map (length . name) pkgs
colsizes = [namelen + 4, 66 - namelen, 10]
namelen = foldl max 2 $ map (length . name) pkgs
colsizes = [namelen + 2, 68 - namelen, 10]
header = [ ["Name", "Synopsis", "Version"]
, ["----", "--------", "-------"]]
rows = header ++ map formatPkg pkgs
formatPkg p = [name p, synopsis p, showVersion (version p)]
-- Format a list of packages by showing their names, synopsis, and versions
-- as an HTML table
packageVersionsAsHtmlTable :: [Package] -> H.HtmlExp
packageVersionsAsHtmlTable pkgs = H.headedTable $
map (\r -> map (\c -> [H.htxt c]) r) rows
where
header = [ ["Name", "Synopsis", "Version"] ]
rows = header ++ map formatPkg pkgs
formatPkg p = [name p, synopsis p, showVersion (version p)]
cpmInfo :: String
cpmInfo = "Use 'cpm info PACKAGE' for more information about a package."
......@@ -984,7 +1013,7 @@ cleanPackage ll =
(maybe []
(map (\ (PackageTest m _ _ _) -> m))
(testSuite pkg))
rmdirs = dotcpm : map addCurrySubdir (srcdirs ++ testdirs)
rmdirs = nub (dotcpm : map addCurrySubdir (srcdirs ++ testdirs))
in log ll ("Removing directories: " ++ unwords rmdirs) |>
(system (unwords (["rm", "-rf"] ++ rmdirs)) >> succeedIO ())
......
cpm/src/CPM/Package.curry
View file @ 50abf574
......@@ -178,24 +178,77 @@ emptyPackage = Package {
, testSuite = Nothing
}
--- Translates the basic package elements to a JSON object.
--- Translates a package to a JSON object.
packageSpecToJSON :: Package -> JValue
packageSpecToJSON pkg = JObject $ [
("name", JString $ name pkg)
packageSpecToJSON pkg = JObject $
[ ("name", JString $ name pkg)
, ("version", JString $ showVersion $ version pkg)
, ("author", JString $ author pkg)
, ("synopsis", JString $ synopsis pkg)
, ("category", stringListToJSON $ category pkg)
, ("dependencies", dependenciesToJSON $ dependencies pkg)
, ("exportedModules", stringListToJSON $ exportedModules pkg) ] ++
maybeStringToJSON "license" (license pkg) ++
maybeStringToJSON "licenseFile" (licenseFile pkg)
, ("author", JString $ author pkg) ] ++
maybeStringToJSON "maintainer" (maintainer pkg) ++
[ ("synopsis", JString $ synopsis pkg) ] ++
maybeStringToJSON "description" (description pkg) ++
stringListToJSON "category" (category pkg) ++
maybeStringToJSON "license" (license pkg) ++
maybeStringToJSON "licenseFile" (licenseFile pkg) ++
maybeStringToJSON "copyright" (copyright pkg) ++
maybeStringToJSON "homepage" (homepage pkg) ++
maybeStringToJSON "bugReports" (bugReports pkg) ++
maybeStringToJSON "repository" (repository pkg) ++
[ ("dependencies", dependenciesToJSON $ dependencies pkg) ] ++
compilerCompatibilityToJSON (compilerCompatibility pkg) ++
maybeSourceToJSON (source pkg) ++
stringListToJSON "sourceDirs" (sourceDirs pkg) ++
stringListToJSON "exportedModules" (exportedModules pkg) ++
maybeStringToJSON "configModule" (configModule pkg) ++
maybeExecToJSON (executableSpec pkg) ++
maybeTestToJSON (testSuite pkg)
where
dependenciesToJSON deps = JObject $ map dependencyToJSON deps
dependencyToJSON (Dependency p vc) = (p, JString $ showVersionConstraints vc)
stringListToJSON exps = JArray $ map JString exps
maybeStringToJSON fname mbcont =
maybe [] (\s -> [(fname, JString s)]) mbcont
where dependencyToJSON (Dependency p vc) =
(p, JString $ showVersionConstraints vc)
compilerCompatibilityToJSON deps =
if null deps
then []
else [("compilerCompatibility", JObject $ map compatToJSON deps)]
where compatToJSON (CompilerCompatibility p vc) =
(p, JString $ showVersionConstraints vc)
maybeSourceToJSON =
maybe [] (\src -> [("source", JObject (pkgSourceToJSON src))])
where
pkgSourceToJSON (FileSource _) =
error "Internal error: FileSource in package specification"
pkgSourceToJSON (Http url) = [("http", JString url)]
pkgSourceToJSON (Git url mbrev) =
[("git", JString url)] ++ maybe [] revToJSON mbrev
where
revToJSON (Ref t) = [("ref", JString t)]
revToJSON (Tag t) = [("tag", JString t)]
revToJSON VersionAsTag = [("tag", JString "$version")]
maybeExecToJSON =
maybe [] (\ (PackageExecutable ename emain) ->
[("executable", JObject [ ("name", JString ename)
, ("main", JString emain)])])
maybeTestToJSON = maybe [] (\tests -> [("testsuite", testsToJSON tests)])
where
testsToJSON tests = if length tests == 1
then testToJSON (head tests)
else JArray $ map testToJSON tests
testToJSON (PackageTest dir mods opts script) = JObject $
[ ("src-dir", JString dir) ] ++
(if null opts then [] else [("options", JString opts)]) ++
stringListToJSON "modules" mods ++
(if null script then [] else [("script", JString script)])
stringListToJSON fname exps =
if null exps then []
else [(fname, JArray $ map JString exps)]
maybeStringToJSON fname = maybe [] (\s -> [(fname, JString s)])
--- Writes a basic package specification to a JSON file.
---
......@@ -204,6 +257,7 @@ packageSpecToJSON pkg = JObject $ [
writePackageSpec :: Package -> String -> IO ()
writePackageSpec pkg file = writeFile file $ ppJSON $ packageSpecToJSON pkg
--- Loads a package specification from a package directory.
---
--- @param the directory containing the package.json file
......@@ -673,7 +727,7 @@ getOptStringList optional key kv = case lookup (key++"s") kv of
--- a list of lists of version constraints. The inner lists are conjunctions of
--- version constraints, the outer list is a disjunction of conjunctions.
readVersionConstraints :: String -> Maybe [[VersionConstraint]]
readVersionConstraints s = parse pVersionConstraints s
readVersionConstraints s = parse pVersionConstraints (dropWhile isSpace s)
test_readVersionConstraints_single :: Test.EasyCheck.Prop
test_readVersionConstraints_single = readVersionConstraints "=1.2.3" -=- Just [[VExact (1, 2, 3, Nothing)]]
......
cpm/src/CPM/PackageCopy.curry
View file @ 50abf574
......@@ -202,9 +202,10 @@ resolveDependencies cfg repo gc dir = loadPackageSpec dir |->
\pkgSpec -> resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir
--- Renders information on a package.
renderPackageInfo :: Bool -> Repository -> GC.GlobalCache -> Package -> String
renderPackageInfo allinfos _ gc pkg = pPrint doc
renderPackageInfo :: Bool -> Bool -> GC.GlobalCache -> Package -> String
renderPackageInfo allinfos plain gc pkg = pPrint doc
where
boldText s = (if plain then id else bold) $ text s
maxLen = 12
doc = vcat $ [ heading, rule, installed, ver, auth, maintnr, synop
, cats, deps, compilers, descr ] ++
......@@ -217,50 +218,51 @@ renderPackageInfo allinfos _ gc pkg = pPrint doc
isInstalled = GC.isPackageInstalled gc pkg
heading = text pkgId
installed = if isInstalled then empty else red $ text "Not installed"
installed = if isInstalled || plain then empty
else red $ text "Not installed"
rule = text (take (length pkgId) $ repeat '-')
ver = fill maxLen (bold (text "Version")) <+>
ver = fill maxLen (boldText "Version") <+>
(text $ showVersion $ version pkg)
auth = fill maxLen (bold (text "Author")) <+> (text $ author pkg)
synop = fill maxLen (bold (text "Synopsis")) <+>
auth = fill maxLen (boldText "Author") <+> (text $ author pkg)
synop = fill maxLen (boldText "Synopsis") <+>
indent 0 (fillSep (map text (words (synopsis pkg))))
deps = (bold $ text "Dependencies") <$$>
deps = boldText "Dependencies" <$$>
(vcat $ map (indent 4 . text . showDependency) $ dependencies pkg)
maintnr = case maintainer pkg of
Nothing -> empty
Just s -> fill maxLen (bold (text "Maintainer")) <+> text s
Just s -> fill maxLen (boldText "Maintainer") <+> text s
cats =
if null (category pkg)
then empty
else fill maxLen (bold (text "Category")) <+>
else fill maxLen (boldText "Category") <+>
indent 0 (fillSep (map text (category pkg)))
execspec = case executableSpec pkg of
Nothing -> empty
Just (PackageExecutable n m) ->
bold (text "Executable") <$$>
indent 4 (bold (text "Name ") <+> text n) <$$>
indent 4 (bold (text "Main module ") <+> text m)
boldText "Executable" <$$>
indent 4 (boldText "Name " <+> text n) <$$>
indent 4 (boldText "Main module " <+> text m)
testsuites = case testSuite pkg of
Nothing -> []
Just tests ->
map (\ (PackageTest dir mods opts script) ->
let check = if null script then "Check" else "Test" in
bold (text "Test suite") <$$>
indent 4 (bold (text "Directory ") <+> text dir) <$$>
boldText "Test suite" <$$>
indent 4 (boldText "Directory " <+> text dir) <$$>
(if null script
then empty
else indent 4 (bold (text "Test script ") <+> text script)) <$$>
else indent 4 (boldText "Test script " <+> text script)) <$$>
(if null opts
then empty
else indent 4 (bold (text $ check++" options") <+>
else indent 4 (boldText (check++" options") <+>
text opts)) <$$>
(if null mods
then empty
else indent 4 (bold (text "Test modules ") <+>
else indent 4 (boldText "Test modules " <+>
align (fillSep (map text mods)))))
tests
......@@ -279,34 +281,34 @@ renderPackageInfo allinfos _ gc pkg = pPrint doc
Just (Git s _) -> showSource s
Just (FileSource s) -> showSource s
where
showSource s = bold (text "Source") <$$> indent 4 (text s)
showSource s = boldText "Source" <$$> indent 4 (text s)
srcdirs =
if null (sourceDirs pkg)
then empty
else bold (text "Source directories") <$$>
else boldText "Source directories" <$$>
indent 4 (fillSep (map text (sourceDirs pkg)))
expmods =
if null (exportedModules pkg)
then empty
else bold (text "Exported modules") <$$>
else boldText "Exported modules" <$$>
indent 4 (fillSep (map text (exportedModules pkg)))
compilers =
if null (compilerCompatibility pkg)
then empty
else bold (text "Compiler compatibility") <$$>
else boldText "Compiler compatibility" <$$>
(vcat $ map (indent 4 . text . showCompilerDependency)
$ compilerCompatibility pkg)
showLineField fgetter fname = case fgetter pkg of
Nothing -> empty
Just s -> bold (text fname) <$$> indent 4 (text s)
Just s -> boldText fname <$$> indent 4 (text s)
showParaField fgetter fname = case fgetter pkg of
Nothing -> empty
Just s -> bold (text fname) <$$>
Just s -> boldText fname <$$>
indent 4 (fillSep (map text (words s)))
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