Pedantic ghcide (#3751)

Author: joyfulmantis

.github/workflows/flags.yml

@@ -75,8 +75,8 @@ jobs:
       - name: Build `ghcide` with flags
         run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe ekg"
 
-      # we have to clean up warnings for 9.0 and 9.2 before enable -Wall
-      - if: matrix.ghc != '9.0' && matrix.ghc != '9.2'
+      # wingman fails with flags on 9.0, so this can be removed when that's gone
+      - if: matrix.ghc != '9.0'
         name: Build with pedantic (-WError)
         run: cabal v2-build --flags="pedantic"
 

ghcide/ghcide.cabal

@@ -35,6 +35,11 @@ flag ekg
     default:     False
     manual:      True
 
+flag pedantic
+    description: Enable -Werror
+    default:     False
+    manual:      True
+
 library
     default-language:   Haskell2010
     build-depends:
@@ -221,14 +226,34 @@ library
 
     ghc-options:
                 -Wall
-                -Wno-name-shadowing
                 -Wincomplete-uni-patterns
                 -Wno-unticked-promoted-constructors
                 -fno-ignore-asserts
 
     if flag(ghc-patched-unboxed-bytecode)
       cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE
 
+    if flag(pedantic)
+        -- We eventually want to build with Werror fully, but we haven't
+        -- finished purging the warnings, so some are set to not be errors
+        -- for now
+        ghc-options: -Werror 
+                     -Wwarn=unused-packages
+                     -Wwarn=unrecognised-pragmas
+                     -Wwarn=dodgy-imports
+                     -Wwarn=missing-signatures
+                     -Wwarn=duplicate-exports
+                     -Wwarn=dodgy-exports
+                     -Wwarn=incomplete-patterns
+                     -Wwarn=overlapping-patterns
+                     -Wwarn=incomplete-record-updates
+    
+    -- ambiguous-fields is only understood by GHC >= 9.2, so we only disable it
+    -- then. The above comment goes for here too -- this should be understood to
+    -- be temporary until we can remove these warnings.
+    if impl(ghc >= 9.2) && flag(pedantic)
+        ghc-options: -Wwarn=ambiguous-fields
+
     if impl(ghc >= 9)
         ghc-options: -Wunused-packages
 

ghcide/session-loader/Development/IDE/Session.hs

@@ -38,9 +38,8 @@ import           Data.Char                            (isLower)
 import           Data.Default
 import           Data.Either.Extra
 import           Data.Function
-import           Data.Hashable
+import           Data.Hashable                        hiding (hash)
 import qualified Data.HashMap.Strict                  as HM
-import           Data.IORef
 import           Data.List
 import           Data.List.Extra                      (dropPrefix, split)
 import qualified Data.Map.Strict                      as Map
@@ -51,11 +50,11 @@ import           Data.Time.Clock
 import           Data.Version
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake           hiding (Log, Priority,
-                                                       withHieDb)
+                                                       knownTargets, withHieDb)
 import qualified Development.IDE.GHC.Compat           as Compat
 import           Development.IDE.GHC.Compat.Core      hiding (Target,
                                                        TargetFile, TargetModule,
-                                                       Var, Warning)
+                                                       Var, Warning, getOptions)
 import qualified Development.IDE.GHC.Compat.Core      as GHC
 import           Development.IDE.GHC.Compat.Env       hiding (Logger)
 import           Development.IDE.GHC.Compat.Units     (UnitId)
@@ -111,6 +110,12 @@ import           HieDb.Utils
 import qualified System.Random                        as Random
 import           System.Random                        (RandomGen)
 
+-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
+
+#if !MIN_VERSION_ghc(9,4,0)
+import           Data.IORef
+#endif
+
 data Log
   = LogSettingInitialDynFlags
   | LogGetInitialGhcLibDirDefaultCradleFail !CradleError !FilePath !(Maybe FilePath) !(Cradle Void)
@@ -148,21 +153,21 @@ instance Pretty Log where
           , "Cradle:" <+> viaShow cradle ]
     LogGetInitialGhcLibDirDefaultCradleNone ->
       "Couldn't load cradle. Cradle not found."
