diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index b1bc9d40ea..f464ac8ef1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -534,7 +534,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- compilation but these are the true source of -- information. new_deps = fmap (\(df, targets) -> RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info) newTargetDfs - all_deps = new_deps `NE.appendList` maybe [] id oldDeps + all_deps = new_deps `NE.appendList` fromMaybe [] oldDeps -- Get all the unit-ids for things in this component _inplace = map rawComponentUnitId $ NE.toList all_deps @@ -594,7 +594,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map void $ modifyVar' filesMap $ - flip HM.union (HM.fromList (zip (map fst $ concatMap toFlagsMap all_targets) (repeat hieYaml))) + flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) void $ extendKnownTargets all_targets @@ -685,7 +685,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- again. modifyVar_ fileToFlags (const (return Map.empty)) -- Keep the same name cache - modifyVar_ hscEnvs (return . Map.adjust (\_ -> []) hieYaml ) + modifyVar_ hscEnvs (return . Map.adjust (const []) hieYaml ) consultCradle hieYaml cfp else return (opts, Map.keys old_di) Nothing -> consultCradle hieYaml cfp diff --git a/ghcide/session-loader/Development/IDE/Session/Implicit.hs b/ghcide/session-loader/Development/IDE/Session/Implicit.hs index e8e804e3c1..c7a6402a9f 100644 --- a/ghcide/session-loader/Development/IDE/Session/Implicit.hs +++ b/ghcide/session-loader/Development/IDE/Session/Implicit.hs @@ -3,26 +3,27 @@ module Development.IDE.Session.Implicit ) where -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>)) +import Control.Exception (handleJust) import Control.Monad -import Control.Monad.Trans.Maybe import Control.Monad.IO.Class -import Control.Exception (handleJust) +import Control.Monad.Trans.Maybe import Data.Bifunctor +import Data.Functor ((<&>)) import Data.Maybe import Data.Void +import System.Directory hiding (findFile) import System.FilePath -import System.Directory hiding (findFile) import System.IO.Error -import Colog.Core (LogAction (..), WithSeverity (..)) -import HIE.Bios.Cradle (getCradle, defaultCradle) +import Colog.Core (LogAction (..), WithSeverity (..)) import HIE.Bios.Config -import HIE.Bios.Types hiding (ActionName(..)) +import HIE.Bios.Cradle (defaultCradle, getCradle) +import HIE.Bios.Types hiding (ActionName (..)) -import Hie.Locate import Hie.Cabal.Parser -import qualified Hie.Yaml as Implicit +import Hie.Locate +import qualified Hie.Yaml as Implicit loadImplicitCradle :: Show a => LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle a) loadImplicitCradle l wfile = do @@ -50,11 +51,11 @@ inferCradleTree start_dir = <|> (cabalExecutable >> cabalConfigDir start_dir >>= \dir -> cabalWorkDir dir >> pure (simpleCabalCradle dir)) <|> (stackExecutable >> stackConfigDir start_dir >>= \dir -> stackWorkDir dir >> stackCradle dir) -- If we have a cabal.project OR we have a .cabal and dist-newstyle, prefer cabal - <|> (cabalExecutable >> (cabalConfigDir start_dir <|> cabalFileAndWorkDir) >>= pure . simpleCabalCradle) + <|> (cabalExecutable >> (cabalConfigDir start_dir <|> cabalFileAndWorkDir) <&> simpleCabalCradle) -- If we have a stack.yaml, use stack <|> (stackExecutable >> stackConfigDir start_dir >>= stackCradle) -- If we have a cabal file, use cabal - <|> (cabalExecutable >> cabalFileDir start_dir >>= pure . simpleCabalCradle) + <|> (cabalExecutable >> cabalFileDir start_dir <&> simpleCabalCradle) where maybeItsBios = (\wdir -> (Bios (Program $ wdir ".hie-bios") Nothing Nothing, wdir)) <$> biosWorkDir start_dir diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index eba9cd6ec1..a0a27acac6 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -297,8 +297,8 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do #endif | n <- concatMap (uniqDSetToList . bcoFreeNames) $ bc_bcos bcos - , Just mod <- [nameModule_maybe n] -- Names from other modules , not (isWiredInName n) -- Exclude wired-in names + , Just mod <- [nameModule_maybe n] -- Names from other modules , moduleUnitId mod `elem` home_unit_ids -- Only care about stuff from the home package set ] home_unit_ids = @@ -340,7 +340,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do #else {- load it -} ; fv_hvs <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos - ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs) + ; let hval = expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs #endif ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb]) @@ -595,7 +595,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do -- SYB is slow but fine given that this is only used for testing noUnfoldings = everywhere $ mkT $ \v -> if isId v then - let v' = if isOtherUnfolding (realIdUnfolding v) then (setIdUnfolding v noUnfolding) else v + let v' = if isOtherUnfolding (realIdUnfolding v) then setIdUnfolding v noUnfolding else v in setIdOccInfo v' noOccInfo else v isOtherUnfolding (OtherCon _) = True @@ -1256,9 +1256,9 @@ parseHeader -> FilePath -- ^ the filename (for source locations) -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported) #if MIN_VERSION_ghc(9,5,0) - -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs)) + -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located (HsModule GhcPs)) #else - -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule)) + -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located HsModule) #endif parseHeader dflags filename contents = do let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 @@ -1748,19 +1748,19 @@ pathToModuleName = mkModuleName . map rep - CPP clauses should be placed at the end of the imports section. The clauses should be ordered by the GHC version they target from earlier to later versions, - with negative if clauses coming before positive if clauses of the same - version. (If you think about which GHC version a clause activates for this + with negative if clauses coming before positive if clauses of the same + version. (If you think about which GHC version a clause activates for this should make sense `!MIN_VERSION_GHC(9,0,0)` refers to 8.10 and lower which is - a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0 + a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0 and later). In addition there should be a space before and after each CPP clause. - - In if clauses that use `&&` and depend on more than one statement, the + - In if clauses that use `&&` and depend on more than one statement, the positive statement should come before the negative statement. In addition the clause should come after the single positive clause for that GHC version. - - There shouldn't be multiple identical CPP statements. The use of odd or even + - There shouldn't be multiple identical CPP statements. The use of odd or even GHC numbers is identical, with the only preference being to use what is - already there. (i.e. (`MIN_VERSION_GHC(9,2,0)` and `MIN_VERSION_GHC(9,1,0)` + already there. (i.e. (`MIN_VERSION_GHC(9,2,0)` and `MIN_VERSION_GHC(9,1,0)` are functionally equivalent) -} diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 315a078282..711cf69130 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -265,7 +265,7 @@ registerFileWatches globs = do -- our purposes. registration = LSP.TRegistration { _id ="globalFileWatches" , _method = LSP.SMethod_WorkspaceDidChangeWatchedFiles - , _registerOptions = Just $ regOptions} + , _registerOptions = Just regOptions} regOptions = DidChangeWatchedFilesRegistrationOptions { _watchers = watchers } -- See Note [File existence cache and LSP file watchers] for why this exists, and the choice of watch kind diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 7cc89ce170..2b5ce01b3f 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -372,7 +372,7 @@ getLocatedImportsRule recorder = let import_dirs = deps env_eq let dflags = hsc_dflags env isImplicitCradle = isNothing $ envImportPaths env_eq - dflags' <- return $ if isImplicitCradle + let dflags' = if isImplicitCradle then addRelativeImport file (moduleName $ ms_mod ms) dflags else dflags opt <- getIdeOptions @@ -538,7 +538,7 @@ reportImportCyclesRule recorder = let cycles = mapMaybe (cycleErrorInFile fileId) (toList errs) -- Convert cycles of files into cycles of module names forM cycles $ \(imp, files) -> do - modNames <- forM files $ + modNames <- forM files $ getModuleName . idToPath depPathIdMap pure $ toDiag imp $ sort modNames where cycleErrorInFile f (PartOfCycle imp fs) @@ -701,7 +701,7 @@ dependencyInfoForFiles fs = do -- 'extendModSummaryNoDeps'. -- This may have to change in the future. map extendModSummaryNoDeps $ - (catMaybes mss) + catMaybes mss #endif pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg) @@ -1170,7 +1170,7 @@ getLinkableType f = use_ NeedsCompilation f -- needsCompilationRule :: Rules () needsCompilationRule :: NormalizedFilePath -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)) needsCompilationRule file - | "boot" `isSuffixOf` (fromNormalizedFilePath file) = + | "boot" `isSuffixOf` fromNormalizedFilePath file = pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do graph <- useNoFile GetModuleGraph diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index fbe1ab1b8a..7111be0b6f 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -189,7 +189,7 @@ import Development.IDE.GHC.Compat (mkSplitUniqSupply, data Log = LogCreateHieDbExportsMapStart | LogCreateHieDbExportsMapFinish !Int - | LogBuildSessionRestart !String ![DelayedActionInternal] !(KeySet) !Seconds !(Maybe FilePath) + | LogBuildSessionRestart !String ![DelayedActionInternal] !KeySet !Seconds !(Maybe FilePath) | LogBuildSessionRestartTakingTooLong !Seconds | LogDelayedAction !(DelayedAction ()) !Seconds | LogBuildSessionFinish !(Maybe SomeException) @@ -1276,7 +1276,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti liftIO $ tag "count" (show $ Prelude.length newDiags) liftIO $ tag "key" (show k) LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $ - LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) ( newDiags) + LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) newDiags return action where diagsFromRule :: Diagnostic -> Diagnostic diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index cd86f25e33..f14dbdced1 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -137,11 +137,11 @@ pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e = sdocWithContext $ \_ctx -> withErrStyle unqual $ #if MIN_VERSION_ghc(9,7,0) - (formatBulleted e) + formatBulleted e #elif MIN_VERSION_ghc(9,3,0) - (formatBulleted _ctx $ e) + formatBulleted _ctx $ e #else - (formatBulleted _ctx $ Error.renderDiagnostic e) + formatBulleted _ctx $ Error.renderDiagnostic e #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 2af02273f9..b0b677743d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE CPP #-} -- | Compat module for 'UnitState' and 'UnitInfo'. module Development.IDE.GHC.Compat.Units ( diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 4fddbe75df..59bb5bfaa9 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -124,7 +124,7 @@ codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) $ -- | Implicit binds can be generated from the interface and are not tidied, -- so we must filter them out isNotImplictBind :: CoreBind -> Bool -isNotImplictBind bind = any (not . isImplicitId) $ bindBindings bind +isNotImplictBind bind = not . all isImplicitId $ bindBindings bind bindBindings :: CoreBind -> [Var] bindBindings (NonRec b _) = [b] @@ -189,7 +189,7 @@ tcTopIfaceBindings1 :: IORef TypeEnv -> [TopIfaceBinding IfaceId] -> IfL [CoreBind] tcTopIfaceBindings1 ty_var ver_decls = do - int <- mapM (traverse $ tcIfaceId) ver_decls + int <- mapM (traverse tcIfaceId) ver_decls let all_ids = concatMap toList int liftIO $ modifyIORef ty_var (flip extendTypeEnvList $ map AnId all_ids) extendIfaceIdEnv all_ids $ mapM tc_iface_bindings int @@ -212,7 +212,7 @@ tc_iface_bindings (TopIfaceNonRec v e) = do e' <- tcIfaceExpr e pure $ NonRec v e' tc_iface_bindings (TopIfaceRec vs) = do - vs' <- traverse (\(v, e) -> (,) <$> pure v <*> tcIfaceExpr e) vs + vs' <- traverse (\(v, e) -> (v,) <$> tcIfaceExpr e) vs pure $ Rec vs' -- | Prefixes that can occur in a GHC OccName diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index d8d16ca69f..f19a7424f4 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -98,7 +98,7 @@ instance Ord FastString where instance NFData (SrcSpanAnn' a) where rnf = rwhnf -instance Bifunctor (GenLocated) where +instance Bifunctor GenLocated where bimap f g (L l x) = L (f l) (g x) deriving instance Functor SrcSpanAnn' diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 0967e4e6fc..75ee2cf49d 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -168,7 +168,7 @@ cgGutsToCoreModule safeMode guts modDetails = CoreModule -- Will produce an 8 byte unreadable ByteString. fingerprintToBS :: Fingerprint -> BS.ByteString fingerprintToBS (Fingerprint a b) = BS.unsafeCreate 8 $ \ptr -> do - ptr' <- pure $ castPtr ptr + let ptr' = castPtr ptr pokeElemOff ptr' 0 a pokeElemOff ptr' 1 b diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index e91afa9c1b..d3b960f2bb 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -23,9 +23,9 @@ import Development.IDE.Types.Location -- standard imports import Control.Monad.Extra import Control.Monad.IO.Class -import Data.List (isSuffixOf, find) -import qualified Data.Set as S +import Data.List (find, isSuffixOf) import Data.Maybe +import qualified Data.Set as S import System.FilePath -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -93,7 +93,7 @@ locateModuleFile import_dirss exts targetFor isSource modName = do Nothing -> case find (\(_ , _, reexports) -> S.member modName reexports) import_dirss of Just (uid,_,_) -> pure $ LocateFoundReexport uid - Nothing -> pure $ LocateNotFound + Nothing -> pure LocateNotFound Just (uid,file) -> pure $ LocateFoundFile uid file where go (uid, candidate) = fmap ((uid,) <$>) $ targetFor modName candidate diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 90175cb730..048799fd39 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -110,7 +110,7 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh -- TODO: magic string , LSP.configSection = "haskell" , LSP.doInitialize = doInitialize - , LSP.staticHandlers = (const staticHandlers) + , LSP.staticHandlers = const staticHandlers , LSP.interpretHandler = interpretHandler , LSP.options = modifyOptions options } diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index c9c3de1540..e3adf398e5 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -274,7 +274,7 @@ hsConDeclsBinders cons get_flds_h98 _ = [] get_flds_gadt :: HsConDeclGADTDetails GhcPs - -> ([LFieldOcc GhcPs]) + -> [LFieldOcc GhcPs] #if MIN_VERSION_ghc(9,3,0) get_flds_gadt (RecConGADT flds _) = get_flds (reLoc flds) #else @@ -283,7 +283,7 @@ hsConDeclsBinders cons get_flds_gadt _ = [] get_flds :: Located [LConDeclField GhcPs] - -> ([LFieldOcc GhcPs]) + -> [LFieldOcc GhcPs] get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index fbac11a357..9ce9a79c93 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -704,7 +704,7 @@ getCompletions pn = showForSnippet name ty = showForSnippet <$> typ thisModName = Local $ nameSrcSpan name - dets = NameDetails <$> (nameModule_maybe name) <*> pure (nameOccName name) + dets = NameDetails <$> nameModule_maybe name <*> pure (nameOccName name) -- When record-dot-syntax completions are available, we return them exclusively. -- They are only available when we write i.e. `myrecord.` with OverloadedRecordDot enabled. @@ -762,7 +762,7 @@ uniqueCompl candidate unique = EQ -> -- preserve completions for duplicate record fields where the only difference is in the type -- remove redundant completions with less type info than the previous - if (isLocalCompletion unique) + if isLocalCompletion unique -- filter global completions when we already have a local one || not(isLocalCompletion candidate) && isLocalCompletion unique then EQ diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 512477c4b3..9809144dcf 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -183,7 +183,7 @@ codeLensResolveProvider ideState pId lens@CodeLens{_range} uri TypeLensesResolve generateLensCommand :: PluginId -> Uri -> T.Text -> TextEdit -> Command generateLensCommand pId uri title edit = - let wEdit = WorkspaceEdit (Just $ Map.singleton uri $ [edit]) Nothing Nothing + let wEdit = WorkspaceEdit (Just $ Map.singleton uri [edit]) Nothing Nothing in mkLspCommand pId (CommandId typeLensCommandId) title (Just [toJSON wEdit]) -- Since the lenses are created with diagnostics, and since the globalTypeSig