diff --git a/Distribution/Server/Features/Documentation.hs b/Distribution/Server/Features/Documentation.hs index accab7bc6..e99538d1b 100644 --- a/Distribution/Server/Features/Documentation.hs +++ b/Distribution/Server/Features/Documentation.hs @@ -49,6 +49,7 @@ data DocumentationFeature = DocumentationFeature { uploadDocumentation :: DynamicPath -> ServerPartE Response, deleteDocumentation :: DynamicPath -> ServerPartE Response, + documentationResource :: DocumentationResource, -- | Notification of documentation changes diff --git a/Distribution/Server/Features/Html.hs b/Distribution/Server/Features/Html.hs index 48a21377d..fb0b824ba 100644 --- a/Distribution/Server/Features/Html.hs +++ b/Distribution/Server/Features/Html.hs @@ -43,7 +43,6 @@ import Distribution.Server.Packages.Render import qualified Distribution.Server.Users.Users as Users import qualified Distribution.Server.Packages.PackageIndex as PackageIndex import Distribution.Server.Users.Group (UserGroup(..)) --- [reverse index disabled] import Distribution.Server.Packages.Reverse import qualified Distribution.Server.Pages.Package as Pages import qualified Distribution.Server.Pages.PackageFromTemplate as PagesNew @@ -60,7 +59,6 @@ import Distribution.Simple.Utils ( cabalVersion ) import Distribution.Package import Distribution.Version import Distribution.Text (display) -import Distribution.PackageDescription import Data.Char (toLower) import Data.List (intercalate, intersperse, insert) @@ -131,6 +129,8 @@ initHtmlFeature env@ServerEnv{serverTemplatesDir, serverTemplatesMode, , "package-page.html" , "table-interface.html" , "tag-edit.html" + , "candidate-page.html" + , "candidate-index.html" ] @@ -160,7 +160,7 @@ initHtmlFeature env@ServerEnv{serverTemplatesDir, serverTemplatesMode, tarIndexCache reportsCore usersdetails - (htmlUtilities core tags user) + (htmlUtilities core candidates tags user) mainCache namesCache browseCache templates @@ -287,6 +287,7 @@ htmlFeature env@ServerEnv{..} cacheBrowseTable templates names + candidates htmlUsers = mkHtmlUsers user usersdetails htmlUploads = mkHtmlUploads utilities upload htmlDocUploads = mkHtmlDocUploads utilities core docsCore templates @@ -489,6 +490,7 @@ mkHtmlCore :: ServerEnv -> AsyncCache BS.ByteString -> Templates -> SearchFeature + -> PackageCandidatesFeature -> HtmlCore mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore} utilities@HtmlUtilities{..} @@ -515,8 +517,10 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore} cacheBrowseTable templates SearchFeature{..} + PackageCandidatesFeature{..} = HtmlCore{..} where + candidatesCore = candidatesCoreResource cores@CoreResource{packageInPath, lookupPackageName, lookupPackageId} = coreResource versions = versionsResource docs = documentationResource @@ -597,6 +601,8 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore} tags <- queryTagsForPackage pkgname deprs <- queryGetDeprecatedFor pkgname mreadme <- makeReadme render + candidates <- lookupCandidateName pkgname + buildStatus <- renderBuildStatus documentationFeature reportsFeature realpkg @@ -639,6 +645,9 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore} , "userRating" $= userRating , "score" $= pkgScore , "buildStatus" $= buildStatus + , "candidates" $= case candidates of + [] -> [ toHtml "No Candidates"] + _ -> [ PagesNew.commaList $ flip map candidates $ \cand -> anchor ! [href $ corePackageIdUri candidatesCore "" $ packageId cand] << display (packageVersion cand) ] ] ++ -- Items not related to IO (mostly pure functions) PagesNew.packagePageTemplate render @@ -646,6 +655,7 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore} docURL distributions deprs utilities + False serveDependenciesPage :: DynamicPath -> ServerPartE Response serveDependenciesPage dpath = do @@ -749,6 +759,7 @@ mkHtmlUsers UserFeature{..} UserDetailsFeature{..} = HtmlUsers{..} where users = userResource + htmlUsersResources = [ -- list of users with user links; if admin, a link to add user page (extendResource $ userList users) { @@ -851,7 +862,7 @@ mkHtmlUsers UserFeature{..} UserDetailsFeature{..} = HtmlUsers{..} [toHtml "Changed password for ", anchor ! [href $ userPageUri users "" uname] << display uname] {------------------------------------------------------------------------------- - Uploads + Uploads(For new package lifecycle, this might need to be removed) -------------------------------------------------------------------------------} data HtmlUploads = HtmlUploads { @@ -933,7 +944,7 @@ mkHtmlDocUploads HtmlUtilities{..} CoreFeature{coreResource} DocumentationFeatur serveDeleteDocumentation :: DynamicPath -> ServerPartE Response serveDeleteDocumentation dpath = do pkgid <- packageInPath dpath - deleteDocumentation dpath >> ignoreFilters -- Override 204 No Content + deleteDocumentation dpath >> ignoreFilters -- Override 204 No Content return $ toResponse $ Resource.XHtml $ hackagePage "Documentation deleted" $ [ paragraph << [toHtml "Successfully deleted documentation for ", packageLink pkgid, toHtml "!"] ] @@ -943,7 +954,8 @@ mkHtmlDocUploads HtmlUtilities{..} CoreFeature{coreResource} DocumentationFeatur pkgid <- packageInPath dpath template <- getTemplate templates "maintain-docs.html" return $ toResponse $ template - [ "pkgid" $= (pkgid :: PackageIdentifier) + [ "pkgid" $= (pkgid :: PackageIdentifier) + , "actionUrl" $= "" ] {------------------------------------------------------------------------------- @@ -1009,13 +1021,13 @@ mkHtmlCandidates :: HtmlUtilities -> PackageCandidatesFeature -> Templates -> HtmlCandidates -mkHtmlCandidates HtmlUtilities{..} +mkHtmlCandidates utilities@HtmlUtilities{..} CoreFeature{ coreResource = CoreResource{packageInPath} , queryGetPackageIndex } VersionsFeature{ queryGetPreferredInfo } UploadFeature{ guardAuthorisedAsMaintainer } - DocumentationFeature{documentationResource, queryDocumentation} + DocumentationFeature{documentationResource, queryDocumentation,..} TarIndexCacheFeature{cachedTarIndex} PackageCandidatesFeature{..} templates = HtmlCandidates{..} @@ -1030,6 +1042,9 @@ mkHtmlCandidates HtmlUtilities{..} candMaintainForm = (resourceAt "/package/:package/candidate/maintain") { resourceGet = [("html", serveCandidateMaintain)] } + candDocUploadForm = (resourceAt "/package/:package/candidate/maintain/docs"){ + resourceGet = [("html", serveCandDocUploadForm)] + } htmlCandidatesResources = [ -- candidates @@ -1072,6 +1087,8 @@ mkHtmlCandidates HtmlUtilities{..} , pkgCandUploadForm -- maintenance for candidate packages , candMaintainForm + -- form for uploading documentation for a candidate + , candDocUploadForm -- form for publishing package , (extendResource $ publishPage candidates) { resourceDesc = [ (GET, "Show candidate publish form") @@ -1087,6 +1104,17 @@ mkHtmlCandidates HtmlUtilities{..} , resourceGet = [ ("html", serveDeleteForm) ] , resourcePost = [ ("html", doDeleteCandidate) ] } + -- form for deleting candidates + , (extendResource $ deleteCandidatesPage candidates) { + resourceDesc = [ (GET, "Show package candidates delete form") + , (POST, "Delete package candidates") ] + , resourceGet = [ ("html", serveCandidatesDeleteForm) ] + , resourcePost = [ ("html", doDeleteCandidates) ] + } + , (extendResource $ packageDocsWhole docs) { + resourcePut = [ ("html", serveCandUploadDocumentation) ] + , resourceDelete = [ ("html", serveCandDeleteDocumentation) ] + } ] serveCandidateUploadForm :: DynamicPath -> ServerPartE Response @@ -1111,19 +1139,30 @@ mkHtmlCandidates HtmlUtilities{..} serveCandidateMaintain :: DynamicPath -> ServerPartE Response serveCandidateMaintain dpath = do + pkgid <- packageInPath dpath candidate <- packageInPath dpath >>= lookupCandidateId guardAuthorisedAsMaintainer (packageName candidate) template <- getTemplate templates "maintain-candidate.html" return $ toResponse $ template [ "pkgname" $= packageName candidate , "pkgversion" $= packageVersion candidate + , "pkgid" $= (pkgid :: PackageIdentifier) ] {-some useful URIs here: candidateUri check "" pkgid, packageCandidatesUri check "" pkgid, publishUri check "" pkgid-} - -- TODO: convert to template-based generation like 'servePackagePage' does + serveCandDocUploadForm :: DynamicPath -> ServerPartE Response + serveCandDocUploadForm dpath = do + pkgid <- packageInPath dpath + template <- getTemplate templates "maintain-docs.html" + return $ toResponse $ template + [ "pkgid" $= (pkgid :: PackageIdentifier) + , "actionUrl" $= "candidate/" + ] + serveCandidatePage :: Resource -> DynamicPath -> ServerPartE Response serveCandidatePage maintain dpath = do cand <- packageInPath dpath >>= lookupCandidateId + template <- getTemplate templates "candidate-page.html" candRender <- liftIO $ candidateRender cand let PackageIdentifier pkgname version = packageId cand render = candPackageRender candRender @@ -1131,11 +1170,7 @@ mkHtmlCandidates HtmlUtilities{..} . flip PackageIndex.lookupPackageName pkgname <$> queryGetPackageIndex prefInfo <- queryGetPreferredInfo pkgname - let sectionHtml = [ Pages.renderVersion (packageId cand) (classifyVersions prefInfo $ insert version otherVersions) Nothing - , Pages.renderChangelog render - , Pages.renderDependencies render - ] ++ Pages.renderFields render - maintainHtml = anchor ! [href $ renderResource maintain [display $ packageId cand]] << "maintain" + let maintainHtml = anchor ! [href $ renderResource maintain [display $ packageId cand]] << "maintain" -- bottom sections, currently documentation and readme mdoctarblob <- queryDocumentation (packageId cand) mdocIndex <- maybe (return Nothing) @@ -1150,9 +1185,16 @@ mkHtmlCandidates HtmlUtilities{..} [] -> [] warn -> [thediv ! [theclass "candidate-warn"] << [paragraph << strong (toHtml "Warnings:"), unordList warn]] - return $ toResponse $ Resource.XHtml $ - Pages.packagePage render [maintainHtml] warningBox sectionHtml - [] mdocIndex mreadme docURL True + return $ toResponse . template $ + [ "versions" $= (PagesNew.renderVersion (packageId cand) (classifyVersions prefInfo $ insert version otherVersions) Nothing) + , "maintainHtml" $= [maintainHtml] + , "warningBox" $= warningBox + ] ++ + PagesNew.packagePageTemplate render + mdocIndex Nothing mreadme + docURL [] Nothing + utilities + True serveDependenciesPage :: DynamicPath -> ServerPartE Response serveDependenciesPage dpath = do @@ -1172,40 +1214,21 @@ mkHtmlCandidates HtmlUtilities{..} Just err -> throwError err Nothing -> do return $ toResponse $ Resource.XHtml $ hackagePage "Publishing candidates" - [form ! [theclass "box", XHtml.method "post", action $ publishUri candidatesResource "" pkgid] + [form ! [theclass "box", XHtml.method "post", action $ publishUri candidates "" pkgid] << input ! [thetype "submit", value "Publish package"]] serveCandidatesPage :: DynamicPath -> ServerPartE Response serveCandidatesPage _ = do - cands <- queryGetCandidateIndex - return $ toResponse $ Resource.XHtml $ hackagePage "Package candidates" - [ h2 << "Package candidates" - , paragraph << - [ toHtml "Here follow all the candidate package versions on Hackage. " - , thespan ! [thestyle "color: gray"] << - [ toHtml "[" - , anchor ! [href "/packages/candidates/upload"] << "upload" - , toHtml "]" ] - ] - , unordList $ map showCands $ PackageIndex.allPackagesByName cands - ] - -- note: each of the lists here should be non-empty, according to PackageIndex - where showCands pkgs = - -- TODO: Duncan changed this to packageSynopsis but without an - -- accomponaying definition of packageSynposis. Changed back for now. - let desc = packageDescription . pkgDesc . candPkgInfo $ last pkgs - pkgname = packageName desc - in [ anchor ! [href $ packageCandidatesUri candidates "" pkgname ] << display pkgname - , toHtml ": " - , toHtml $ intersperse (toHtml ", ") $ flip map pkgs $ \pkg -> - anchor ! [href $ corePackageIdUri candidatesCore "" (packageId pkg)] << display (packageVersion pkg) - , toHtml $ ". " ++ synopsis desc - ] + template <- getTemplate templates "candidate-index.html" + cands <- queryGetCandidateIndex + return $ toResponse . template $ + PagesNew.candidatesPageTemplate cands candidates candidatesCore servePackageCandidates :: Resource -> DynamicPath -> ServerPartE Response servePackageCandidates candPkgUp dpath = do pkgname <- packageInPath dpath pkgs <- lookupCandidateName pkgname + let delUri = "/package/"++(display pkgname)++"/candidates/delete" return $ toResponse $ Resource.XHtml $ hackagePage "Package candidates" $ [ h3 << ("Candidates for " ++ display pkgname) ] ++ case pkgs of @@ -1215,13 +1238,12 @@ mkHtmlCandidates HtmlUtilities{..} , anchor ! [href $ "/packages/candidates/upload"] << "another" , toHtml " package?" ] - _ -> [ unordList $ flip map pkgs $ \pkg -> anchor ! [href $ corePackageIdUri candidatesCore "" $ packageId pkg] << display (packageVersion pkg) ] + _ -> [ unordList $ flip map pkgs $ \pkg -> anchor ! [href $ corePackageIdUri candidatesCore "" $ packageId pkg] << display (packageVersion pkg) + , anchor ! [href $ delUri]<< "Delete All Candidates"] - -- TODO: make publishCandidate a member of the PackageCandidates feature, just like - -- putDeprecated and putPreferred are for the Versions feature. servePostPublish :: DynamicPath -> ServerPartE Response servePostPublish dpath = do - uresult <- publishCandidate dpath False + uresult <- publishCandidate dpath True return $ toResponse $ Resource.XHtml $ hackagePage "Publish successful" $ [ paragraph << [toHtml "Successfully published ", packageLink (packageId $ uploadDesc uresult), toHtml "!"] ] ++ case uploadWarnings uresult of @@ -1234,9 +1256,34 @@ mkHtmlCandidates HtmlUtilities{..} guardAuthorisedAsMaintainer (packageName candidate) let pkgid = packageId candidate return $ toResponse $ Resource.XHtml $ hackagePage "Deleting candidates" - [form ! [theclass "box", XHtml.method "post", action $ deleteUri candidatesResource "" pkgid] + [form ! [theclass "box", XHtml.method "post", action $ deleteUri candidates "" pkgid] << input ! [thetype "submit", value "Delete package candidate"]] + serveCandidatesDeleteForm :: DynamicPath -> ServerPartE Response + serveCandidatesDeleteForm dpath = do + pkgname <- packageInPath dpath + guardAuthorisedAsMaintainer pkgname + -- let pkgname = packageName pkgid + return $ toResponse $ Resource.XHtml $ hackagePage "Deleting package candidates" + [form ! [theclass "box", XHtml.method "post", action $ deleteCandidatesUri candidates "" pkgname] + << input ! [thetype "submit", value "Delete All Candidates For This Package"]] + + serveCandUploadDocumentation :: DynamicPath -> ServerPartE Response + serveCandUploadDocumentation dpath = do + pkgid <- packageInPath dpath + uploadDocumentation dpath >> ignoreFilters -- Override 204 No Content + return $ toResponse $ Resource.XHtml $ hackagePage "Documentation uploaded" $ + [ paragraph << [toHtml "Successfully uploaded documentation for ", candidateLink pkgid, toHtml "!"] + ] + + serveCandDeleteDocumentation :: DynamicPath -> ServerPartE Response + serveCandDeleteDocumentation dpath = do + pkgid <- packageInPath dpath + deleteDocumentation dpath >> ignoreFilters -- Override 204 No Content + return $ toResponse $ Resource.XHtml $ hackagePage "Documentation deleted" $ + [ paragraph << [toHtml "Successfully deleted documentation for ", candidateLink pkgid, toHtml "!"] + ] + dependenciesPage :: Bool -> PackageRender -> URL -> Resource.XHtml dependenciesPage isCandidate render docURL = Resource.XHtml $ hackagePage (pkg ++ ": dependencies") $ diff --git a/Distribution/Server/Features/Html/HtmlUtilities.hs b/Distribution/Server/Features/Html/HtmlUtilities.hs index bcf7e8bad..dce565b16 100644 --- a/Distribution/Server/Features/Html/HtmlUtilities.hs +++ b/Distribution/Server/Features/Html/HtmlUtilities.hs @@ -8,6 +8,7 @@ import Text.XHtml.Strict import qualified Data.Set as Set import Distribution.Server.Features.Tags import Distribution.Server.Features.Core +import Distribution.Server.Features.PackageCandidates import Distribution.Text (display) import Data.List (intersperse, intercalate) import Data.Set (Set) @@ -20,6 +21,7 @@ import Distribution.Server.Features.Users data HtmlUtilities = HtmlUtilities { packageLink :: PackageId -> Html + , candidateLink :: PackageId -> Html , packageNameLink :: PackageName -> Html , renderItem :: PackageItem -> Html , makeRow :: PackageItem -> Html @@ -27,13 +29,17 @@ data HtmlUtilities = HtmlUtilities { , renderReviewTags :: Set Tag -> (Set Tag, Set Tag) -> PackageName -> [Html] } -htmlUtilities :: CoreFeature -> TagsFeature -> UserFeature -> HtmlUtilities +htmlUtilities :: CoreFeature -> PackageCandidatesFeature -> TagsFeature -> UserFeature -> HtmlUtilities htmlUtilities CoreFeature{coreResource} + PackageCandidatesFeature{candidatesCoreResource} TagsFeature{tagsResource} UserFeature{userResource} = HtmlUtilities{..} where packageLink :: PackageId -> Html packageLink pkgid = anchor ! [href $ corePackageIdUri cores "" pkgid] << display pkgid + candidateLink :: PackageId -> Html + candidateLink pkgid = anchor ! [href $ corePackageIdUri candidatesCoreResource "" pkgid] << display pkgid + packageNameLink :: PackageName -> Html packageNameLink pkgname = anchor ! [href $ corePackageNameUri cores "" pkgname] << display pkgname diff --git a/Distribution/Server/Features/PackageCandidates.hs b/Distribution/Server/Features/PackageCandidates.hs index 1c1e2a1cf..568079bb7 100644 --- a/Distribution/Server/Features/PackageCandidates.hs +++ b/Distribution/Server/Features/PackageCandidates.hs @@ -70,6 +70,7 @@ data PackageCandidatesFeature = PackageCandidatesFeature { postPackageCandidate :: DynamicPath -> ServerPartE Response, putPackageCandidate :: DynamicPath -> ServerPartE Response, doDeleteCandidate :: DynamicPath -> ServerPartE Response, + doDeleteCandidates :: DynamicPath -> ServerPartE Response, uploadCandidate :: (PackageId -> Bool) -> ServerPartE CandPkgInfo, publishCandidate :: DynamicPath -> Bool -> ServerPartE UploadResult, checkPublish :: forall m. MonadIO m => Users.UserId -> PackageIndex PkgInfo -> CandPkgInfo -> m (Maybe ErrorResponse), @@ -110,9 +111,11 @@ data PackageCandidatesResource = PackageCandidatesResource { packageCandidatesPage :: Resource, publishPage :: Resource, deletePage :: Resource, + deleteCandidatesPage :: Resource, packageCandidatesUri :: String -> PackageName -> String, publishUri :: String -> PackageId -> String, deleteUri :: String -> PackageId -> String, + deleteCandidatesUri :: String -> PackageName -> String, -- TODO: Why don't the following entries have a corresponding entry -- in CoreResource? @@ -248,6 +251,7 @@ candidatesFeature ServerEnv{serverBlobStore = store} } , publishPage = resourceAt "/package/:package/candidate/publish.:format" , deletePage = resourceAt "/package/:package/candidate/delete.:format" + , deleteCandidatesPage = resourceAt "/package/:package/candidates/delete.:format" , candidateContents = (resourceAt "/package/:package/candidate/src/..") { resourceGet = [("", serveContents)] } @@ -261,6 +265,8 @@ candidatesFeature ServerEnv{serverBlobStore = store} renderResource (publishPage r) [display pkgid, format] , deleteUri = \format pkgid -> renderResource (deletePage r) [display pkgid, format] + , deleteCandidatesUri = \format pkgname -> + renderResource (deleteCandidatesPage r) [display pkgname, format] , candidateChangeLogUri = \pkgid -> renderResource (candidateChangeLog candidatesResource) [display pkgid, display (packageName pkgid)] } @@ -341,6 +347,13 @@ candidatesFeature ServerEnv{serverBlobStore = store} void $ updateState candidatesState $ DeleteCandidate (packageId candidate) seeOther (packageCandidatesUri candidatesResource "" $ packageName candidate) $ toResponse () + doDeleteCandidates :: DynamicPath -> ServerPartE Response + doDeleteCandidates dpath = do + pkgname <- packageInPath dpath + guardAuthorisedAsMaintainer pkgname + void $ updateState candidatesState $ DeleteCandidates pkgname + seeOther (packageCandidatesUri candidatesResource "" $ pkgname) $ toResponse () + serveCandidateTarball :: DynamicPath -> ServerPartE Response serveCandidateTarball dpath = do pkgid <- packageTarballInPath dpath diff --git a/Distribution/Server/Features/Upload.hs b/Distribution/Server/Features/Upload.hs index ae323d62b..1e7b786cd 100644 --- a/Distribution/Server/Features/Upload.hs +++ b/Distribution/Server/Features/Upload.hs @@ -46,6 +46,7 @@ data UploadFeature = UploadFeature { uploadResource :: UploadResource, -- | The main upload routine. This uses extractPackage on a multipart -- request to get contextual information. + -- For new pacakges lifecycle, this should be removed uploadPackage :: ServerPartE UploadResult, --TODO: consider moving the trustee and/or per-package maintainer groups diff --git a/Distribution/Server/Pages/Group.hs b/Distribution/Server/Pages/Group.hs index 1b243098b..4007e0207 100644 --- a/Distribution/Server/Pages/Group.hs +++ b/Distribution/Server/Pages/Group.hs @@ -2,6 +2,7 @@ module Distribution.Server.Pages.Group ( groupPage, renderGroupName + -- renderGroupNameWithCands ) where import Text.XHtml.Strict @@ -17,8 +18,11 @@ renderGroupName :: GroupDescription -> Maybe String -> Html renderGroupName desc murl = maybeUrl (groupTitle desc) murl +++ - maybe noHtml (\(for, mfor) -> " for " +++ maybeUrl for mfor) (groupEntity desc) + maybe noHtml (\(for, mfor) -> " for " +++ maybeUrl for mfor ) (groupEntity desc) + +++ + maybe noHtml (\(_, mfor) -> " : " +++ candUrl "No Candidates" mfor ) (groupEntity desc) where maybeUrl text = maybe (toHtml text) (\url -> anchor ! [href url] << text) + candUrl text = maybe (toHtml text) (\url -> anchor ! [href $ url ++ "/candidates"] << "candidates") -- Primitive access control: the URI to post a new user request to, or the the URI/user/ to DELETE -- if neither adding or removing is enabled, a link to a URI/edit page is provided diff --git a/Distribution/Server/Pages/PackageFromTemplate.hs b/Distribution/Server/Pages/PackageFromTemplate.hs index d7e6ce194..7d3dd6610 100644 --- a/Distribution/Server/Pages/PackageFromTemplate.hs +++ b/Distribution/Server/Pages/PackageFromTemplate.hs @@ -1,15 +1,22 @@ {-# LANGUAGE PatternGuards, RecordWildCards #-} module Distribution.Server.Pages.PackageFromTemplate ( packagePageTemplate + , candidatesPageTemplate , renderVersion , latestVersion + , commaList ) where import Distribution.Server.Framework.Templating import Distribution.Server.Features.PreferredVersions +import Distribution.Server.Features.Core import Distribution.Server.Util.DocMeta import Distribution.Server.Packages.Render +import qualified Distribution.Server.Packages.PackageIndex as PackageIndex +import Distribution.Server.Packages.PackageIndex (PackageIndex) +import Distribution.Server.Packages.Types +import Distribution.Server.Features.PackageCandidates import Distribution.Server.Users.Types (userStatus, userName, isActiveAccount) import Data.TarIndex (TarIndex) import Distribution.Server.Features.Distro.Types @@ -75,54 +82,81 @@ packagePageTemplate :: PackageRender -> URL -> [(DistroName, DistroPackageInfo)] -> Maybe [PackageName] -> HtmlUtilities + -> Bool -> [TemplateAttr] packagePageTemplate render mdocIndex mdocMeta mreadme docURL distributions - deprs utilities = - -- The main two namespaces - [ "package" $= packageFieldsTemplate - , "hackage" $= hackageFieldsTemplate - , "doc" $= docFieldsTemplate - ] ++ - - -- Miscellaneous things that could still stand to be refactored a bit. - [ "moduleList" $= Old.moduleSection render mdocIndex docURL hasQuickNav - , "executables" $= (commaList . map toHtml $ rendExecNames render) - , "downloadSection" $= Old.downloadSection render - , "stability" $= renderStability desc - , "isDeprecated" $= (if deprs == Nothing then False else True) - , "deprecatedMsg" $= (deprHtml deprs) - ] + deprs utilities isCandidate = + if isCandidate + then + -- The main two namespaces + [ "package" $= packageFieldsTemplate + , "hackage" $= hackageFieldsTemplate + , "doc" $= docFieldsTemplate + ] ++ + -- Miscellaneous things that could still stand to be refactored a bit. + [ "moduleList" $= Old.moduleSection render mdocIndex docURL False + , "downloadSection" $= Old.downloadSection render + ] + else + -- The main two namespaces + [ "package" $= packageFieldsTemplate + , "hackage" $= hackageFieldsTemplate + , "doc" $= docFieldsTemplate + ] ++ + -- Miscellaneous things that could still stand to be refactored a bit. + [ "moduleList" $= Old.moduleSection render mdocIndex docURL hasQuickNav + , "executables" $= (commaList . map toHtml $ rendExecNames render) + , "downloadSection" $= Old.downloadSection render + , "stability" $= renderStability desc + , "isDeprecated" $= (if deprs == Nothing then False else True) + , "deprecatedMsg" $= (deprHtml deprs) + ] where -- Access via "$hackage.varName$" - hackageFieldsTemplate = templateDict $ - [ templateVal "uploadTime" - (uncurry renderUploadInfo $ rendUploadInfo render) - ] ++ - - [ templateVal "hasUpdateTime" - (case rendUpdateInfo render of Nothing -> False; _ -> True) - , templateVal "updateTime" [ renderUpdateInfo revisionNo utime uinfo - | (revisionNo, utime, uinfo) <- maybeToList (rendUpdateInfo render) ] - ] ++ - - [ templateVal "hasDistributions" - True - {-(if distributions == [] then False else True)-} - , templateVal "distributions" - (concatHtml . intersperse (toHtml ", ") $ map showDist distributions) - ] ++ - - [ templateVal "hasFlags" - (if rendFlags render == [] then False else True) - , templateVal "flagsSection" - (Old.renderPackageFlags render docURL) - ] - where - showDist (dname, info) = toHtml (display dname ++ ":") +++ + hackageFieldsTemplate = + if isCandidate + then templateDict $ + [ templateVal "uploadTime" + (uncurry renderUploadInfo $ rendUploadInfo render) + ] ++ + [ templateVal "hasUpdateTime" + (case rendUpdateInfo render of Nothing -> False; _ -> True) + , templateVal "updateTime" [ renderUpdateInfo revisionNo utime uinfo + | (revisionNo, utime, uinfo) <- maybeToList (rendUpdateInfo render) ] + ] ++ + [ templateVal "hasFlags" + (if rendFlags render == [] then False else True) + , templateVal "flagsSection" + (Old.renderPackageFlags render docURL) + ] + else templateDict $ + [ templateVal "uploadTime" + (uncurry renderUploadInfo $ rendUploadInfo render) + ] ++ + + [ templateVal "hasUpdateTime" + (case rendUpdateInfo render of Nothing -> False; _ -> True) + , templateVal "updateTime" [ renderUpdateInfo revisionNo utime uinfo + | (revisionNo, utime, uinfo) <- maybeToList (rendUpdateInfo render) ] + ] ++ + [ templateVal "hasDistributions" + True + {-(if distributions == [] then False else True)-} + , templateVal "distributions" + (concatHtml . intersperse (toHtml ", ") $ map showDist distributions) + ] ++ + [ templateVal "hasFlags" + (if rendFlags render == [] then False else True) + , templateVal "flagsSection" + (Old.renderPackageFlags render docURL) + ] + where + showDist (dname, info) = toHtml (display dname ++ ":") +++ anchor ! [href $ distroUrl info] << toHtml (display $ distroVersion info) + -- Fields from the .cabal file. -- Access via "$package.varName$" packageFieldsTemplate = templateDict $ @@ -133,12 +167,15 @@ packagePageTemplate render , templateVal "maintainer" (Old.maintainField $ rendMaintainer render) , templateVal "buildDepends" (snd (Old.renderDependencies render)) , templateVal "optional" optionalPackageInfoTemplate + , templateVal "candidateBanner" candidateBanner ] - docFieldsTemplate = templateDict $ - [ templateVal "hasQuickNavV1" hasQuickNavV1 - , templateVal "baseUrl" docURL - ] + docFieldsTemplate = + if isCandidate + then templateDict $ [ templateVal "baseUrl" docURL ] + else templateDict $ [ templateVal "hasQuickNavV1" hasQuickNavV1 + , templateVal "baseUrl" docURL + ] -- Fields that may be empty, along with booleans to see if they're present. -- Access via "$package.optional.varname$" @@ -205,6 +242,17 @@ packagePageTemplate render desc = rendOther render + candidateBanner + | isCandidate = [ thediv ! [theclass "candidate-info"] + << [ paragraph << [ strong (toHtml "This is a package candidate release!") + , toHtml " Here you can preview how this package release will appear once published to the main package index (which can be accomplished via the 'maintain' link below)." + , toHtml " Please note that once a package has been published to the main package index it cannot be undone!" + , toHtml " Please consult the " + , anchor ! [href "/upload"] << "package uploading documentation" + , toHtml " for more information." + ] ] ] + | otherwise = [] + renderCopyright :: Html renderCopyright = toHtml $ case text of "" -> "None provided" @@ -264,6 +312,33 @@ packagePageTemplate render hasQuickNav :: Bool hasQuickNav = hasQuickNavV1 +candidatesPageTemplate :: (PackageIndex CandPkgInfo) -> PackageCandidatesResource -> CoreResource -> [TemplateAttr] +candidatesPageTemplate cands candidates candidatesCore= + ["heading" $= "Package candidates" + ,"content" $= (paragraph << + [ toHtml "Here follow all the candidate package versions on Hackage. " + , thespan ! [thestyle "color: gray"] << + [ toHtml "[" + , anchor ! [href "/packages/candidates/upload"] << "upload" + , toHtml "]" ] + ]) + ,"list" $= (unordList $ map showCands $ PackageIndex.allPackagesByName cands) + ] + where showCands pkgs = + -- TODO: Duncan changed this to packageSynopsis but without an + -- accomponaying definition of packageSynposis. Changed back for now. + let desc = packageDescription . pkgDesc . candPkgInfo $ last pkgs + pkgname = packageName desc + -- candidates = candidatesResource + -- candidatesCore = candidatesCoreResource + in [ anchor ! [href $ packageCandidatesUri candidates "" pkgname ] << display pkgname + , toHtml ": " + , toHtml $ intersperse (toHtml ", ") $ flip map pkgs $ \pkg -> + anchor ! [href $ corePackageIdUri candidatesCore "" (packageId pkg)] << display (packageVersion pkg) + , toHtml $ ". " ++ synopsis desc + ] + + -- #ToDo: Pick out several interesting versions to display, with a link to -- display all versions. renderVersion :: PackageId -> [(Version, VersionStatus)] -> Maybe String -> Html diff --git a/config b/config new file mode 100644 index 000000000..5575604e3 --- /dev/null +++ b/config @@ -0,0 +1,237 @@ +-- This is the configuration file for the 'cabal' command line tool. +-- +-- The available configuration options are listed below. +-- Some of them have default values listed. +-- +-- Lines (like this one) beginning with '--' are comments. +-- Be careful with spaces and indentation because they are +-- used to indicate layout for nested sections. +-- +-- This config file was generated using the following versions +-- of Cabal and cabal-install: +-- Cabal library version: 3.2.0.0 +-- cabal-install version: 3.2.0.0 + + +repository hackage.haskell.org + url: http://hackage.haskell.org/ + -- secure: True + -- root-keys: + -- key-threshold: 3 + +-- default-user-config: +-- require-sandbox: False +-- ignore-sandbox: False +-- ignore-expiry: False +-- http-transport: +-- nix: False +-- local-no-index-repo: +remote-repo-cache: /Users/sitaochen/.cabal/packages +-- local-repo: +-- logs-dir: /Users/sitaochen/.cabal/logs +world-file: /Users/sitaochen/.cabal/world +-- store-dir: +-- verbose: 1 +-- compiler: ghc +-- cabal-file: +-- with-compiler: +-- with-hc-pkg: +-- program-prefix: +-- program-suffix: +-- library-vanilla: True +-- library-profiling: +-- shared: +-- static: +-- executable-dynamic: False +-- executable-static: False +-- profiling: +-- executable-profiling: +-- profiling-detail: +-- library-profiling-detail: +-- optimization: True +-- debug-info: False +-- library-for-ghci: +-- split-sections: False +-- split-objs: False +-- executable-stripping: +-- library-stripping: +-- configure-option: +-- user-install: True +-- package-db: +-- flags: +-- extra-include-dirs: +-- deterministic: +-- cid: +-- extra-lib-dirs: +-- extra-framework-dirs: +extra-prog-path: /Users/sitaochen/.cabal/bin +-- instantiate-with: +-- tests: False +-- coverage: False +-- library-coverage: +-- exact-configuration: False +-- benchmarks: False +-- relocatable: False +-- response-files: +-- allow-depending-on-private-libs: +-- cabal-lib-version: +-- constraint: +-- preference: +-- solver: modular +-- allow-older: False +-- allow-newer: False +-- write-ghc-environment-files: +-- documentation: False +-- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html +-- target-package-db: +-- max-backjumps: 4000 +-- reorder-goals: False +-- count-conflicts: True +-- fine-grained-conflicts: True +-- minimize-conflict-set: False +-- independent-goals: False +-- shadow-installed-packages: False +-- strong-flags: False +-- allow-boot-library-installs: False +-- reject-unconstrained-dependencies: none +-- reinstall: False +-- avoid-reinstalls: False +-- force-reinstalls: False +-- upgrade-dependencies: False +-- index-state: +-- root-cmd: +-- symlink-bindir: +build-summary: /Users/sitaochen/.cabal/logs/build.log +-- build-log: +remote-build-reporting: anonymous +-- report-planning-failure: False +-- per-component: True +-- one-shot: False +-- run-tests: +jobs: $ncpus +-- keep-going: False +-- offline: False +-- project-file: +-- lib: False +-- ignore-project: False +-- package-env: +-- overwrite-policy: +-- install-method: +installdir: /Users/sitaochen/.cabal/bin +-- username: +-- password: +-- password-command: +-- builddir: + +haddock + -- keep-temp-files: False + -- hoogle: False + -- html: False + -- html-location: + -- executables: False + -- tests: False + -- benchmarks: False + -- foreign-libraries: False + -- all: + -- internal: False + -- css: + -- hyperlink-source: False + -- quickjump: False + -- hscolour-css: + -- contents-location: + +init + -- interactive: False + -- cabal-version: 1.10 + -- license: BSD3 + -- tests: + -- test-dir: + -- language: Haskell2010 + -- application-dir: + -- source-dir: + +install-dirs user + -- prefix: /Users/sitaochen/.cabal + -- bindir: $prefix/bin + -- libdir: $prefix/lib + -- libsubdir: $abi/$libname + -- dynlibdir: $libdir/$abi + -- libexecdir: $prefix/libexec + -- libexecsubdir: $abi/$pkgid + -- datadir: $prefix/share + -- datasubdir: $abi/$pkgid + -- docdir: $datadir/doc/$abi/$pkgid + -- htmldir: $docdir/html + -- haddockdir: $htmldir + -- sysconfdir: $prefix/etc + +install-dirs global + -- prefix: /usr/local + -- bindir: $prefix/bin + -- libdir: $prefix/lib + -- libsubdir: $abi/$libname + -- dynlibdir: $libdir/$abi + -- libexecdir: $prefix/libexec + -- libexecsubdir: $abi/$pkgid + -- datadir: $prefix/share + -- datasubdir: $abi/$pkgid + -- docdir: $datadir/doc/$abi/$pkgid + -- htmldir: $docdir/html + -- haddockdir: $htmldir + -- sysconfdir: $prefix/etc + +program-locations + -- alex-location: + -- ar-location: + -- c2hs-location: + -- cpphs-location: + -- doctest-location: + -- gcc-location: + -- ghc-location: + -- ghc-pkg-location: + -- ghcjs-location: + -- ghcjs-pkg-location: + -- greencard-location: + -- haddock-location: + -- happy-location: + -- haskell-suite-location: + -- haskell-suite-pkg-location: + -- hmake-location: + -- hpc-location: + -- hsc2hs-location: + -- hscolour-location: + -- jhc-location: + -- ld-location: + -- pkg-config-location: + -- runghc-location: + -- strip-location: + -- tar-location: + -- uhc-location: + +program-default-options + -- alex-options: + -- ar-options: + -- c2hs-options: + -- cpphs-options: + -- doctest-options: + -- gcc-options: + -- ghc-options: + -- ghc-pkg-options: + -- ghcjs-options: + -- ghcjs-pkg-options: + -- greencard-options: + -- haddock-options: + -- happy-options: + -- haskell-suite-options: + -- haskell-suite-pkg-options: + -- hmake-options: + -- hpc-options: + -- hsc2hs-options: + -- hscolour-options: + -- jhc-options: + -- ld-options: + -- pkg-config-options: + -- runghc-options: + -- strip-options: + -- tar-options: + -- uhc-options: diff --git a/datafiles/TUF/snapshot.private b/datafiles/TUF/snapshot.private index 5cc9c333a..21942794f 100644 --- a/datafiles/TUF/snapshot.private +++ b/datafiles/TUF/snapshot.private @@ -1 +1 @@ -{"keytype":"ed25519","keyval":{"private":"Zr9s1rtDVRWwSGRnNzmaW0v/5rPr9J2tlAQwz46Mp3RoO0AVXdeEmsWS0y6S43aLguIKnDWtJdEZFvr9mpxIYQ==","public":"aDtAFV3XhJrFktMukuN2i4LiCpw1rSXRGRb6/ZqcSGE="}} \ No newline at end of file +{"keytype":"ed25519","keyval":{"private":"Zr9s1rtDVRWwSGRnNzmaW0v/5rPr9J2tlAQwz46Mp3RoO0AVXdeEmsWS0y6S43aLguIKnDWtJdEZFvr9mpxIYQ==","public":"aDtAFV3XhJrFktMukuN2i4LiCpw1rSXRGRb6/ZqcSGE="}} diff --git a/datafiles/TUF/timestamp.private b/datafiles/TUF/timestamp.private index 37426c689..6a8d8360a 100644 --- a/datafiles/TUF/timestamp.private +++ b/datafiles/TUF/timestamp.private @@ -1 +1 @@ -{"keytype":"ed25519","keyval":{"private":"s8o+9ITQMdldqYnSfcFJYzjBqrDiBlGt3jTrha3T85tUE8wvIgAIS/Hko+QvcZ0SeAYx1CZa02TZQYUXFrC1sA==","public":"VBPMLyIACEvx5KPkL3GdEngGMdQmWtNk2UGFFxawtbA="}} \ No newline at end of file +{"keytype":"ed25519","keyval":{"private":"s8o+9ITQMdldqYnSfcFJYzjBqrDiBlGt3jTrha3T85tUE8wvIgAIS/Hko+QvcZ0SeAYx1CZa02TZQYUXFrC1sA==","public":"VBPMLyIACEvx5KPkL3GdEngGMdQmWtNk2UGFFxawtbA="}} diff --git a/datafiles/templates/Html/candidate-index.html.st b/datafiles/templates/Html/candidate-index.html.st new file mode 100644 index 000000000..2a7782ad2 --- /dev/null +++ b/datafiles/templates/Html/candidate-index.html.st @@ -0,0 +1,21 @@ + + + + + $hackageCssTheme()$ + + + + Package candidates | Hackage + + + + $hackagePageHeader()$ +
+

$heading$

+ $content$ + $list$ + $footer$ +
+ + \ No newline at end of file diff --git a/datafiles/templates/Html/candidate-page.html.st b/datafiles/templates/Html/candidate-page.html.st new file mode 100644 index 000000000..284cd7554 --- /dev/null +++ b/datafiles/templates/Html/candidate-page.html.st @@ -0,0 +1,150 @@ + + + + $hackageCssTheme()$ + + $package.name$$if(package.optional.hasSynopsis)$: $package.optional.synopsis$$endif$ + + + + + + + + + + + $hackagePageHeader()$ +
+

$package.name$$if(package.optional.hasSynopsis)$: $package.optional.synopsis$$endif$

+ + $package.candidateBanner$ +
+ [$maintainHtml$] + [Publish] +
+ + $warningBox$ + +
+ $if(package.optional.hasDescription)$ + $package.optional.description$ + $endif$ + $if(package.optional.hasReadme)$ +
+ [Skip to Readme] + $endif$ +
+ + +

Properties

+ + + + + + + + $if(package.optional.hasChangelog)$ + + + $else$ + + + $endif$ + + + + + + + + + + + + + $if(package.optional.hasCopyright)$ + + + + + $endif$ + + + + + + + + + + + $if(package.optional.hasCategories)$ + + + + + $endif$ + + $if(package.optional.hasHomePage)$ + + + + + $endif$ + + $if(package.optional.hasBugTracker)$ + + + + + $endif$ + + $if(package.optional.hasSourceRepository)$ + + + + + $endif$ + + + + + +
Versions$versions$
Change log$package.optional.changelog$Change logNone available
Dependencies$package.buildDepends$
License$package.license$
Copyright$package.optional.copyright$
Author$package.author$
Maintainer$package.maintainer$
Category$package.optional.category$
Home page + + $package.optional.homepage$ + +
Bug tracker + + $package.optional.bugTracker$ + +
Source repo$package.optional.sourceRepository$
Uploaded$hackage.uploadTime$
+ $moduleList$ + + $if(hackage.hasFlags)$ + $hackage.flagsSection$ + $endif$ + + $downloadSection$ + +

Maintainer's Corner

+

For package maintainers and hackage trustees

+ + + $if(package.optional.hasReadme)$ +
+

Readme for $package.name$-$package.version$

+ [back to package description] + $package.optional.readme$ + $endif$ + + + \ No newline at end of file diff --git a/datafiles/templates/Html/maintain-candidate.html.st b/datafiles/templates/Html/maintain-candidate.html.st index c07827fde..7cb8507d4 100644 --- a/datafiles/templates/Html/maintain-candidate.html.st +++ b/datafiles/templates/Html/maintain-candidate.html.st @@ -19,6 +19,9 @@ edit the maintainer group.
Discard this candidate (does not affect published packages).
+
Manage documentation for $pkgid$
+
Upload or delete Haddock documentation for this package.
+
Publish candidate
Publish this candidate to make it visible in the main package database.
diff --git a/datafiles/templates/Html/maintain-docs.html.st b/datafiles/templates/Html/maintain-docs.html.st index a06313852..e79255d40 100644 --- a/datafiles/templates/Html/maintain-docs.html.st +++ b/datafiles/templates/Html/maintain-docs.html.st @@ -14,7 +14,7 @@ $hackagePageHeader()$

Upload documentation

Hackage usually builds package documentation automatically. However, if you wish, you may also build and upload the HTML yourself.

For more information, see the Notes section of the Upload page.

-
+ @@ -22,7 +22,7 @@ $hackagePageHeader()$

Delete documentation

-
+
diff --git a/datafiles/templates/Html/package-page.html.st b/datafiles/templates/Html/package-page.html.st index a58afda85..5bf654b3d 100644 --- a/datafiles/templates/Html/package-page.html.st +++ b/datafiles/templates/Html/package-page.html.st @@ -212,6 +212,12 @@ +

Candidates

+
$if(package.optional.hasReadme)$