From 39d1e0c867ddc84c3f35e63a075c5bcb167affa1 Mon Sep 17 00:00:00 2001
From: Alexey Kuleshevich <alexey@kuleshevi.ch>
Date: Thu, 11 Jul 2019 14:07:42 +0300
Subject: [PATCH] Make sure links to haddocks are not generated for modules
 that have no haddock

---
 src/Handler/Package.hs         | 7 +++++--
 src/Stackage/Database/Query.hs | 8 ++++----
 src/Stackage/Database/Types.hs | 2 +-
 3 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs
index d1a31f3..61f57c6 100644
--- a/src/Handler/Package.hs
+++ b/src/Handler/Package.hs
@@ -18,6 +18,7 @@ module Handler.Package
 
 import Control.Lens
 
+import qualified RIO.Map as Map
 import Data.Coerce
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
@@ -121,8 +122,9 @@ handlePackage epi = do
         SnapshotR (spiSnapName spi) $ f $ PNVNameVersion (spiPackageName spi) (spiVersion spi)
     pname = either hciPackageName spiPackageName epi
     enumerate = zip [0 :: Int ..]
-    renderModules sppi = renderForest [] $ moduleForest $ coerce (sppiModuleNames sppi)
+    renderModules sppi = renderForest [] $ moduleForest $ coerce $ Map.keys modNames
       where
+        modNames = sppiModuleNames sppi
         SnapshotPackageInfo{spiPackageName, spiVersion, spiSnapName} = sppiSnapshotPackageInfo sppi
         packageIdentifier = PackageIdentifierP spiPackageName spiVersion
         renderForest _ [] = mempty
@@ -135,7 +137,7 @@ handlePackage epi = do
             renderTree Node {..} =
                 [hamlet|
                   <li>
-                    $if isModule
+                    $if isModule && hasDoc
                       <a href=@{haddockUrl spiSnapName mli}>#{modName}
                     $else
                       #{modName}
@@ -145,6 +147,7 @@ handlePackage epi = do
                 mli = ModuleListingInfo modName packageIdentifier
                 pathRev' = component : pathRev
                 modName = moduleNameFromComponents (reverse pathRev')
+                hasDoc = fromMaybe False $ Map.lookup modName modNames
     maxDisplayedDeps :: Int
     maxDisplayedDeps = 40
 
diff --git a/src/Stackage/Database/Query.hs b/src/Stackage/Database/Query.hs
index 8a86609..3baf17b 100644
--- a/src/Stackage/Database/Query.hs
+++ b/src/Stackage/Database/Query.hs
@@ -630,15 +630,15 @@ getFileByTreeEntryId teid =
         where_ $ te ^. TreeEntryId ==. val teid
         pure (fp ^. FilePathPath, b ^. BlobContents)
 
-getModuleNames :: SnapshotPackageId -> ReaderT SqlBackend (RIO env) [ModuleNameP]
+getModuleNames :: SnapshotPackageId -> ReaderT SqlBackend (RIO env) (Map ModuleNameP Bool)
 getModuleNames spid =
-    map unValue <$>
+    Map.fromList . map (\(md, hs) -> (unValue md, unValue hs)) <$>
     select
         (from $ \(spm `InnerJoin` pm) -> do
              on (spm ^. SnapshotPackageModuleModule ==. pm ^. ModuleNameId)
              where_ (spm ^. SnapshotPackageModuleSnapshotPackage ==. val spid)
              orderBy [desc (pm ^. ModuleNameName)]
-             pure (pm ^. ModuleNameName))
+             pure (pm ^. ModuleNameName, spm ^. SnapshotPackageModuleHasDocs))
 
 ------ Dependencies
 
@@ -1000,7 +1000,7 @@ markModuleHasDocs ::
        SnapshotId
     -> PackageIdentifierP
     -> Maybe SnapshotPackageId
-    -- ^ If we know ahead of time the SnapshotPackageId it will speed up a great deal if don't have
+    -- ^ If we know ahead of time the SnapshotPackageId it will speed things up, since we don't have
     -- to look it up in the database.
     -> ModuleNameP
     -> ReaderT SqlBackend (RIO env) (Maybe SnapshotPackageId)
diff --git a/src/Stackage/Database/Types.hs b/src/Stackage/Database/Types.hs
index 5e963f8..4e28274 100644
--- a/src/Stackage/Database/Types.hs
+++ b/src/Stackage/Database/Types.hs
@@ -251,7 +251,7 @@ data SnapshotPackagePageInfo = SnapshotPackagePageInfo
     , sppiReverseDepsCount       :: !Int
     -- ^ Count of all packages in the snapshot that depends on this package
     , sppiLatestInfo             :: ![LatestInfo]
-    , sppiModuleNames            :: ![ModuleNameP]
+    , sppiModuleNames            :: !(Map ModuleNameP Bool)
     , sppiPantryCabal            :: !(Maybe PantryCabal)
     , sppiVersion                :: !(Maybe VersionRev)
     -- ^ Version on this page. Should be present only if different from latest