-    LogHieDbRetry delay maxDelay maxRetryCount e ->
+    LogHieDbRetry delay maxDelay retriesRemaining e ->
       nest 2 $
         vcat
           [ "Retrying hiedb action..."
           , "delay:" <+> pretty delay
           , "maximum delay:" <+> pretty maxDelay
-          , "retries remaining:" <+> pretty maxRetryCount
+          , "retries remaining:" <+> pretty retriesRemaining
           , "SQLite error:" <+> pretty (displayException e) ]
-    LogHieDbRetriesExhausted baseDelay maxDelay maxRetryCount e ->
+    LogHieDbRetriesExhausted baseDelay maxDelay retriesRemaining e ->
       nest 2 $
         vcat
           [ "Retries exhausted for hiedb action."
           , "base delay:" <+> pretty baseDelay
           , "maximum delay:" <+> pretty maxDelay
-          , "retries remaining:" <+> pretty maxRetryCount
+          , "retries remaining:" <+> pretty retriesRemaining
           , "Exception:" <+> pretty (displayException e) ]
     LogHieDbWriterThreadSQLiteError e ->
       nest 2 $
@@ -199,7 +204,7 @@ instance Pretty Log where
       "Cradle:" <+> viaShow cradle
     LogNewComponentCache componentCache ->
       "New component cache HscEnvEq:" <+> viaShow componentCache
-    LogHieBios log -> pretty log
+    LogHieBios msg -> pretty msg
 
 -- | Bump this version number when making changes to the format of the data stored in hiedb
 hiedbDataVersion :: String
@@ -263,17 +268,16 @@ loadWithImplicitCradle mHieYaml rootDir = do
 
 getInitialGhcLibDirDefault :: Recorder (WithPriority Log) -> FilePath -> IO (Maybe LibDir)
 getInitialGhcLibDirDefault recorder rootDir = do
-  let log = logWith recorder
   hieYaml <- findCradle def rootDir
   cradle <- loadCradle def hieYaml rootDir
   libDirRes <- getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle
   case libDirRes of
       CradleSuccess libdir -> pure $ Just $ LibDir libdir
       CradleFail err -> do
-        log Error $ LogGetInitialGhcLibDirDefaultCradleFail err rootDir hieYaml cradle
+        logWith recorder Error $ LogGetInitialGhcLibDirDefaultCradleFail err rootDir hieYaml cradle
         pure Nothing
       CradleNone -> do
-        log Warning LogGetInitialGhcLibDirDefaultCradleNone
+        logWith recorder Warning LogGetInitialGhcLibDirDefaultCradleNone
         pure Nothing
 
 -- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir
@@ -301,28 +305,26 @@ retryOnException
   -> g -- ^ random number generator
   -> m a -- ^ action that may throw exception
   -> m a
-retryOnException exceptionPred recorder maxDelay !baseDelay !maxRetryCount rng action = do
+retryOnException exceptionPred recorder maxDelay !baseDelay !maxTimesRetry rng action = do
   result <- tryJust exceptionPred action
   case result of
     Left e
-      | maxRetryCount > 0 -> do
+      | maxTimesRetry > 0 -> do
         -- multiply by 2 because baseDelay is midpoint of uniform range
         let newBaseDelay = min maxDelay (baseDelay * 2)
         let (delay, newRng) = Random.randomR (0, newBaseDelay) rng
-        let newMaxRetryCount = maxRetryCount - 1
+        let newMaxTimesRetry = maxTimesRetry - 1
         liftIO $ do
-          log Warning $ LogHieDbRetry delay maxDelay newMaxRetryCount (toException e)
+          logWith recorder Warning $ LogHieDbRetry delay maxDelay newMaxTimesRetry (toException e)
           threadDelay delay
-        retryOnException exceptionPred recorder maxDelay newBaseDelay newMaxRetryCount newRng action
+        retryOnException exceptionPred recorder maxDelay newBaseDelay newMaxTimesRetry newRng action
 
       | otherwise -> do
         liftIO $ do
