diff --git a/GenChangelogs.hs b/GenChangelogs.hs index 20fc0c92d5..908d2998eb 100755 --- a/GenChangelogs.hs +++ b/GenChangelogs.hs @@ -33,4 +33,4 @@ main = do forM_ prsAfterLastTag $ \SimplePullRequest{..} -> putStrLn $ T.unpack $ "- " <> simplePullRequestTitle <> "\n([#" <> T.pack (show $ unIssueNumber simplePullRequestNumber) <> ")](" <> getUrl simplePullRequestHtmlUrl <> ")" <> - " by @" <> (untagName (simpleUserLogin simplePullRequestUser)) + " by @" <> untagName (simpleUserLogin simplePullRequestUser) diff --git a/exe/Main.hs b/exe/Main.hs index bac9b40924..d77c515f37 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -16,7 +16,7 @@ main = withUtf8 $ do let withExamples = case args of - LspMode (LspArguments{..}) -> argsExamplePlugin - _ -> False + LspMode LspArguments{..} -> argsExamplePlugin + _ -> False defaultMain args (idePlugins withExamples) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 8a0c452be1..2c72f20266 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -73,7 +73,7 @@ launchHaskellLanguageServer LspArguments{..} = do hPutStrLn stderr $ showProgramVersionOfInterest programsOfInterest hPutStrLn stderr "" -- Get the ghc version -- this might fail! - hPutStrLn stderr $ "Consulting the cradle to get project GHC version..." + hPutStrLn stderr "Consulting the cradle to get project GHC version..." ghcVersion <- getRuntimeGhcVersion' cradle hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion @@ -136,7 +136,7 @@ getRuntimeGhcVersion' cradle = do -- of the project that may or may not be accurate. findLocalCradle :: FilePath -> IO (Cradle Void) findLocalCradle fp = do - cradleConf <- (findCradle defaultLoadingOptions) fp + cradleConf <- findCradle defaultLoadingOptions fp crdl <- case cradleConf of Just yaml -> do hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\"" @@ -144,4 +144,3 @@ findLocalCradle fp = do Nothing -> loadImplicitCradle fp hPutStrLn stderr $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl return crdl - diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index bcecdc3dbb..7c4d446572 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -168,7 +168,7 @@ checkDiagnosticsForDoc :: TextDocumentIdentifier -> [(DiagnosticSeverity, Cursor checkDiagnosticsForDoc TextDocumentIdentifier {_uri} expected obtained = do let expected' = Map.fromList [(nuri, map (\(ds, c, t) -> (ds, c, t, Nothing)) expected)] nuri = toNormalizedUri _uri - expectDiagnosticsWithTags' (return $ (_uri, List obtained)) expected' + expectDiagnosticsWithTags' (return (_uri, List obtained)) expected' canonicalizeUri :: Uri -> IO Uri canonicalizeUri uri = filePathToUri <$> canonicalizePath (fromJust (uriToFilePath uri)) diff --git a/hie-compat/src-ghc86/Compat/HieBin.hs b/hie-compat/src-ghc86/Compat/HieBin.hs index 94e9ad3e50..b02fe63b2e 100644 --- a/hie-compat/src-ghc86/Compat/HieBin.hs +++ b/hie-compat/src-ghc86/Compat/HieBin.hs @@ -97,7 +97,7 @@ writeHieFile hie_file_path hiefile = do -- hieVersion and the GHC version used to generate this file mapM_ (putByte bh0) hieMagic putBinLine bh0 $ BSC.pack $ show hieVersion - putBinLine bh0 $ ghcVersion + putBinLine bh0 ghcVersion -- remember where the dictionary pointer will go dict_p_p <- tellBin bh0 @@ -297,7 +297,7 @@ getSymbolTable bh ncu = do getSymTabName :: SymbolTable -> BinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh - return $ st A.! (fromIntegral i) + return $ st A.! fromIntegral i putName :: HieSymbolTable -> BinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do diff --git a/hie-compat/src-ghc86/Compat/HieDebug.hs b/hie-compat/src-ghc86/Compat/HieDebug.hs index 76a4384466..06a2cd0924 100644 --- a/hie-compat/src-ghc86/Compat/HieDebug.hs +++ b/hie-compat/src-ghc86/Compat/HieDebug.hs @@ -1,7 +1,6 @@ {- Functions to validate and check .hie file ASTs generated by GHC. -} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module Compat.HieDebug where @@ -22,10 +21,10 @@ import Data.Function ( on ) import Data.List ( sortOn ) import Data.Foldable ( toList ) -ppHies :: Outputable a => (HieASTs a) -> SDoc +ppHies :: Outputable a => HieASTs a -> SDoc ppHies (HieASTs asts) = M.foldrWithKey go "" asts where - go k a rest = vcat $ + go k a rest = vcat [ "File: " <> ppr k , ppHie a , rest @@ -112,9 +111,9 @@ validAst (Node _ span children) = do ] checkContainment [] = return () checkContainment (x:xs) - | span `containsSpan` (nodeSpan x) = checkContainment xs + | span `containsSpan` nodeSpan x = checkContainment xs | otherwise = Left $ hsep - [ ppr $ span + [ ppr span , "does not contain" , ppr $ nodeSpan x ] @@ -139,7 +138,7 @@ validateScopes asts = M.foldrWithKey (\k a b -> valid k a ++ b) [] refMap [] -> [] _ -> if any (`scopeContainsSpan` sp) scopes then [] - else return $ hsep $ + else return $ hsep [ "Name", ppr n, "at position", ppr sp , "doesn't occur in calculated scope", ppr scopes] | otherwise = [] diff --git a/hie-compat/src-ghc86/Compat/HieTypes.hs b/hie-compat/src-ghc86/Compat/HieTypes.hs index cdf52adf40..b9dfa1ccb1 100644 --- a/hie-compat/src-ghc86/Compat/HieTypes.hs +++ b/hie-compat/src-ghc86/Compat/HieTypes.hs @@ -5,7 +5,6 @@ For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files -} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -168,7 +167,7 @@ data HieType a type HieTypeFlat = HieType TypeIndex -- | Roughly isomorphic to the original core 'Type'. -newtype HieTypeFix = Roll (HieType (HieTypeFix)) +newtype HieTypeFix = Roll (HieType HieTypeFix) instance Binary (HieType TypeIndex) where put_ bh (HTyVarTy n) = do @@ -200,7 +199,7 @@ instance Binary (HieType TypeIndex) where put_ bh (HCastTy a) = do putByte bh 7 put_ bh a - put_ bh (HCoercionTy) = putByte bh 8 + put_ bh HCoercionTy = putByte bh 8 get bh = do (t :: Word8) <- get bh @@ -228,7 +227,7 @@ instance Binary (HieArgs TypeIndex) where -- | Mapping from filepaths (represented using 'FastString') to the -- corresponding AST -newtype HieASTs a = HieASTs { getAsts :: (M.Map FastString (HieAST a)) } +newtype HieASTs a = HieASTs { getAsts :: M.Map FastString (HieAST a) } deriving (Functor, Foldable, Traversable) instance Binary (HieASTs TypeIndex) where @@ -276,9 +275,9 @@ instance Binary (NodeInfo TypeIndex) where put_ bh $ nodeType ni put_ bh $ M.toList $ nodeIdentifiers ni get bh = NodeInfo - <$> fmap (S.fromDistinctAscList) (get bh) + <$> fmap S.fromDistinctAscList (get bh) <*> get bh - <*> fmap (M.fromList) (get bh) + <*> fmap M.fromList (get bh) type Identifier = Either ModuleName Name @@ -309,7 +308,7 @@ instance Binary (IdentifierDetails TypeIndex) where put_ bh $ S.toAscList $ identInfo dets get bh = IdentifierDetails <$> get bh - <*> fmap (S.fromDistinctAscList) (get bh) + <*> fmap S.fromDistinctAscList (get bh) -- | Different contexts under which identifiers exist @@ -419,7 +418,7 @@ data IEType instance Binary IEType where put_ bh b = putByte bh (fromIntegral (fromEnum b)) - get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x)) + get bh = do x <- getByte bh; pure $! toEnum (fromIntegral x) data RecFieldContext @@ -431,7 +430,7 @@ data RecFieldContext instance Binary RecFieldContext where put_ bh b = putByte bh (fromIntegral (fromEnum b)) - get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x)) + get bh = do x <- getByte bh; pure $! toEnum (fromIntegral x) data BindType @@ -441,7 +440,7 @@ data BindType instance Binary BindType where put_ bh b = putByte bh (fromIntegral (fromEnum b)) - get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x)) + get bh = do x <- getByte bh; pure $! toEnum (fromIntegral x) data DeclType @@ -456,7 +455,7 @@ data DeclType instance Binary DeclType where put_ bh b = putByte bh (fromIntegral (fromEnum b)) - get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x)) + get bh = do x <- getByte bh; pure $! toEnum (fromIntegral x) data Scope diff --git a/hie-compat/src-ghc86/Compat/HieUtils.hs b/hie-compat/src-ghc86/Compat/HieUtils.hs index 519a8f50e5..367e0adf2e 100644 --- a/hie-compat/src-ghc86/Compat/HieUtils.hs +++ b/hie-compat/src-ghc86/Compat/HieUtils.hs @@ -62,11 +62,11 @@ resolveVisibility kind ty_args ts' = go (extendTvSubst env tv t) res ts go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps - = (True,t) : (go env res ts) + = (True,t) : go env res ts go env (TyVarTy tv) ts | Just ki <- lookupTyVar env tv = go env ki ts - go env kind (t:ts) = (True, t) : (go env kind ts) -- Ill-kinded + go env kind (t:ts) = (True, t) : go env kind ts -- Ill-kinded foldType :: (HieType a -> a) -> HieTypeFix -> a foldType f (Roll t) = f $ fmap (foldType f) t @@ -114,7 +114,7 @@ compressTypes -> (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat) compressTypes asts = (a, arr) where - (a, (HTS _ m i)) = flip runState initialHTS $ + (a, HTS _ m i) = flip runState initialHTS $ for asts $ \typ -> do i <- getTypeIndex typ return i diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 76b94189de..ed083fcf60 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Ide.Types diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index eec70edb96..81a648ee28 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -46,7 +46,7 @@ getGhcPathOfOrThrowError versionNumber = cabalInstallHls :: VersionNumber -> [String] -> Action () cabalInstallHls versionNumber args = do - localBin <- liftIO $ getInstallDir + localBin <- liftIO getInstallDir cabalVersion <- getCabalVersion args ghcPath <- getGhcPathOfOrThrowError versionNumber diff --git a/install/src/HlsInstall.hs b/install/src/HlsInstall.hs index f9b961860b..8f63235a27 100644 --- a/install/src/HlsInstall.hs +++ b/install/src/HlsInstall.hs @@ -38,7 +38,7 @@ defaultMain = do let args = [verbosityArg (shakeVerbosity shakeOptionsRules)] phony "show-options" $ do - putNormal $ "Options:" + putNormal "Options:" putNormal $ " Verbosity level: " ++ show (shakeVerbosity shakeOptionsRules) want ["short-help"] @@ -51,7 +51,7 @@ defaultMain = do phony "data" $ do need ["show-options"] need ["check"] - liftIO $ putStrLn "Generation of hoogle data files is disabled for now." + liftIO $ putStrLn "Generation of hoogle data files is disabled for now." -- if isRunFromStack then stackBuildData args else cabalBuildData args forM_ @@ -90,7 +90,7 @@ defaultMain = do need ["icu-macos-fix-build"] phony "icu-macos-fix-install" (command_ [] "brew" ["install", "icu4c"]) - phony "icu-macos-fix-build" $ mapM_ (flip buildIcuMacosFix $ args) versions + phony "icu-macos-fix-build" $ mapM_ (flip buildIcuMacosFix args) versions buildIcuMacosFix :: VersionNumber -> [String] -> Action () diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 71d982472a..3b2dc7555e 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -128,7 +128,7 @@ codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier u -- edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing range = Range (Position 3 0) (Position 4 0) let cmdParams = AddTodoParams uri "do abc" - cmd <- mkLspCommand plId "codelens.todo" title (Just [(toJSON cmdParams)]) + cmd <- mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams]) pure $ Right $ List [ CodeLens range (Just cmd) Nothing ] Nothing -> pure $ Right $ List [] diff --git a/plugins/default/src/Ide/Plugin/Floskell.hs b/plugins/default/src/Ide/Plugin/Floskell.hs index 3c8aa8e590..24837400c6 100644 --- a/plugins/default/src/Ide/Plugin/Floskell.hs +++ b/plugins/default/src/Ide/Plugin/Floskell.hs @@ -1,8 +1,5 @@ -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Floskell ( diff --git a/plugins/default/src/Ide/Plugin/Fourmolu.hs b/plugins/default/src/Ide/Plugin/Fourmolu.hs index e82b1b1fad..38ed809575 100644 --- a/plugins/default/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/default/src/Ide/Plugin/Fourmolu.hs @@ -1,7 +1,7 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} module Ide.Plugin.Fourmolu ( diff --git a/plugins/default/src/Ide/Plugin/Ormolu.hs b/plugins/default/src/Ide/Plugin/Ormolu.hs index 32fbef3946..f70175c385 100644 --- a/plugins/default/src/Ide/Plugin/Ormolu.hs +++ b/plugins/default/src/Ide/Plugin/Ormolu.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 6c50bc05c7..5194a89a77 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -4,7 +4,6 @@ {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs index aea08f01df..ad75bb4c39 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs @@ -30,4 +30,4 @@ langOptions = runParser (many space *> languageOpts <* many space) -- >>> runParser languageOpts ":set -XBinaryLiterals -XOverloadedStrings" -- Right ["BinaryLiterals","OverloadedStrings"] languageOpts :: Parser Char [[Char]] -languageOpts = string ":set" *> many (many space *> string "-X" *> (many letterChar)) +languageOpts = string ":set" *> many (many space *> string "-X" *> many letterChar) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index e44a86e242..5acb4a11f8 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index d52ef9c2ef..4bc87b47d2 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -3,13 +3,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} #include "ghc-api-version.h" @@ -189,10 +187,10 @@ minimalImportsRule = define $ \MinimalImports nfp -> do -- | Use the ghc api to extract a minimal, explicit set of imports for this module extractMinimalImports :: - Maybe (HscEnvEq) -> - Maybe (TcModuleResult) -> + Maybe HscEnvEq -> + Maybe TcModuleResult -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]) -extractMinimalImports (Just (hsc)) (Just (TcModuleResult {..})) = do +extractMinimalImports (Just hsc) (Just TcModuleResult {..}) = do -- extract the original imports and the typechecking environment let tcEnv = tmrTypechecked (_, imports, _, _) = tmrRenamed diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 3e63501980..a4448b3825 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -7,10 +7,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Hlint ( diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 6dcbc0b1ab..a4e163ee10 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -8,7 +8,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -121,7 +120,7 @@ runRetrieCmd lsp state RunRetrieParams{originatingFile = uri, ..} = nfp <- MaybeT $ return $ uriToNormalizedFilePath $ toNormalizedUri uri (session, _) <- MaybeT $ runAction "Retrie.GhcSessionDeps" state $ - useWithStale GhcSessionDeps $ + useWithStale GhcSessionDeps nfp (ms, binds, _, _, _) <- MaybeT $ runAction "Retrie.getBinds" state $ getBinds nfp let importRewrites = concatMap (extractImports ms binds) rewrites @@ -227,7 +226,7 @@ suggestBindRewrites :: GHC.Module -> HsBindLR GhcRn GhcRn -> [(T.Text, CodeActionKind, RunRetrieParams)] -suggestBindRewrites originatingFile pos ms_mod (FunBind {fun_id = L l' rdrName}) +suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L l' rdrName} | pos `isInsideSrcSpan` l' = let pprName = prettyPrint rdrName pprNameText = T.pack pprName @@ -253,7 +252,7 @@ suggestTypeRewrites :: GHC.Module -> TyClDecl pass -> [(T.Text, CodeActionKind, RunRetrieParams)] -suggestTypeRewrites originatingFile ms_mod (SynDecl {tcdLName = L _ rdrName}) = +suggestTypeRewrites originatingFile ms_mod SynDecl {tcdLName = L _ rdrName} = let pprName = prettyPrint rdrName pprNameText = T.pack pprName unfoldRewrite restrictToOriginatingFile = @@ -273,7 +272,7 @@ suggestRuleRewrites :: GHC.Module -> LRuleDecls pass -> [(T.Text, CodeActionKind, RunRetrieParams)] -suggestRuleRewrites originatingFile pos ms_mod (L _ (HsRules {rds_rules})) = +suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) = concat [ [ forwardRewrite ruleName True , forwardRewrite ruleName False diff --git a/plugins/tactics/src/Ide/Plugin/Tactic.hs b/plugins/tactics/src/Ide/Plugin/Tactic.hs index 56be9158ca..bbb0f3afd2 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic.hs @@ -3,10 +3,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -- | A plugin that uses tactics to synthesize code @@ -365,4 +363,3 @@ getRhsPosVals rss tcs -- TODO(sandy): Make this more robust isHole :: OccName -> Bool isHole = isPrefixOf "_" . occNameString - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs b/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs index 3a3785971c..0c1633d379 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs @@ -178,7 +178,7 @@ destructLambdaCase' f jdg = do let g = jGoal jdg case splitFunTy_maybe (unCType g) of Just (arg, _) | isAlgType arg -> - fmap (fmap noLoc $ lambdaCase) <$> + fmap (fmap noLoc lambdaCase) <$> destructMatches f Nothing (CType arg) jdg _ -> throwError $ GoalMismatch "destructLambdaCase'" g @@ -214,7 +214,7 @@ mkCon dcon (fmap unLoc -> args) , (lhs : rhs : args') <- args = noLoc $ foldl' (@@) (op lhs (coerceName dcon_name) rhs) args' | otherwise = - noLoc $ foldl' (@@) (bvar' $ occName $ dcon_name) args + noLoc $ foldl' (@@) (bvar' $ occName dcon_name) args where dcon_name = dataConName dcon @@ -259,4 +259,3 @@ infixCall s = flip op (fromString s) -- | Like '(@@)', but uses a dollar instead of parentheses. appDollar :: HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs appDollar = infixCall "$" - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs index 8522e0ddc4..15150c938e 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs @@ -89,8 +89,7 @@ getFunBindId _ = [] getCurrentDefinitions :: MonadReader Context m => m [(OccName, CType)] -getCurrentDefinitions = asks $ ctxDefiningFuncs +getCurrentDefinitions = asks ctxDefiningFuncs getModuleHypothesis :: MonadReader Context m => m [(OccName, CType)] getModuleHypothesis = asks ctxModuleFuncs - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs b/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs index 3285479a49..5cba1d20b6 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs @@ -78,7 +78,7 @@ freshTyvars t = do reps <- fmap M.fromList $ for tvs $ \tv -> do uniq <- freshUnique - pure $ (tv, setTyVarUnique tv uniq) + pure (tv, setTyVarUnique tv uniq) pure $ everywhere (mkT $ \tv -> @@ -153,4 +153,4 @@ dataConExTys :: DataCon -> [TyCoVar] dataConExTys = DataCon.dataConExTyCoVars #else dataConExTys = DataCon.dataConExTyVars -#endif \ No newline at end of file +#endif diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs index 7a024f85fb..75321a170c 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs @@ -1,7 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} @@ -377,4 +374,3 @@ isDisallowed _ = False expandDisallowed :: Provenance -> Provenance expandDisallowed (DisallowedPrv _ prv) = expandDisallowed prv expandDisallowed prv = prv - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs b/plugins/tactics/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs index c29c1d58d8..7c595a0b57 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs @@ -1,5 +1,4 @@ {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE LambdaCase #-} module Ide.Plugin.Tactic.KnownStrategies.QuickCheck where @@ -109,4 +108,3 @@ mkArbitraryCall recursive_tc n ty = (n == 1) @@ arbitrary False -> arbitrary - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs index 22ef2b6b5e..559d983e31 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs @@ -1,7 +1,4 @@ {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -9,8 +6,6 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -92,7 +87,7 @@ runTactic ctx jdg t = . flip runReader ctx . unExtractM $ runTacticT t jdg tacticState of - (errs, []) -> Left $ take 50 $ errs + (errs, []) -> Left $ take 50 errs (_, fmap assoc23 -> solns) -> do let sorted = flip sortBy solns $ comparing $ \((_, ext), (jdg, holes)) -> @@ -174,7 +169,7 @@ scoreSolution ext TacticState{..} holes , Penalize $ S.size ts_unused_top_vals , Penalize $ S.size ts_intro_vals , Reward $ S.size ts_used_vals - , Penalize $ ts_recursion_count + , Penalize ts_recursion_count , Penalize $ solutionSize ext ) @@ -251,4 +246,3 @@ requireConcreteHole m = do case S.size $ vars S.\\ skolems of 0 -> m _ -> throwError TooPolymorphic - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Naming.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Naming.hs index 5426701106..f6b054f987 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Naming.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Naming.hs @@ -22,7 +22,7 @@ mkTyName :: Type -> String mkTyName (tcSplitFunTys -> ([a@(isFunTy -> False)], b)) = "f" ++ mkTyName a ++ mkTyName b -- eg. mkTyName (a -> b -> C) = "f_C" -mkTyName (tcSplitFunTys -> ((_:_), b)) +mkTyName (tcSplitFunTys -> (_:_, b)) = "f_" ++ mkTyName b -- eg. mkTyName (Either A B) = "eab" mkTyName (splitTyConApp_maybe -> Just (c, args)) @@ -31,7 +31,7 @@ mkTyName (splitTyConApp_maybe -> Just (c, args)) mkTyName (getTyVar_maybe -> Just tv) = occNameString $ occName tv -- eg. mkTyName (forall x. y) = "y" -mkTyName (tcSplitSigmaTy -> ((_:_), _, t)) +mkTyName (tcSplitSigmaTy -> (_:_, _, t)) = mkTyName t mkTyName _ = "x" @@ -90,4 +90,3 @@ mkManyGoodNames hy args = -- | Which names are in scope? getInScope :: Map OccName a -> [OccName] getInScope = M.keys - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs index 804fb4d7ff..60b318c8cc 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs @@ -1,12 +1,8 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Tactic.Tactics @@ -284,4 +280,3 @@ overAlgebraicTerms = allNames :: Judgement -> [OccName] allNames = M.keys . jHypothesis - diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs index 9d08934e94..c9d1bdd514 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs @@ -4,11 +4,9 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Ide.Plugin.Tactic.Types @@ -77,7 +75,7 @@ instance Show Class where data TacticState = TacticState { ts_skolems :: !(Set TyVar) -- ^ The known skolems. - , ts_unifier :: !(TCvSubst) + , ts_unifier :: !TCvSubst -- ^ The current substitution of univars. , ts_used_vals :: !(Set OccName) -- ^ Set of values used by tactics. @@ -236,10 +234,10 @@ overProvenance f (HyInfo prv ty) = HyInfo (f prv) ty -- | The current bindings and goal for a hole to be filled by refinery. data Judgement' a = Judgement { _jHypothesis :: !(Map OccName (HyInfo a)) - , _jBlacklistDestruct :: !(Bool) - , _jWhitelistSplit :: !(Bool) + , _jBlacklistDestruct :: !Bool + , _jWhitelistSplit :: !Bool , _jIsTopHole :: !Bool - , _jGoal :: !(a) + , _jGoal :: !a } deriving stock (Eq, Generic, Functor, Show) @@ -364,4 +362,3 @@ data RunTacticResults = RunTacticResults , rtr_extract :: LHsExpr GhcPs , rtr_other_solns :: [(Trace, LHsExpr GhcPs)] } deriving Show - diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index 3516ecf837..e3310bf2c5 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -1,11 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE CPP #-} -- To get precise GHC version -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs index 9617284f09..cc7aac19e2 100644 --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -49,7 +49,7 @@ showProgramVersionOfInterest ProgramsOfInterest {..} = ] where showVersionWithDefault :: Maybe Version -> String - showVersionWithDefault = maybe ("Not found") showVersion + showVersionWithDefault = maybe "Not found" showVersion findProgramVersions :: IO ProgramsOfInterest findProgramVersions = ProgramsOfInterest @@ -67,7 +67,7 @@ findVersionOf tool = Just path -> readProcessWithExitCode path ["--numeric-version"] "" >>= \case (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout - _ -> pure $ Nothing + _ -> pure Nothing where myVersionParser = do skipSpaces diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 527aca5447..a07988f12e 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -298,7 +298,7 @@ snippetTests = testGroup "snippets" [ , testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" - let config = object [ "haskell" .= (object ["completionSnippetsOn" .= False])] + let config = object [ "haskell" .= object ["completionSnippetsOn" .= False]] sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams config) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 4148ccc0f2..5054159396 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -370,7 +370,7 @@ redundantImportTests = testGroup "redundant import code actions" [ CACommand cmd : _ <- getAllCodeActions doc executeCommand cmd contents <- documentContents doc - liftIO $ (T.lines contents) @?= + liftIO $ T.lines contents @?= [ "{-# OPTIONS_GHC -Wunused-imports #-}" , "module MultipleImports where" , "import Data.Maybe" @@ -435,7 +435,7 @@ signatureTests = testGroup "missing top level signature code actions" [ _ <- waitForDiagnosticsFromSource doc "typecheck" cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "add signature: main :: IO ()" `elem` (map (^. L.title) cas) @? "Contains code action" + liftIO $ "add signature: main :: IO ()" `elem` map (^. L.title) cas @? "Contains code action" executeCodeAction $ head cas @@ -449,7 +449,7 @@ signatureTests = testGroup "missing top level signature code actions" [ , " return ()" ] - liftIO $ (T.lines contents) @?= expected + liftIO $ T.lines contents @?= expected ] missingPragmaTests :: TestTree @@ -487,7 +487,7 @@ missingPragmaTests = testGroup "missing pragma warning code actions" [ , " deriving (Generic,Functor,Traversable)" ] - liftIO $ (T.lines contents) @?= expected + liftIO $ T.lines contents @?= expected , testCase "Adds TypeApplications pragma" $ do runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do @@ -511,7 +511,7 @@ missingPragmaTests = testGroup "missing pragma warning code actions" [ , "foo = id @a" ] - liftIO $ (T.lines contents) @?= expected + liftIO $ T.lines contents @?= expected ] unusedTermTests :: TestTree diff --git a/test/functional/HaddockComments.hs b/test/functional/HaddockComments.hs index 3aa36e514f..c4af8af296 100644 --- a/test/functional/HaddockComments.hs +++ b/test/functional/HaddockComments.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module HaddockComments diff --git a/test/functional/ModuleName.hs b/test/functional/ModuleName.hs index 512d4a546f..67f8e9425a 100644 --- a/test/functional/ModuleName.hs +++ b/test/functional/ModuleName.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/test/functional/Tactic.hs b/test/functional/Tactic.hs index 0850fc741e..5a3bbed4d6 100644 --- a/test/functional/Tactic.hs +++ b/test/functional/Tactic.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -154,7 +153,7 @@ goldenTest input line col tc occ = doc <- openDoc input "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col - Just (CACodeAction (CodeAction {_command = Just c})) + Just (CACodeAction CodeAction {_command = Just c}) <- pure $ find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions executeCommand c _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message @@ -174,7 +173,7 @@ expectFail input line col tc occ = doc <- openDoc input "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col - Just (CACodeAction (CodeAction {_command = Just c})) + Just (CACodeAction CodeAction {_command = Just c}) <- pure $ find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions resp <- executeCommandWithResp c liftIO $ unless (isLeft $ _result resp) $ @@ -190,4 +189,3 @@ executeCommandWithResp cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments execParams = ExecuteCommandParams (cmd ^. command) args Nothing request WorkspaceExecuteCommand execParams -