Commit 7ff71421 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated: bug fixes for starting CPM with non-existing repository files

parent c72e1df7
......@@ -169,8 +169,9 @@ ASCII alphanumeric character as well as dashes (\code{-}) and underscores
(\code{_}). It must start with an alphanumeric character. The author field is a
free-form field, but the suggested format is either a name (\code{John Doe}),
or a name followed by an email address in angle brackets
(\code{John Doe <john.doe@goldenstate.gov>}). Separate multiple authors with
commas.
(\code{John Doe <john.doe@goldenstate.gov>}).
Multiple authors can either be separated by commas or written
as a list of strings.
Versions must be specified in the format laid out in the semantic versioning
standard:\footnote{\url{http://www.semver.org}} each version number consists of
......@@ -1131,19 +1132,21 @@ angle brackets, e.g.,
\begin{lstlisting}
John Doe <john@doe.com>
\end{lstlisting}
Multiple authors should be separated by commas.
Multiple authors can either be separated by commas or written
as a list of strings.
\item[\fbox{\code{maintainer}}] The current maintainers of the package, if
different from the original authors. This field allows the current maintainers
to indicate the best person or persons to contact about the package while
attributing the original authors.
The suggested format is a name followed by an email address in
angle brackets, e.g.,
The suggested format is similarly to the authors,
i.e., a name followed by an email address in angle brackets, e.g.,
\begin{lstlisting}
John Doe <john@doe.com>
\end{lstlisting}
Multiple maintainers should be separated by commas.
Multiple maintainers can either be separated by commas or written
as a list of strings.
\item[\fbox{\code{synopsis*}}] A short form summary of the package's purpose.
It should be kept as short as possible (ideally, less than 100 characters).
......@@ -1379,7 +1382,8 @@ are used:
"name": "PACKAGE_NAME",
"version": "0.0.1",
"author": "YOUR NAME <YOUR EMAIL ADDRESS>",
"maintainer": "ANOTHER NAME <ANOTHER EMAIL ADDRESS>",
"maintainer": [ "ANOTHER NAME <ANOTHER EMAIL ADDRESS>",
"FURTHER NAME <FURTHER EMAIL ADDRESS>" ],
"synopsis": "A ONE-LINE SUMMARY ABOUT THE PACKAGE",
"description": "A MORE DETAILED SUMMARY ABOUT THE PACKAGE",
"category": [ "Category1", "Category2" ],
......
......@@ -138,13 +138,10 @@ setHomePackageDir cfg
| null (homePackageDir cfg)
= do homedir <- getHomeDirectory
let cpmdir = homedir </> ".cpm"
excpmdir <- doesDirectoryExist cpmdir
if excpmdir
then let (cname,cmaj,cmin,crev) = compilerVersion cfg
cvname = cname ++ "-" ++ showVersionNumer (cmaj,cmin,crev)
homepkgdir = cpmdir </> cvname ++ "-homepackage"
in return cfg { homePackageDir = homepkgdir }
else return cfg
(cname,cmaj,cmin,crev) = compilerVersion cfg
cvname = cname ++ "-" ++ showVersionNumer (cmaj,cmin,crev)
homepkgdir = cpmdir </> cvname ++ "-homepackage"
return cfg { homePackageDir = homepkgdir }
| otherwise = return cfg
--- Sets the correct compiler version in the configuration.
......
......@@ -129,10 +129,10 @@ cPackage :: String -> Version -> [Dependency] -> Package
cPackage p v ds = emptyPackage {
name = p
, version = v
, author = "author"
, author = ["author"]
, synopsis = "JSON library for Curry"
, dependencies = ds
, maintainer = Nothing
, maintainer = []
, description = Nothing
, license = Nothing
, licenseFile = Nothing
......
......@@ -59,7 +59,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 17/01/2019)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 15/03/2019)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -1149,7 +1149,8 @@ addDependencyCmd pkgname force config =
addDepToLocalPackage vers pkgdir =
loadPackageSpec pkgdir |>= \pkgSpec ->
let depexists = pkgname `elem` dependencyNames pkgSpec
newdeps = addDep [[VGte vers]] (dependencies pkgSpec)
newdeps = addDep [[VGte vers, VLt (nextMajor vers)]]
(dependencies pkgSpec)
newpkg = pkgSpec { dependencies = newdeps }
in if force || not depexists
then writePackageSpec newpkg (pkgdir </> "package.json") |>>
......@@ -1466,7 +1467,7 @@ newPackage (NewOptions pname) = do
createDirectory pname
let pkgSpec = emptyPackage { name = pname
, version = initialVersion
, author = emptyAuthor
, author = [emptyAuthor]
, synopsis = emptySynopsis
, category = ["Programming"]
, dependencies = []
......
......@@ -5,7 +5,7 @@
------------------------------------------------------------------------------
module CPM.Package
( Version, initialVersion
( Version, initialVersion, nextMajor, nextMinor
, VersionConstraint (..)
, CompilerCompatibility (..)
, Package (..), emptyPackage
......@@ -65,6 +65,14 @@ type Version = (Int, Int, Int, Maybe String)
initialVersion :: Version
initialVersion = (0,0,1,Nothing)
--- The next major version of a given version.
nextMajor :: Version -> Version
nextMajor (maj,_,_,_) = (maj + 1, 0, 0, Nothing)
--- The next minor version of a given version.
nextMinor :: Version -> Version
nextMinor (maj,min,_,_) = (maj, min + 1, 0, Nothing)
type Conjunction = [VersionConstraint]
type Disjunction = [Conjunction]
......@@ -153,8 +161,8 @@ data GitRevision = Tag String
data Package = Package {
name :: String
, version :: Version
, author :: String
, maintainer :: Maybe String
, author :: [String]
, maintainer :: [String]
, synopsis :: String
, description :: Maybe String
, category :: [String]
......@@ -187,8 +195,8 @@ emptyPackage :: Package
emptyPackage = Package {
name = ""
, version = initialVersion
, author = ""
, maintainer = Nothing
, author = []
, maintainer = []
, synopsis = ""
, description = Nothing
, category = []
......@@ -220,9 +228,13 @@ execOfPackage p =
packageSpecToJSON :: Package -> JValue
packageSpecToJSON pkg = JObject $
[ ("name", JString $ name pkg)
, ("version", JString $ showVersion $ version pkg)
, ("author", JString $ author pkg) ] ++
maybeStringToJSON "maintainer" (maintainer pkg) ++
, ("version", JString $ showVersion $ version pkg) ] ++
(case author pkg of [] -> [("author", JString "")]
[s] -> [("author", JString s)]
xs -> stringListToJSON "author" xs) ++
(case maintainer pkg of [] -> []
[s] -> [ ("maintainer", JString s) ]
xs -> stringListToJSON "maintainer" xs) ++
[ ("synopsis", JString $ synopsis pkg) ] ++
maybeStringToJSON "description" (description pkg) ++
stringListToJSON "category" (category pkg) ++
......@@ -478,8 +490,8 @@ packageSpecFromJObject :: [(String, JValue)] -> Either String Package
packageSpecFromJObject kv =
mandatoryString "name" kv $ \name ->
mandatoryString "version" kv $ \versionS ->
mandatoryString "author" kv $ \author ->
optionalString "maintainer" kv $ \maintainer ->
getStringOrStringList True "An author" "author" $ \author ->
getStringOrStringList False "A maintainer" "maintainer" $ \maintainer ->
mandatoryString "synopsis" kv $ \synopsis ->
optionalString "description" kv $ \description ->
getStringList "A category" "category" $ \categories ->
......@@ -572,20 +584,42 @@ packageSpecFromJObject kv =
Just JNull -> Left $ "Expected an object, got 'null'" ++ forKey
where forKey = " for key 'source'"
getStringOrStringList :: Bool -> String -> String
-> ([String] -> Either String a)
-> Either String a
getStringOrStringList mandatory keystr key f = case lookup key kv of
Nothing -> if mandatory
then Left $ "Mandatory field missing: '" ++ key ++ "'"
else f []
Just (JArray a) -> case stringsFromJArray keystr a of
Left e -> Left e
Right e -> f e
Just (JString s) -> f [s]
Just (JObject _) -> Left $ expectedText ++ "an object" ++ forKey
Just (JNumber _) -> Left $ expectedText ++ "a number" ++ forKey
Just JTrue -> Left $ expectedText ++ "'true'" ++ forKey
Just JFalse -> Left $ expectedText ++ "'false'" ++ forKey
Just JNull -> Left $ expectedText ++ "'null'" ++ forKey
where
forKey = " for key '" ++ key ++ "'"
expectedText = "Expected an array, got "
getStringList :: String -> String -> ([String] -> Either String a)
-> Either String a
getStringList keystr key f = case lookup key kv of
Nothing -> f []
Just (JArray a) -> case stringsFromJArray keystr a of
Left e -> Left e
Left e -> Left e
Right e -> f e
Just (JObject _) -> Left $ "Expected an array, got an object" ++ forKey
Just (JString _) -> Left $ "Expected an array, got a string" ++ forKey
Just (JNumber _) -> Left $ "Expected an array, got a number" ++ forKey
Just JTrue -> Left $ "Expected an array, got 'true'" ++ forKey
Just JFalse -> Left $ "Expected an array, got 'false'" ++ forKey
Just JNull -> Left $ "Expected an array, got 'null'" ++ forKey
where forKey = " for key '" ++ key ++ "'"
Just (JObject _) -> Left $ expectedText ++ "an object" ++ forKey
Just (JString _) -> Left $ expectedText ++ "a string" ++ forKey
Just (JNumber _) -> Left $ expectedText ++ "a number" ++ forKey
Just JTrue -> Left $ expectedText ++ "'true'" ++ forKey
Just JFalse -> Left $ expectedText ++ "'false'" ++ forKey
Just JNull -> Left $ expectedText ++ "'null'" ++ forKey
where
forKey = " for key '" ++ key ++ "'"
expectedText = "Expected an array, got "
getExecutableSpec :: (Maybe PackageExecutable -> Either String a)
-> Either String a
......@@ -675,7 +709,7 @@ test_specFromJObject_minimalSpec =
is (packageSpecFromJObject obj) (\x -> isRight x && test x)
where obj = [ ("name", JString "mypackage"), ("author", JString "me")
, ("synopsis", JString "great!"), ("version", JString "1.2.3")]
test x = author p == "me" && name p == "mypackage"
test x = author p == ["me"] && name p == "mypackage"
where p = (head . rights) [x]
--- Reads a list of strings from a list of JValues.
......@@ -818,14 +852,15 @@ getOptStringList optional key kv = case lookup (key++"s") kv of
then Right []
else Left $ "'"++key++"s' is not provided in 'testsuite'"
Just (JArray a) -> stringsFromJArray ("A "++key) a
Just (JObject _) -> Left $ "Expected an array, got an object" ++ forKey
Just (JString _) -> Left $ "Expected an array, got a string" ++ forKey
Just (JNumber _) -> Left $ "Expected an array, got a number" ++ forKey
Just JTrue -> Left $ "Expected an array, got 'true'" ++ forKey
Just JFalse -> Left $ "Expected an array, got 'false'" ++ forKey
Just JNull -> Left $ "Expected an array, got 'null'" ++ forKey
Just (JObject _) -> Left $ expectedText ++ "an object" ++ forKey
Just (JString _) -> Left $ expectedText ++ "a string" ++ forKey
Just (JNumber _) -> Left $ expectedText ++ "a number" ++ forKey
Just JTrue -> Left $ expectedText ++ "'true'" ++ forKey
Just JFalse -> Left $ expectedText ++ "'false'" ++ forKey
Just JNull -> Left $ expectedText ++ "'null'" ++ forKey
where
forKey = " for key '" ++ key ++ "s'"
expectedText = "Expected an array, got "
--- Reads documentation specification from the key-value-pairs of a JObject.
docuSpecFromJObject :: [(String, JValue)] -> Either String PackageDocumentation
......
......@@ -154,16 +154,17 @@ renderPackageInfo allinfos plain installed pkg = pPrint doc
ver = fill maxLen (boldText "Version") <+>
(text $ showVersion $ version pkg)
auth = fill maxLen (boldText "Author") <+>
indent 0 (fillSep (map (text . strip) (splitOn "," $ author pkg)))
indent 0 (fillSep (map (text . strip)
(concatMap (splitOn ",") $ author pkg)))
synop = fill maxLen (boldText "Synopsis") <+>
indent 0 (fillSep (map text (words (synopsis pkg))))
deps = boldText "Dependencies" <$$>
(vcat $ map (indent 4 . text . showDependency) $ dependencies pkg)
maintnr = case maintainer pkg of
Nothing -> empty
Just s -> fill maxLen (boldText "Maintainer") <+>
indent 0 (fillSep (map (text . strip) (splitOn "," s)))
[] -> empty
xs -> fill maxLen (boldText "Maintainer") <+>
indent 0 (fillSep (map (text . strip) (concatMap (splitOn ",") xs)))
cats =
if null (category pkg)
......@@ -279,7 +280,7 @@ getLocalPackageSpec cfg dir = do
let newpkg = emptyPackage
{ name = snd (splitFileName homepkgdir)
, version = initialVersion
, author = "CPM"
, author = ["CPM"]
, synopsis = "Default home package"
, dependencies = []
}
......
......@@ -179,9 +179,8 @@ tryReadRepositoryFrom path = do
verPaths <- return $ concatMap (\ (d, p) -> map (d </>) p)
$ zip pkgPaths verDirs
specPaths <- return $ map (</> "package.json") verPaths
putStr "Reading repository index"
infoMessage "Reading repository index..."
specs <- mapIO readPackageFile specPaths
putChar '\n'
when (null (lefts specs)) $ debugMessage "Finished reading repository"
return $ (Repository $ rights specs, lefts specs)
where
......
......@@ -523,7 +523,6 @@ isDisjunctionCompatible ver cs = any id (map (all id) rs)
isCompatible (VGte v) = ver `vgte` v && preReleaseCompatible ver v
isCompatible (VCompatible v) = ver `vgte` v && ver `vlt` (nextMinor v) &&
preReleaseCompatible ver v
nextMinor (maj, min, _, _) = (maj, min + 1, 0, Nothing)
test_onlyConjunctionCompatible :: Prop
test_onlyConjunctionCompatible = isDisjunctionCompatible ver dis -=- True
......@@ -696,10 +695,10 @@ cPackage :: String -> Version -> [Dependency] -> Package
cPackage p v ds = emptyPackage {
name = p
, version = v
, author = "author"
, author = ["author"]
, synopsis = "JSON library for Curry"
, dependencies = ds
, maintainer = Nothing
, maintainer = []
, description = Nothing
, license = Nothing
, licenseFile = Nothing
......@@ -716,10 +715,10 @@ cPackageCC :: String -> Version -> [CompilerCompatibility] -> Package
cPackageCC p v cs = emptyPackage {
name = p
, version = v
, author = "author"
, author = ["author"]
, synopsis = "JSON library for Curry"
, dependencies = []
, maintainer = Nothing
, maintainer = []
, description = Nothing
, license = Nothing
, licenseFile = Nothing
......
......@@ -33,18 +33,19 @@ import System.CurryPath ( getLoadPathForModule )
--- Data type for representing the different target files that can be produced
--- by the front end of the Curry compiler.
--- @cons FCY - FlatCurry file ending with .fcy
--- @cons TFCY - Typed FlatCurry file ending with .tfcy
--- @cons FINT - FlatCurry interface file ending with .fint
--- @cons ACY - AbstractCurry file ending with .acy
--- @cons UACY - Untyped (without type checking) AbstractCurry file ending with .uacy
--- @cons HTML - colored HTML representation of source program
--- @cons CY - source representation employed by the frontend
--- @cons TOKS - token stream of source program
--- @cons AST - abstract syntax tree ending with .sast
--- @cons SAST - shortened abstract syntax tree ending with .sast
--- @cons FCY - FlatCurry file ending with .fcy
--- @cons TFCY - Typed FlatCurry file ending with .tfcy
--- @cons FINT - FlatCurry interface file ending with .fint
--- @cons ACY - AbstractCurry file ending with .acy
--- @cons UACY - Untyped (without type checking) AbstractCurry file ending with .uacy
--- @cons HTML - colored HTML representation of source program
--- @cons CY - source representation employed by the frontend
--- @cons TOKS - token stream of source program
--- @cons AST - abstract syntax tree ending with .sast
--- @cons SAST - shortened abstract syntax tree ending with .sast
--- @cons COMMS - comments stream ending with .cycom
data FrontendTarget = FCY | TFCY | FINT | ACY | UACY | HTML | CY | TOKS | TAFCY
| AST | SAST
| AST | SAST | COMMS
deriving Eq
--- Abstract data type for representing parameters supported by the front end
......@@ -248,6 +249,7 @@ callFrontendWithParams target params modpath = do
showFrontendTarget TOKS = "--tokens"
showFrontendTarget AST = "--ast"
showFrontendTarget SAST = "--short-ast"
showFrontendTarget COMMS = "--comments"
showFrontendParams = unwords
[ if quiet params then runQuiet else ""
......
......@@ -4,15 +4,12 @@
--- @author Michael Hanus
--- @version January 2019
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Debug.Profile
( ProcessInfo(..), getProcessInfos, showMemInfo, printMemInfo
, garbageCollectorOff, garbageCollectorOn, garbageCollect
, profileTime, profileTimeNF, profileSpace, profileSpaceNF
#ifdef __PAKCS__
, evalTime, evalSpace
#endif
, getTimings, getTimingsNF
)
where
......@@ -82,23 +79,38 @@ printMemInfo = getProcessInfos >>= putStrLn . showMemInfo
--- Print the time needed to execute a given IO action.
profileTime :: IO a -> IO a
profileTime action = do
(result,rt,et,gc) <- getTimings action
putStrLn $ "Run time: " ++ show rt ++ " msec."
putStrLn $ "Elapsed time: " ++ show et ++ " msec."
putStrLn $ "Garbage collections: " ++ show gc
return result
--- Returns the run time, elapsed time, and number of garbage collections
--- needed to execute a given IO action.
getTimings :: IO a -> IO (a,Int,Int,Int)
getTimings action = do
garbageCollect
pi1 <- getProcessInfos
result <- action
pi2 <- getProcessInfos
putStrLn $ "Run time: "
++ (showInfoDiff pi1 pi2 RunTime) ++ " msec."
putStrLn $ "Elapsed time: "
++ (showInfoDiff pi1 pi2 ElapsedTime) ++ " msec."
putStrLn $ "Garbage collections: "
++ (showInfoDiff pi1 pi2 GarbageCollections)
return result
return (result,
infoDiff pi1 pi2 RunTime,
infoDiff pi1 pi2 ElapsedTime,
infoDiff pi1 pi2 GarbageCollections)
--- Evaluates the argument to normal form
--- and print the time needed for this evaluation.
profileTimeNF :: a -> IO ()
profileTimeNF exp = profileTime (seq (id $!! exp) done)
--- Evaluates the argument to normal form
--- and returns the run time, elapsed time, and number of garbage collections
--- needed for this evaluation.
getTimingsNF :: a -> IO (Int,Int,Int)
getTimingsNF exp = do
(_,rt,et,gc) <- getTimings (seq (id $!! exp) done)
return (rt,et,gc)
--- Print the time and space needed to execute a given IO action.
--- During the executation, the garbage collector is turned off to get the
--- total space usage.
......@@ -134,17 +146,6 @@ showInfoDiff :: [(ProcessInfo, Int)] -> [(ProcessInfo, Int)] -> ProcessInfo
showInfoDiff infos1 infos2 item =
show (maybe 0 id (lookup item infos2) - maybe 0 id (lookup item infos1))
#ifdef __PAKCS__
--- Evaluates the argument to normal form (and return the normal form)
--- and print the time needed for this evaluation on standard error.
--- Included for backward compatibility only, use profileTime!
evalTime :: a -> a
evalTime external
--- Evaluates the argument to normal form (and return the normal form)
--- and print the time and space needed for this evaluation on standard error.
--- During the evaluation, the garbage collector is turned off.
--- Included for backward compatibility only, use profileSpace!
evalSpace :: a -> a
evalSpace external
#endif
infoDiff :: [(ProcessInfo, Int)] -> [(ProcessInfo, Int)] -> ProcessInfo -> Int
infoDiff infos1 infos2 item =
maybe 0 id (lookup item infos2) - maybe 0 id (lookup item infos1)
......@@ -17,12 +17,4 @@
<library>prim_debug_profile</library>
<entry>prim_garbageCollect</entry>
</primitive>
<primitive name="evalTime" arity="1">
<library>prim_debug_profile</library>
<entry>prim_evalTime[raw]</entry>
</primitive>
<primitive name="evalSpace" arity="1">
<library>prim_debug_profile</library>
<entry>prim_evalSpace[raw]</entry>
</primitive>
</primitives>
......@@ -33,18 +33,19 @@ import System.CurryPath ( getLoadPathForModule )
--- Data type for representing the different target files that can be produced
--- by the front end of the Curry compiler.
--- @cons FCY - FlatCurry file ending with .fcy
--- @cons TFCY - Typed FlatCurry file ending with .tfcy
--- @cons FINT - FlatCurry interface file ending with .fint
--- @cons ACY - AbstractCurry file ending with .acy
--- @cons UACY - Untyped (without type checking) AbstractCurry file ending with .uacy
--- @cons HTML - colored HTML representation of source program
--- @cons CY - source representation employed by the frontend
--- @cons TOKS - token stream of source program
--- @cons AST - abstract syntax tree ending with .sast
--- @cons SAST - shortened abstract syntax tree ending with .sast
--- @cons FCY - FlatCurry file ending with .fcy
--- @cons TFCY - Typed FlatCurry file ending with .tfcy
--- @cons FINT - FlatCurry interface file ending with .fint
--- @cons ACY - AbstractCurry file ending with .acy
--- @cons UACY - Untyped (without type checking) AbstractCurry file ending with .uacy
--- @cons HTML - colored HTML representation of source program
--- @cons CY - source representation employed by the frontend
--- @cons TOKS - token stream of source program
--- @cons AST - abstract syntax tree ending with .sast
--- @cons SAST - shortened abstract syntax tree ending with .sast
--- @cons COMMS - comments stream ending with .cycom
data FrontendTarget = FCY | TFCY | FINT | ACY | UACY | HTML | CY | TOKS | TAFCY
| AST | SAST
| AST | SAST | COMMS
deriving Eq
--- Abstract data type for representing parameters supported by the front end
......@@ -248,6 +249,7 @@ callFrontendWithParams target params modpath = do
showFrontendTarget TOKS = "--tokens"
showFrontendTarget AST = "--ast"
showFrontendTarget SAST = "--short-ast"
showFrontendTarget COMMS = "--comments"
showFrontendParams = unwords
[ if quiet params then runQuiet else ""
......
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