-          log Warning $ LogHieDbRetriesExhausted baseDelay maxDelay maxRetryCount (toException e)
+          logWith recorder Warning $ LogHieDbRetriesExhausted baseDelay maxDelay maxTimesRetry (toException e)
           throwIO e
 
     Right b -> pure b
-  where
-    log = logWith recorder
 
 -- | in microseconds
 oneSecond :: Int
@@ -377,21 +379,19 @@ runWithDb recorder fp k = do
     withAsync (writerThread withWriteDbRetryable chan) $ \_ -> do
       withHieDb fp (\readDb -> k (makeWithHieDbRetryable recorder rng readDb) chan)
   where
-    log = logWith recorder
-
     writerThread :: WithHieDb -> IndexQueue -> IO ()
     writerThread withHieDbRetryable chan = do
       -- Clear the index of any files that might have been deleted since the last run
       _ <- withHieDbRetryable deleteMissingRealFiles
       _ <- withHieDbRetryable garbageCollectTypeNames
       forever $ do
-        k <- atomically $ readTQueue chan
+        l <- atomically $ readTQueue chan
         -- TODO: probably should let exceptions be caught/logged/handled by top level handler
-        k withHieDbRetryable
+        l withHieDbRetryable
           `Safe.catch` \e@SQLError{} -> do
-            log Error $ LogHieDbWriterThreadSQLiteError e
-          `Safe.catchAny` \e -> do
-            log Error $ LogHieDbWriterThreadException e
+            logWith recorder Error $ LogHieDbWriterThreadSQLiteError e
+          `Safe.catchAny` \f -> do
+            logWith recorder Error $ LogHieDbWriterThreadException f
 
 
 getHieDbLoc :: FilePath -> IO FilePath
@@ -520,7 +520,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
                   -- We will modify the unitId and DynFlags used for
                   -- compilation but these are the true source of
                   -- information.
-                  
+
                   new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info
                                 : maybe [] snd oldDeps
                   -- Get all the unit-ids for things in this component
@@ -532,7 +532,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
 #if MIN_VERSION_ghc(9,3,0)
                   let (df2, uids) = (rawComponentDynFlags, [])
 #else
-                  let (df2, uids) = removeInplacePackages fakeUid inplace rawComponentDynFlags
+                  let (df2, uids) = _removeInplacePackages fakeUid inplace rawComponentDynFlags
 #endif
                   let prefix = show rawComponentUnitId
                   -- See Note [Avoiding bad interface files]
@@ -554,11 +554,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
               -- scratch again (for now)
               -- It's important to keep the same NameCache though for reasons
               -- that I do not fully understand
-              log Info $ LogMakingNewHscEnv inplace
-              hscEnv <- emptyHscEnv ideNc libDir
+              logWith recorder Info $ LogMakingNewHscEnv inplace
+              hscEnvB <- emptyHscEnv ideNc libDir
               !newHscEnv <-
                 -- Add the options for the current component to the HscEnv
-                evalGhcEnv hscEnv $ do
+                evalGhcEnv hscEnvB $ do
                   _ <- setSessionDynFlags
 #if !MIN_VERSION_ghc(9,3,0)
                           $ setHomeUnitId_ fakeUid
@@ -595,7 +595,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
             res <- loadDLL hscEnv "libm.so.6"
             case res of
               Nothing  -> pure ()
-              Just err -> log Error $ LogDLLLoadError err
+              Just err -> logWith recorder Error $ LogDLLLoadError err
 
 
           -- Make a map from unit-id to DynFlags, this is used when trying to
@@ -637,21 +637,22 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
                     let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
                     modIfaces <- uses GetModIface cs_exist
                     -- update exports map
-                    extras <- getShakeExtras
+                    shakeExtras <- getShakeExtras
                     let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
-                    liftIO $ atomically $ modifyTVar' (exportsMap extras) (exportsMap' <>)
+                    liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>)
 
           return (second Map.keys res)
 
     let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
         consultCradle hieYaml cfp = do
-           lfp <- flip makeRelative cfp <$> getCurrentDirectory
-           log Info $ LogCradlePath lfp
+           lfpLog <- flip makeRelative cfp <$> getCurrentDirectory
+           logWith recorder Info $ LogCradlePath lfpLog
 
            when (isNothing hieYaml) $
