Post Hoogle generation disk cleanup

app/stackage-server-cron.hs

@@ -58,7 +58,7 @@ optsParser =
               T.unpack defHaddockBucketName)) <*>
     switch
         (long "do-not-upload" <>
-         help "Stop from hoogle db and snapshots.json from being generated and uploaded") <*>
+         help "Disable upload of Hoogle database and snapshots.json") <*>
     option
         readLogLevel
         (long "log-level" <> metavar "LOG_LEVEL" <> short 'l' <> value LevelInfo <>

src/Stackage/Database/Github.hs

@@ -4,7 +4,7 @@ module Stackage.Database.Github
     ( cloneOrUpdate
     , lastGitFileUpdate
     , getStackageContentDir
-    , getCoreCabalFilesDir
+    , getBackupCoreCabalFilesDir
     , GithubRepo(..)
     ) where
 
@@ -81,9 +81,9 @@ getStackageContentDir rootDir =
     cloneOrUpdate rootDir (GithubRepo "commercialhaskell" "stackage-content")
 
 -- | Use backup location with cabal files, hackage doesn't have all of them.
-getCoreCabalFilesDir ::
+getBackupCoreCabalFilesDir ::
        (MonadReader env m, HasLogFunc env, HasProcessContext env, MonadIO m)
     => FilePath
     -> m FilePath
-getCoreCabalFilesDir rootDir =
+getBackupCoreCabalFilesDir rootDir =
     cloneOrUpdate rootDir (GithubRepo "commercialhaskell" "core-cabal-files")

src/Stackage/Database/Query.hs

@@ -173,7 +173,7 @@ ltsBefore x y = do
 lastLtsNightlyWithoutHoogleDb :: Int -> Int -> RIO StackageCron [(SnapshotId, SnapName)]
 lastLtsNightlyWithoutHoogleDb ltsCount nightlyCount = do
     currentHoogleVersionId <- scHoogleVersionId <$> ask
-    let getSnapshotsWithoutHoogeDb snapId snapCount =
+    let getSnapshotsWithoutHoogleDb snapId snapCount =
             map (unValue *** unValue) <$>
             select
                 -- "snap" is either Lts or Nightly, while "snapshot" is indeed
@@ -206,12 +206,12 @@ lastLtsNightlyWithoutHoogleDb ltsCount nightlyCount = do
                 --     order by snapshot.created desc
                 --     limit $snapCount
                 --
-                -- So it returns a list of snapshots where there is no
+                -- So it returns a limited list of snapshots where there is no
                 -- corresponding entry in the snapshot_hoogle_db table for the
                 -- current hoogle version.
     run $ do
-        lts <- getSnapshotsWithoutHoogeDb LtsSnap ltsCount
-        nightly <- getSnapshotsWithoutHoogeDb NightlySnap nightlyCount
+        lts <- getSnapshotsWithoutHoogleDb LtsSnap ltsCount
+        nightly <- getSnapshotsWithoutHoogleDb NightlySnap nightlyCount
         pure $ lts ++ nightly
 
 
@@ -1100,6 +1100,8 @@ getHackageCabalByKey (PackageIdentifierP pname ver) (BlobKey sha size) =
         return (hc ^. HackageCabalId, hc ^. HackageCabalTree)
 
 
+-- | Gets the id for the SnapshotPackage that corresponds to the given Snapshot
+-- and PackageIdentifier.
 getSnapshotPackageId ::
        SnapshotId
     -> PackageIdentifierP
@@ -1114,6 +1116,18 @@ getSnapshotPackageId snapshotId (PackageIdentifierP pname ver) =
              (pn ^. PackageNameName ==. val pname) &&.
              (v ^. VersionVersion ==. val ver))
         return (sp ^. SnapshotPackageId)
+    --
+    -- i.e.
+    --
+    -- select sp.id
+    -- from snapshot_package sp
+    -- join version
+    -- on version.id = sp.version
+    -- join package_name pn
+    -- on pn.id = sp.package_name
+    -- where sp.snapshot = $snapshot_id
+    -- and pn.name = $name
+    -- and v.version = $version
 
 
 getSnapshotPackageCabalBlob ::
@@ -1127,6 +1141,16 @@ getSnapshotPackageCabalBlob snapshotId pname =
             ((sp ^. SnapshotPackageSnapshot ==. val snapshotId) &&.
              (pn ^. PackageNameName ==. val pname))
         return (blob ^. BlobContents)
+    -- i.e.
+    --
+    -- select blob.content
+    -- from snapshot_package sp
+    -- join package_name pn
+    -- on pn.id = sp.package_name
+    -- join blob
+    -- on blob.id = sp.cabal
+    -- where sp.snapshot = $snapshotId
+    -- and pn.name = $name
 
 -- | Idempotent and thread safe way of adding a new module.
 insertModuleSafe :: ModuleNameP -> ReaderT SqlBackend (RIO env) ModuleNameId
@@ -1164,6 +1188,7 @@ markModuleHasDocs snapshotId pid mSnapshotPackageId modName =
                 \AND snapshot_package_module.snapshot_package = ?"
                 [toPersistValue modName, toPersistValue snapshotPackageId]
             return $ Just snapshotPackageId
+        -- FIXME: The Nothing case seems like it should not happen.
         Nothing -> return Nothing
 
 
@@ -1199,9 +1224,10 @@ checkInsertSnapshotHoogleDb shouldInsert snapshotId = do
                     lift $
                     logInfo $
                     "Marking hoogle database for version " <> display hver <> " as available."
-                -- whether or not the version exists, we still put it into snapshot_hoogle_db
-                -- So literally the only use of the above query is to log the
-                -- action we're taking.
+                -- whether or not the version exists, we still put it into
+                -- snapshot_hoogle_db. So literally the only use of the above
+                -- query is to log the action we're taking. Whether or not it
+                -- exists is immaterial to the following action.
                 isJust <$> P.insertUniqueEntity sh
             -- if we're not inserting, we're just checking if it already exists
             -- in snapshot_hoogle_db.

src/Stackage/Database/Types.hs

@@ -117,6 +117,7 @@ data SnapshotFile = SnapshotFile
     } deriving (Show)
 
 
+-- Is this a reference to a cabal file stored in Pantry?
 data PantryCabal = PantryCabal
     { pcPackageName :: !PackageNameP
     , pcVersion     :: !VersionP
@@ -131,6 +132,7 @@ instance Display PantryCabal where
 instance ToMarkup PantryCabal where
     toMarkup = toMarkup . textDisplay
 
+-- A Cabal file (package name, version, blob) and source tree
 data PantryPackage = PantryPackage
     { ppPantryCabal :: !PantryCabal
     , ppPantryKey   :: !TreeKey

stack.yaml

@@ -34,5 +34,4 @@ nix:
     - zlib
     - postgresql
     - pkg-config
-    - haskell-language-server
     - cacert