diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 73fa40eb36..f5ee171862 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -32,7 +32,13 @@ source-repository head type: git location: https://github.com/haskell/haskell-language-server +common warnings + ghc-options: + -Wall -Wredundant-constraints -Wunused-packages + -Wno-name-shadowing -Wno-unticked-promoted-constructors + library + import: warnings exposed-modules: Ide.Logger Ide.Plugin.Config @@ -84,10 +90,6 @@ library else build-depends: unix - ghc-options: - -Wall -Wredundant-constraints -Wno-name-shadowing - -Wno-unticked-promoted-constructors -Wunused-packages - if flag(pedantic) ghc-options: -Werror @@ -102,6 +104,7 @@ library TypeOperators test-suite tests + import: warnings type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test @@ -125,6 +128,7 @@ test-suite tests , text benchmark rangemap-benchmark + import: warnings -- Benchmark doesn't make sense if fingertree implementation -- is not used. if !flag(use-fingertree) @@ -134,7 +138,7 @@ benchmark rangemap-benchmark default-language: Haskell2010 hs-source-dirs: bench main-is: Main.hs - ghc-options: -threaded -Wall + ghc-options: -threaded build-depends: , base , criterion diff --git a/hls-plugin-api/src/Ide/Logger.hs b/hls-plugin-api/src/Ide/Logger.hs index aab41f4e73..24984236d7 100644 --- a/hls-plugin-api/src/Ide/Logger.hs +++ b/hls-plugin-api/src/Ide/Logger.hs @@ -178,7 +178,7 @@ withFileRecorder path columns action = do fileHandle :: Either IOException Handle <- liftIO $ try (openFile path AppendMode) case fileHandle of Left e -> action $ Left e - Right fileHandle -> finally ((Right <$> makeHandleRecorder fileHandle) >>= action) (liftIO $ hClose fileHandle) + Right fileHandle -> finally (makeHandleRecorder fileHandle >>= action . Right) (liftIO $ hClose fileHandle) makeDefaultHandleRecorder :: MonadIO m diff --git a/hls-plugin-api/src/Ide/Plugin/RangeMap.hs b/hls-plugin-api/src/Ide/Plugin/RangeMap.hs index 11d7ebe29e..dfe0042933 100644 --- a/hls-plugin-api/src/Ide/Plugin/RangeMap.hs +++ b/hls-plugin-api/src/Ide/Plugin/RangeMap.hs @@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +#ifdef USE_FINGERTREE +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +#endif -- | A map that allows fast \"in-range\" filtering. 'RangeMap' is meant -- to be constructed once and cached as part of a Shake rule. If @@ -18,15 +20,14 @@ module Ide.Plugin.RangeMap fromList', filterByRange, ) where - -import Data.Bifunctor (first) -import Data.Foldable (foldl') import Development.IDE.Graph.Classes (NFData) -import Language.LSP.Protocol.Types (Position, - Range (Range), - isSubrangeOf) +import Language.LSP.Protocol.Types (Range, isSubrangeOf) #ifdef USE_FINGERTREE +import Data.Bifunctor (first) +import Data.Foldable (foldl') import qualified HaskellWorks.Data.IntervalMap.FingerTree as IM +import Language.LSP.Protocol.Types (Position, + Range (Range)) #endif -- | A map from code ranges to values. diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index 511b5f0a61..6797c4a85a 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 19ae197753..6feb8769fa 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} diff --git a/hls-plugin-api/test/Ide/PluginUtilsTest.hs b/hls-plugin-api/test/Ide/PluginUtilsTest.hs index a4f16a4491..88addf768c 100644 --- a/hls-plugin-api/test/Ide/PluginUtilsTest.hs +++ b/hls-plugin-api/test/Ide/PluginUtilsTest.hs @@ -1,16 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ide.PluginUtilsTest ( tests ) where -import Data.Char (isPrint) import qualified Data.Set as Set import qualified Data.Text as T import qualified Ide.Plugin.RangeMap as RangeMap -import Ide.PluginUtils (extractTextInRange, - positionInRange, unescape) +import Ide.PluginUtils (extractTextInRange, unescape) import Language.LSP.Protocol.Types (Position (..), Range (Range), UInt, isSubrangeOf) import Test.Tasty @@ -106,7 +105,7 @@ genRangeInline = do pure $ Range x1 x2 where genRangeLength :: Gen UInt - genRangeLength = fromInteger <$> chooseInteger (5, 50) + genRangeLength = uInt (5, 50) genRangeMultiline :: Gen Range genRangeMultiline = do @@ -119,17 +118,20 @@ genRangeMultiline = do pure $ Range x1 x2 where genSecond :: Gen UInt - genSecond = fromInteger <$> chooseInteger (0, 10) + genSecond = uInt (0, 10) genPosition :: Gen Position genPosition = Position - <$> (fromInteger <$> chooseInteger (0, 1000)) - <*> (fromInteger <$> chooseInteger (0, 150)) + <$> uInt (0, 1000) + <*> uInt (0, 150) + +uInt :: (Integer, Integer) -> Gen UInt +uInt (a, b) = fromInteger <$> chooseInteger (a, b) instance Arbitrary Range where arbitrary = genRange -prop_rangemapListEq :: (Show a, Eq a, Ord a) => Range -> [(Range, a)] -> Property +prop_rangemapListEq :: (Show a, Ord a) => Range -> [(Range, a)] -> Property prop_rangemapListEq r xs = let filteredList = (map snd . filter (isSubrangeOf r . fst)) xs filteredRangeMap = RangeMap.filterByRange r (RangeMap.fromList' xs) diff --git a/hls-plugin-api/test/Ide/TypesTests.hs b/hls-plugin-api/test/Ide/TypesTests.hs index c5ceab7ed2..c4ae1ccc0a 100644 --- a/hls-plugin-api/test/Ide/TypesTests.hs +++ b/hls-plugin-api/test/Ide/TypesTests.hs @@ -7,17 +7,15 @@ module Ide.TypesTests ( tests ) where -import Control.Lens (preview, (?~), (^?)) -import Control.Monad ((>=>)) +import Control.Lens ((?~), (^?)) import Data.Default (Default (def)) import Data.Function ((&)) -import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (isJust) import qualified Data.Text as Text -import Ide.Types (Config (Config), - PluginRequestMethod (combineResponses)) +import Ide.Types (PluginRequestMethod (combineResponses)) import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition), +import Language.LSP.Protocol.Message (MessageParams, MessageResult, SMethod (..)) import Language.LSP.Protocol.Types (ClientCapabilities, Definition (Definition), @@ -29,18 +27,17 @@ import Language.LSP.Protocol.Types (ClientCapabilities, Null (Null), Position (Position), Range (Range), - TextDocumentClientCapabilities (TextDocumentClientCapabilities, _definition), + TextDocumentClientCapabilities, TextDocumentIdentifier (TextDocumentIdentifier), TypeDefinitionClientCapabilities (TypeDefinitionClientCapabilities, _dynamicRegistration, _linkSupport), TypeDefinitionParams (..), - Uri (Uri), _L, _R, + Uri (Uri), _L, _R, _definition, _typeDefinition, filePathToUri, type (|?) (..)) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (assertBool, testCase, (@=?)) +import Test.Tasty.HUnit (testCase, (@=?)) import Test.Tasty.QuickCheck (ASCIIString (ASCIIString), Arbitrary (arbitrary), Gen, - NonEmptyList (NonEmpty), arbitraryBoundedEnum, cover, listOf1, oneof, testProperty, (===)) @@ -63,6 +60,11 @@ combineResponsesTextDocumentTypeDefinitionTests :: TestTree combineResponsesTextDocumentTypeDefinitionTests = testGroup "TextDocumentTypeDefinition" $ defAndTypeDefSharedTests SMethod_TextDocumentTypeDefinition typeDefinitionParams +defAndTypeDefSharedTests :: + ( MessageResult m ~ (Definition |? ([DefinitionLink] |? Null)) + , PluginRequestMethod m + ) + => SMethod m -> MessageParams m -> [TestTree] defAndTypeDefSharedTests message params = [ testCase "merges all single location responses into one response with all locations (without upgrading to links)" $ do let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null)) @@ -177,7 +179,11 @@ defAndTypeDefSharedTests message params = (isJust (result ^? _L) || isJust (result ^? _R >>= (^? _R))) === True ] -(range1, range2, range3) = (Range (Position 3 0) $ Position 3 5, Range (Position 5 7) $ Position 5 13, Range (Position 24 30) $ Position 24 40) + +range1, range2, range3 :: Range +range1 = Range (Position 3 0) $ Position 3 5 +range2 = Range (Position 5 7) $ Position 5 13 +range3 = Range (Position 24 30) $ Position 24 40 supportsLinkInAllDefinitionCaps :: ClientCapabilities supportsLinkInAllDefinitionCaps = def & L.textDocument ?~ textDocumentCaps diff --git a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal index f65a78cb3a..bb50145920 100644 --- a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal +++ b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal @@ -20,7 +20,11 @@ source-repository head type: git location: https://github.com/haskell/haskell-language-server.git +common warnings + ghc-options: -Wall -Wunused-packages + library + import: warnings exposed-modules: Ide.Plugin.Floskell hs-source-dirs: src build-depends: @@ -31,11 +35,11 @@ library , lsp-types ^>=2.1 , mtl , text - , transformers default-language: Haskell2010 test-suite tests + import: warnings type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs index e030ef7f2c..521a676a0f 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs @@ -10,7 +10,6 @@ import Control.Monad.Except (throwError) import Control.Monad.IO.Class import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as TL import Development.IDE hiding (pluginHandlers) import Floskell import Ide.Plugin.Error