From 00fd613ecb99cf53a9a759d3bd80c26d0da50541 Mon Sep 17 00:00:00 2001 From: Peter Wicks Stringfield Date: Thu, 18 Feb 2021 18:20:26 -0600 Subject: [PATCH] Hlint hints. --- GenChangelogs.hs | 2 +- ghcide/.hlint.yaml | 18 +++++++++++++-- .../session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 2 -- ghcide/src/Development/IDE/Spans/AtPoint.hs | 6 ++--- hls-plugin-api/src/Ide/PluginUtils.hs | 4 ++-- hls-plugin-api/src/Ide/Types.hs | 1 - install/src/Cabal.hs | 2 +- install/src/Env.hs | 2 +- install/src/Print.hs | 2 +- plugins/default/src/Ide/Plugin/Fourmolu.hs | 2 +- plugins/default/src/Ide/Plugin/Ormolu.hs | 2 +- plugins/default/src/Ide/Plugin/Pragmas.hs | 5 ++--- .../src/Ide/Plugin/Eval/CodeLens.hs | 2 -- .../src/Ide/Plugin/Eval/Util.hs | 3 ++- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 2 +- .../src/Ide/Plugin/Retrie.hs | 22 +++++++++---------- .../hls-splice-plugin/hls-splice-plugin.cabal | 1 + .../src/Ide/Plugin/Splice.hs | 9 ++++---- src/Ide/Main.hs | 3 --- test/functional/Progress.hs | 5 ++--- test/functional/Reference.hs | 2 +- test/functional/Tactic.hs | 2 +- test/utils/Test/Hls/Util.hs | 1 + test/wrapper/Main.hs | 10 +++------ 25 files changed, 57 insertions(+), 55 deletions(-) diff --git a/GenChangelogs.hs b/GenChangelogs.hs index f992ab2dcc..0e4a1384dc 100755 --- a/GenChangelogs.hs +++ b/GenChangelogs.hs @@ -24,7 +24,7 @@ main = do prs <- github' $ pullRequestsForR "haskell" "haskell-language-server" stateClosed FetchAll let prsAfterLastTag = either (error . show) - (foldMap (\pr -> if inRange pr then [pr] else [])) + (foldMap (\pr -> [pr | inRange pr])) prs inRange pr | Just mergedDate <- simplePullRequestMergedAt pr = mergedDate > lastDate diff --git a/ghcide/.hlint.yaml b/ghcide/.hlint.yaml index 2e3099223b..2406c24949 100644 --- a/ghcide/.hlint.yaml +++ b/ghcide/.hlint.yaml @@ -11,7 +11,6 @@ - ignore: {name: "Redundant do"} - ignore: {name: "Avoid lambda"} - ignore: {name: "Use newtype instead of data"} -- ignore: {name: "Use fromMaybe"} - ignore: {name: "Use unless"} - ignore: {name: "Move brackets to avoid $"} - ignore: {name: "Eta reduce"} @@ -25,6 +24,21 @@ - ignore: {name: "Use uncurry"} - ignore: {name: "Avoid lambda using `infix`"} +# Gives at least one suggestion we don't like. +- ignore: {name: "Use <=<"} +- ignore: {name: "Use zipFrom"} +- ignore: {name: "Use zipWithFrom"} + +# We are using the "redundant" return/pure to assign a name. We do not want to +# delete it. In particular, this is not an improvement: +# Found: +# do options <- somethingComplicated +# pure options +# Perhaps: +# do somethingComplicated +- ignore: {name: "Redundant return"} +- ignore: {name: "Redundant pure"} + # Off by default hints we like - warn: {name: Use module export list} @@ -107,7 +121,7 @@ # Things that are unsafe in Haskell base library - {name: unsafeInterleaveIO, within: [Development.IDE.LSP.LanguageServer]} - {name: unsafeDupablePerformIO, within: []} - - {name: unsafeCoerce, within: []} + - {name: unsafeCoerce, within: [Ide.Plugin.Eval.Code]} # Things that are a bit dangerous in the GHC API - {name: nameModule, within: []} diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 2232ac3faa..1c5a07f0a4 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -123,7 +123,7 @@ getInitialGhcLibDirDefault = do hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show (err,dir,hieYaml,cradle) pure Nothing CradleNone -> do - hPutStrLn stderr $ "Couldn't load cradle (CradleNone)" + hPutStrLn stderr "Couldn't load cradle (CradleNone)" pure Nothing -- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 4e038aced3..c571b91248 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -5,8 +5,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -{- HLINT ignore "Use zipFrom" -} - module Development.IDE.GHC.ExactPrint ( Graft(..), graft, diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 8007e839a7..243959e97a 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -158,7 +158,7 @@ documentHighlight hf rf pos = pure highlights ns = concat $ pointCommand hf pos (rights . M.keys . nodeIdentifiers . nodeInfo) highlights = do n <- ns - ref <- maybe [] id (M.lookup (Right n) rf) + ref <- fromMaybe [] (M.lookup (Right n) rf) pure $ makeHighlight ref makeHighlight (sp,dets) = DocumentHighlight (realSrcSpanToRange sp) (Just $ highlightType $ identInfo dets) @@ -266,12 +266,12 @@ typeLocationsAtPoint hiedb lookupModule _ideOptions pos (HAR _ ast _ _ hieKind) HQualTy a b -> getTypes [a,b] HCastTy a -> getTypes [a] _ -> [] - in fmap nubOrd $ concatMapM (fmap (maybe [] id) . nameToLocation hiedb lookupModule) (getTypes ts) + in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation hiedb lookupModule) (getTypes ts) HieFresh -> let ts = concat $ pointCommand ast pos getts getts x = nodeType ni ++ (mapMaybe identType $ M.elems $ nodeIdentifiers ni) where ni = nodeInfo x - in fmap nubOrd $ concatMapM (fmap (maybe [] id) . nameToLocation hiedb lookupModule) (getTypes ts) + in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation hiedb lookupModule) (getTypes ts) namesInType :: Type -> [Name] namesInType (TyVarTy n) = [Var.varName n] diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 92da82629b..00ff4fd550 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -135,7 +135,7 @@ clientSupportsDocumentChanges caps = WorkspaceEditClientCapabilities mDc _ _ <- _workspaceEdit wCaps mDc in - fromMaybe False supports + Just True == supports -- --------------------------------------------------------------------- @@ -214,7 +214,7 @@ allLspCmdIds' pid mp = mkPlugin (allLspCmdIds pid) (Just . pluginCommands) allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text] -allLspCmdIds pid commands = concat $ map go commands +allLspCmdIds pid commands = concatMap go commands where go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index f99ab309c0..5f67c5b6a4 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 81a648ee28..0a4733daff 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -96,7 +96,7 @@ getProjectFile ver = do else "cabal.project" checkCabal_ :: [String] -> Action () -checkCabal_ args = checkCabal args >> return () +checkCabal_ args = void $ checkCabal args -- | check `cabal` has the required version checkCabal :: [String] -> Action String diff --git a/install/src/Env.hs b/install/src/Env.hs index 6388338639..397b9108f6 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -54,7 +54,7 @@ findInstalledGhcs = do -- sort by version to make it coherent with getHlsVersions $ sortBy (comparing fst) -- nub by version. knownGhcs takes precedence. - $ nubBy ((==) `on` fst) + $ nubOrdBy (compare `on` fst) -- filter out stack provided GHCs (assuming that stack programs path is the default one in linux) $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs) diff --git a/install/src/Print.hs b/install/src/Print.hs index 063525e7ec..b4937f4a32 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -25,7 +25,7 @@ printInStars = liftIO . putStrLn . embedInStars -- | Trim whitespace of both ends of a string trim :: String -> String -trim = dropWhileEnd isSpace . dropWhile isSpace +trim = trimEnd . trimStart -- | Trim the whitespace of the stdout of a command trimmedStdout :: Stdout String -> String diff --git a/plugins/default/src/Ide/Plugin/Fourmolu.hs b/plugins/default/src/Ide/Plugin/Fourmolu.hs index 95c0943f4c..002fdc0848 100644 --- a/plugins/default/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/default/src/Ide/Plugin/Fourmolu.hs @@ -93,7 +93,7 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable convertDynFlags :: DynFlags -> IO [DynOption] convertDynFlags df = - let pp = if null p then [] else ["-pgmF=" <> p] + let pp = ["-pgmF=" <> p | not (null p)] p = D.sPgm_F $ D.settings df pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df ex = map showExtension $ S.toList $ D.extensionFlags df diff --git a/plugins/default/src/Ide/Plugin/Ormolu.hs b/plugins/default/src/Ide/Plugin/Ormolu.hs index bafee34f50..1a1cee45bc 100644 --- a/plugins/default/src/Ide/Plugin/Ormolu.hs +++ b/plugins/default/src/Ide/Plugin/Ormolu.hs @@ -44,7 +44,7 @@ provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $ let pp = let p = D.sPgm_F $ D.settings df - in if null p then [] else ["-pgmF=" <> p] + in ["-pgmF=" <> p | not (null p)] pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df ex = map showExtension $ S.toList $ D.extensionFlags df in diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index f1a3fc4926..bef200645a 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -12,6 +10,7 @@ module Ide.Plugin.Pragmas import Control.Lens hiding (List) import qualified Data.HashMap.Strict as H +import Data.Maybe (catMaybes) import qualified Data.Text as T import Development.IDE as D import Ide.Types @@ -78,7 +77,7 @@ codeActionProvider state _plId (CodeActionParams _ _ docId _ (J.CodeActionContex disabled | Just dynFlags <- mDynflags -- GHC does not export 'OnOff', so we have to view it as string - = [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags] + = catMaybes $ T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags | otherwise -- When the module failed to parse, we don't have access to its -- dynFlags. In that case, simply don't disable any pragmas. 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 2b31039fb7..381b7b387e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -1,8 +1,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE FlexibleContexts #-} 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 1f573a58ac..8406975c3e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -15,6 +15,7 @@ module Ide.Plugin.Eval.Util ( logWith, ) where +import Control.Monad.Extra (maybeM) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except ( @@ -84,7 +85,7 @@ handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b handleMaybe msg = maybe (throwE msg) return handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b -handleMaybeM msg act = maybe (throwE msg) return =<< lift act +handleMaybeM msg act = maybeM (throwE msg) return $ lift act response :: Functor f => ExceptT String f c -> f (Either ResponseError c) response = diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index e3027b1c24..63290406da 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -278,7 +278,7 @@ codeActionProvider ideState plId (CodeActionParams _ _ docId _ context) = Right in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd) applyOneActions :: [LSP.CodeAction] - applyOneActions = catMaybes $ map mkHlintAction (filter validCommand diags) + applyOneActions = mapMaybe mkHlintAction (filter validCommand diags) -- |Some hints do not have an associated refactoring validCommand (LSP.Diagnostic _ _ (Just (InR code)) (Just "hlint") _ _ _) = diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index f6ee55f4fe..f7b7403291 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -20,6 +20,7 @@ import Control.Concurrent.Extra (readVar) import Control.Exception.Safe (Exception (..), SomeException, catch, throwIO, try) import Control.Monad (forM, unless) +import Control.Monad.Extra (maybeM) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT, @@ -146,14 +147,14 @@ extractImports ModSummary{ms_mod} topLevelBinds (Unfold thing) , names <- listify p fun_matches = [ AddImport {..} - | name <- names, - Just ideclNameString <- - [moduleNameString . GHC.moduleName <$> nameModule_maybe name], - let ideclSource = False, + | let ideclSource = False, + name <- names, let r = nameRdrName name, let ideclQualifiedBool = isQual r, let ideclAsString = moduleNameString . fst <$> isQual_maybe r, - let ideclThing = Just (IEVar $ occNameString $ rdrNameOcc r) + let ideclThing = Just (IEVar $ occNameString $ rdrNameOcc r), + Just ideclNameString <- + [moduleNameString . GHC.moduleName <$> nameModule_maybe name] ] where p name = nameModule_maybe name /= Just ms_mod @@ -178,8 +179,8 @@ provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca) ++ [ r | TyClGroup {group_tyclds} <- hs_tyclds, L l g <- group_tyclds, - r <- suggestTypeRewrites uri ms_mod g, - pos `isInsideSrcSpan` l + pos `isInsideSrcSpan` l, + r <- suggestTypeRewrites uri ms_mod g ] @@ -235,7 +236,6 @@ suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L l' rdrName} description = "Fold " <> pprNameText <> describeRestriction restrictToOriginatingFile in (description, CodeActionRefactorExtract, RunRetrieParams {..}) in [unfoldRewrite False, unfoldRewrite True, foldRewrite False, foldRewrite True] - where suggestBindRewrites _ _ _ _ = [] describeRestriction :: IsString p => Bool -> p @@ -409,9 +409,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do -- TODO add the imports to the resulting edits (_user, ast, change@(Change _replacements _imports)) <- lift $ runRetrie fixityEnv retrie cpp - case ast of - _ -> - return $ asTextEdits change + return $ asTextEdits change let (errors :: [CallRetrieError], replacements) = partitionEithers results editParams :: WorkspaceEdit @@ -485,7 +483,7 @@ handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b handleMaybe msg = maybe (throwE msg) return handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b -handleMaybeM msg act = maybe (throwE msg) return =<< lift act +handleMaybeM msg act = maybeM (throwE msg) return $ lift act response :: Monad m => ExceptT String m a -> m (Either ResponseError a) response = diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index 407b4ce506..bb5c4ee820 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -18,6 +18,7 @@ library build-depends: aeson , base >=4.12 && <5 , containers + , extra , foldl , lsp , hls-plugin-api diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index f5d47ad9d5..577975c408 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -25,6 +25,7 @@ import Control.Arrow import qualified Control.Foldl as L import Control.Lens (ix, view, (%~), (<&>), (^.)) import Control.Monad +import Control.Monad.Extra (eitherM) import qualified Control.Monad.Fail as Fail import Control.Monad.Trans.Class import Control.Monad.Trans.Except @@ -324,8 +325,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e graftDeclsWithM (RealSrcSpan srcSpan) $ \case (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do eExpr <- - either (fail . show) pure - =<< lift + eitherM (fail . show) pure + $ lift ( lift $ gtry @_ @SomeException $ (fst <$> rnTopSpliceDecls spl) @@ -337,8 +338,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e graftWithM (RealSrcSpan srcSpan) $ \case (L _spn (matchSplice astP -> Just spl)) -> do eExpr <- - either (fail . show) pure - =<< lift + eitherM (fail . show) pure + $ lift ( lift $ gtry @_ @SomeException $ (fst <$> expandSplice astP spl) diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index b5a6984f8a..8005a90f5d 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -5,10 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NamedFieldPuns #-} module Ide.Main(defaultMain, runLspMode) where diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index 676e4dc664..9df8de0fa6 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE GADTs #-} module Progress (tests) where @@ -106,9 +105,9 @@ expectProgressReports xs = expectProgressReports' [] xs EndM msg -> do liftIO $ token msg `expectElem` tokens expectProgressReports' (delete (token msg) tokens) expectedTitles - title msg = msg ^. L.value ^. L.title + title msg = msg ^. L.value . L.title token msg = msg ^. L.token - create = CreateM . view L.params <$> (message SWindowWorkDoneProgressCreate) + create = CreateM . view L.params <$> message SWindowWorkDoneProgressCreate begin = BeginM <$> satisfyMaybe (\case FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Begin x))) -> Just (ProgressParams t x) _ -> Nothing) diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs index c4718e7e35..dabfa4a9d1 100644 --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -25,7 +25,7 @@ tests = testGroup "references" [ , mkRange 4 14 4 17 , mkRange 4 0 4 3 , mkRange 2 6 2 9 - ] `isInfixOf` (coerce refs) @? "Contains references" + ] `isInfixOf` coerce refs @? "Contains references" -- TODO: Respect withDeclaration parameter -- ignoreTestBecause "Broken" $ testCase "works without definitions" $ runSession hlsCommand fullCaps "test/testdata" $ do -- doc <- openDoc "References.hs" "haskell" diff --git a/test/functional/Tactic.hs b/test/functional/Tactic.hs index c48bdc2411..6bac33728f 100644 --- a/test/functional/Tactic.hs +++ b/test/functional/Tactic.hs @@ -150,7 +150,7 @@ mkTest name fp line col ts = for_ ts $ \(f, tc, var) -> do let title = tacticTitle tc var liftIO $ - f (elem title titles) + f (title `elem` titles) @? ("Expected a code action with title " <> T.unpack title) diff --git a/test/utils/Test/Hls/Util.hs b/test/utils/Test/Hls/Util.hs index b3b4296f3b..0b64ea7338 100644 --- a/test/utils/Test/Hls/Util.hs +++ b/test/utils/Test/Hls/Util.hs @@ -173,6 +173,7 @@ logFilePath = "hls-" ++ show ghcVersion ++ ".log" -- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while -- stack just puts all project executables on PATH. hlsCommand :: String +{-# NOINLINE hlsCommand #-} hlsCommand = unsafePerformIO $ do testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE" pure $ testExe ++ " --lsp -d -j2 -l test-logs/" ++ logFilePath diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs index 06aef44d25..6a8c19be38 100644 --- a/test/wrapper/Main.hs +++ b/test/wrapper/Main.hs @@ -1,5 +1,4 @@ -import Data.Char -import Data.List +import Data.List.Extra (trimEnd) import Data.Maybe import Test.Hls.Util import Test.Tasty @@ -23,7 +22,7 @@ projectGhcVersionTests = testGroup "--project-ghc-version" , testCase "stack with ghc 8.8.3" $ testDir "test/wrapper/testdata/stack-8.8.3" "8.8.3" , testCase "cabal with global ghc" $ do - ghcVer <- trim <$> readProcess "ghc" ["--numeric-version"] "" + ghcVer <- trimEnd <$> readProcess "ghc" ["--numeric-version"] "" testDir "test/wrapper/testdata/cabal-cur-ver" ghcVer ] @@ -32,8 +31,5 @@ testDir dir expectedVer = withCurrentDirectoryInTmp dir $ do testExe <- fromMaybe "haskell-language-server-wrapper" <$> lookupEnv "HLS_WRAPPER_TEST_EXE" - actualVer <- trim <$> readProcess testExe ["--project-ghc-version"] "" + actualVer <- trimEnd <$> readProcess testExe ["--project-ghc-version"] "" actualVer @?= expectedVer - -trim :: String -> String -trim = dropWhileEnd isSpace