-             log Warning $ LogCradleNotFound lfp
+             logWith recorder Warning $ LogCradleNotFound lfpLog
 
            cradle <- loadCradle hieYaml dir
+           -- TODO: Why are we repeating the same command we have on line 646?
            lfp <- flip makeRelative cfp <$> getCurrentDirectory
 
            when optTesting $ mRunLspT lspEnv $
@@ -667,7 +668,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
                   addTag "result" (show res)
                   return res
 
-           log Debug $ LogSessionLoadingResult eopts
+           logWith recorder Debug $ LogSessionLoadingResult eopts
            case eopts of
              -- The cradle gave us some options so get to work turning them
              -- into and HscEnv.
@@ -727,11 +728,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
       opts <- liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do
         -- If the cradle is not finished, then wait for it to finish.
         void $ wait as
-        as <- async $ getOptions file
-        return (as, wait as)
+        asyncRes <- async $ getOptions file
+        return (asyncRes, wait asyncRes)
       pure opts
-  where
-    log = logWith recorder
 
 -- | Run the specific cradle on a specific FilePath via hie-bios.
 -- This then builds dependencies or whatever based on the cradle, gets the
@@ -787,14 +786,14 @@ fromTargetId :: [FilePath]          -- ^ import paths
              -> DependencyInfo
              -> IO [TargetDetails]
 -- For a target module we consider all the import paths
-fromTargetId is exts (GHC.TargetModule mod) env dep = do
-    let fps = [i </> moduleNameSlashes mod -<.> ext <> boot
+fromTargetId is exts (GHC.TargetModule modName) env dep = do
+    let fps = [i </> moduleNameSlashes modName -<.> ext <> boot
               | ext <- exts
               , i <- is
               , boot <- ["", "-boot"]
               ]
     locs <- mapM (fmap toNormalizedFilePath' . makeAbsolute) fps
-    return [TargetDetails (TargetModule mod) env dep locs]
+    return [TargetDetails (TargetModule modName) env dep locs]
 -- For a 'TargetFile' we consider all the possible module names
 fromTargetId _ _ (GHC.TargetFile f _) env deps = do
     nf <- toNormalizedFilePath' <$> makeAbsolute f
@@ -1059,11 +1058,11 @@ getDependencyInfo :: [FilePath] -> IO DependencyInfo
 getDependencyInfo fs = Map.fromList <$> mapM do_one fs
 
   where
-    tryIO :: IO a -> IO (Either IOException a)
-    tryIO = Safe.try
+    safeTryIO :: IO a -> IO (Either IOException a)
+    safeTryIO = Safe.try
 
     do_one :: FilePath -> IO (FilePath, Maybe UTCTime)
-    do_one fp = (fp,) . eitherToMaybe <$> tryIO (getModificationTime fp)
+    do_one fp = (fp,) . eitherToMaybe <$> safeTryIO (getModificationTime fp)
 
 -- | This function removes all the -package flags which refer to packages we
 -- are going to deal with ourselves. For example, if a executable depends
@@ -1073,12 +1072,12 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs
 -- There are several places in GHC (for example the call to hptInstances in
 -- tcRnImports) which assume that all modules in the HPT have the same unit
 -- ID. Therefore we create a fake one and give them all the same unit id.
-removeInplacePackages
+_removeInplacePackages --Only used in ghc < 9.4
     :: UnitId     -- ^ fake uid to use for our internal component
     -> [UnitId]
     -> DynFlags
     -> (DynFlags, [UnitId])
-removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $
+_removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $
                                        df { packageFlags = ps }, uids)
   where
     (uids, ps) = Compat.filterInplaceUnits us (packageFlags df)

ghcide/src/Development/IDE/Core/Actions.hs

@@ -67,7 +67,7 @@ getAtPoint file pos = runMaybeT $ do
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
   MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'
 
--- | For each Loacation, determine if we have the PositionMapping
+-- | For each Location, determine if we have the PositionMapping
 -- for the correct file. If not, get the correct position mapping
 -- and then apply the position mapping to the location.
 toCurrentLocations