added: Package deprecation (purescript#391)

src/Handler/Help.hs

@@ -54,6 +54,9 @@ helpLayout forWhom inner =
         <dd .grouped-list__item>
           <a href="/help/authors#submit-automated">
             Submitting packages from a script
+        <dd .grouped-list__item>
+          <a href="/help/authors#package-deprecation">
+            How to mark package as deprecated
         <dd .grouped-list__item>
           <a href="/help/authors#package-badges">
             Package badges

src/Handler/Packages.hs

@@ -14,6 +14,7 @@ import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.BetterErrors as ABE
 import qualified Language.PureScript as P
 
+import SearchIndex (isDeprecated)
 import Handler.Database
 import Handler.Caching
 import Handler.Utils
@@ -79,13 +80,14 @@ getPackageAvailableVersionsR (PathPackageName pkgName) =
 getPackageVersionR :: PathPackageName -> PathVersion -> Handler Html
 getPackageVersionR (PathPackageName pkgName) (PathVersion version) =
   cacheHtmlConditional $
-    findPackage pkgName version $ \pkg@D.Package{..} -> do
+    findPackageWithLatest pkgName version $ \pkg@D.Package{..} latestPkg -> do
       moduleList <- renderModuleList pkg
       ereadme    <- tryGetReadme pkg
       let cacheStatus = either (const NotOkToCache) (const OkToCache) ereadme
       content <- defaultLayout $ do
         setTitle (toHtml (runPackageName pkgName))
         let dependencies = bowerDependencies pkgMeta
+        let deprecated = isDeprecated latestPkg
         $(widgetFile "packageVersion")
       return (cacheStatus, content)
 
@@ -156,14 +158,15 @@ getPackageVersionDocsR (PathPackageName pkgName) (PathVersion version) =
 
 getPackageVersionModuleDocsR :: PathPackageName -> PathVersion -> Text -> Handler Html
 getPackageVersionModuleDocsR (PathPackageName pkgName) (PathVersion version) mnString =
-  cacheHtml $ findPackage pkgName version $ \pkg@D.Package{..} -> do
+  cacheHtml $ findPackageWithLatest pkgName version $ \pkg@D.Package{..} latestPkg -> do
     moduleList <- renderModuleList pkg
     mhtmlDocs <- renderHtmlDocs pkg mnString
     case mhtmlDocs of
       Nothing -> notFound
       Just htmlDocs ->
         defaultLayout $ do
           let mn = P.moduleNameFromString mnString
+          let deprecated = isDeprecated latestPkg
           setTitle (toHtml (mnString <> " - " <> runPackageName pkgName))
           $(widgetFile "packageVersionModuleDocs")
 
@@ -207,6 +210,17 @@ findPackage pkgName version cont = do
     Left NoSuchPackage -> packageNotFound pkgName
     Left NoSuchPackageVersion -> packageVersionNotFound pkgName version
 
+findPackageWithLatest ::
+  PackageName ->
+  Version ->
+  (D.VerifiedPackage -> D.VerifiedPackage -> Handler r) ->
+  Handler r
+findPackageWithLatest pkgName version cont = do
+  findPackage pkgName version $ \pkg -> do
+    latestVersion <- fromMaybe version <$> getLatestVersionFor pkgName
+    latestPkg <- fromMaybe pkg . hush <$> lookupPackage pkgName latestVersion
+    cont pkg latestPkg
+
 packageNotFound :: PackageName -> Handler a
 packageNotFound pkgName = do
   defaultLayout404 $(widgetFile "packageNotFound")

src/Handler/Search.hs

@@ -203,7 +203,7 @@ searchResultToJSON result@SearchResult{..} = do
 routeResult :: SearchResult -> (Route App, Maybe Text)
 routeResult SearchResult{..} =
   case srInfo of
-    PackageResult ->
+    PackageResult _ ->
       ( case srSource of
           SourcePackage pkgName _ ->
             PackageR (PathPackageName pkgName)
@@ -276,10 +276,13 @@ searchResultHtml fr r =
     <div .result>
       <h3 .result__title>
         $case srInfo r
-          $of PackageResult
+          $of PackageResult deprecated
             <span .result__badge.badge.badge--package title="Package">P
             <a .result__link href=#{fr $ routeResult r}>
               #{pkgName}
+            $if deprecated
+              <span .badge--deprecated title="This package is marked as deprecated">
+                DEPRECATED
           $of ModuleResult moduleName
             <span .badge.badge--module title="Module">M
             <a .result__link href=#{fr $ routeResult r}>
@@ -290,7 +293,7 @@ searchResultHtml fr r =
 
     <div .result__body>
       $case srInfo r
-        $of PackageResult
+        $of PackageResult _
         $of ModuleResult _
         $of DeclarationResult _ _ name typ
           $maybe typeValue <- typ
@@ -300,7 +303,7 @@ searchResultHtml fr r =
 
     <div .result__actions>
       $case srInfo r
-        $of PackageResult
+        $of PackageResult _
         $of ModuleResult _
           <span .result__actions__item>
             <span .badge.badge--package title="Package">P

src/SearchIndex.hs

@@ -13,6 +13,7 @@ module SearchIndex
   , typeComplexity
   , parseType
   , isSymbol
+  , isDeprecated
   ) where
 
 import Import.NoFoundation
@@ -28,7 +29,7 @@ import qualified Text.Parsec.Combinator as Parsec
 import qualified Language.PureScript as P
 import qualified Language.PureScript.Docs as D
 import Web.Bower.PackageMeta
-  (PackageName, bowerName, bowerDescription, runPackageName)
+  (PackageName, bowerName, bowerDescription, bowerKeywords, runPackageName)
 
 -- | A single search result.
 data SearchResult = SearchResult
@@ -49,7 +50,8 @@ data SearchResultSource
 instance NFData SearchResultSource
 
 data SearchResultInfo
-  = PackageResult
+  = PackageResult Bool
+  -- ^ Package deprecation status
   | ModuleResult Text
   -- ^ Module name
   | DeclarationResult D.Namespace Text Text (Maybe Text)
@@ -60,8 +62,9 @@ instance NFData SearchResultInfo
 
 instance ToJSON SearchResultInfo where
   toJSON i = object $ case i of
-    PackageResult ->
+    PackageResult deprecated ->
       [ "type" .= ("package" :: Text)
+      , "deprecated" .= deprecated
       ]
     ModuleResult moduleName ->
       [ "type" .= ("module" :: Text)
@@ -78,7 +81,7 @@ instance ToJSON SearchResultInfo where
 searchResultTitle :: SearchResult -> Text
 searchResultTitle r =
   case srInfo r of
-    PackageResult ->
+    PackageResult _ ->
       case srSource r of
         SourceBuiltin ->
           "<builtin>"
@@ -156,7 +159,7 @@ primEntries =
     concatMap (entriesForModule mkEntry) D.primModules
 
 entriesForPackage :: D.Package a -> Int -> [(ByteString, IndexEntry)]
-entriesForPackage D.Package{..} revDeps =
+entriesForPackage pkg@D.Package{..} revDeps =
   let
     src =
       SourcePackage (bowerName pkgMeta) pkgVersion
@@ -171,14 +174,17 @@ entriesForPackage D.Package{..} revDeps =
         (tryStripPrefix "purescript-"
           (T.toLower
             (runPackageName (bowerName pkgMeta))))
+    deprecated = isDeprecated pkg
     packageEntry =
       ( entryKey
       , mkEntry (fromMaybe "" (bowerDescription pkgMeta))
-                PackageResult
+                (PackageResult deprecated)
                 Nothing
       )
   in
-    packageEntry : concatMap (entriesForModule mkEntry) pkgModules
+    packageEntry : if deprecated
+                     then []
+                     else concatMap (entriesForModule mkEntry) pkgModules
 
 entriesForModule ::
   (Text -> SearchResultInfo -> Maybe D.Type' -> IndexEntry) ->
@@ -470,3 +476,7 @@ parseType = fmap ($> ()) . parseWithTokenParser P.parsePolyType
 
 isSymbol :: Text -> Bool
 isSymbol = maybe False (const True) . parseWithTokenParser P.symbol
+
+isDeprecated :: D.Package a -> Bool
+isDeprecated D.Package{..} =
+  "pursuit-deprecated" `elem` bowerKeywords pkgMeta

static/css/extra.css

@@ -7,3 +7,15 @@
 .col--main > h2:first-child {
   margin-top: 0;
 }
+
+.badge--deprecated {
+  color: #fff;
+  background-color: #c4953a;
+  padding: 0.1em 0.4em 0.1em 0.4em;
+  border-radius: 0.3em;
+  font-size: 77%;
+  font-weight: bold;
+  position: relative;
+  top: -0.1em;
+  margin-left: 0.4em;
+}

static/help-docs/authors.md

@@ -43,6 +43,10 @@ curl -X POST \
 
 If your submission is successful, Pursuit will return a 201 Created response, and the URL for your newly uploaded package will be in the Location header.
 
+## <a name="package-deprecation"></a>How to mark package as deprecated
+
+Package deprecation is a mechanism to tell the end users that your package is no longer supported. When package is marked as deprecated, its contents will not show up in search results on Pursuit (with the only exception of the package name itself). A package can be marked as deprecated by adding a special keyword `pursuit-deprecated` to keywords section of `bower.json` and publishing a new version of the package.
+
 ## <a name="package-badges"></a>Package badges
 
 Pursuit can generate SVG badges for your packages, which you can put on your project's homepage, or perhaps its GitHub readme.

templates/packageVersion.hamlet

@@ -1,5 +1,10 @@
 <div .page-title .clearfix>
-  <div .page-title__label>Package
+  <div .page-title__label>
+    Package
+    $if deprecated
+      <span .badge--deprecated title="This package is marked as deprecated">
+        DEPRECATED
+
   <h1 .page-title__title>#{runPackageName pkgName}
 
 <div .col.col--main>

templates/packageVersionModuleDocs.hamlet

@@ -8,6 +8,9 @@
   <dl .grouped-list>
     <dt .grouped-list__title>Package
     <dd .grouped-list__item><a href=@{packageRoute pkg}>#{runPackageName pkgName}</a>
+      $if deprecated
+        <span .badge--deprecated title="This package is marked as deprecated">
+          DEPRECATED
     <dt .grouped-list__title>Repository
     <dd .grouped-list__item>#{linkToGithub pkgGithub}