Skip to content

Fix -Wall and -Wunused-packages in plugins api and floskell #4005

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jan 22, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 9 additions & 5 deletions hls-plugin-api/hls-plugin-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -102,6 +104,7 @@ library
TypeOperators

test-suite tests
import: warnings
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test
Expand All @@ -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)
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion hls-plugin-api/src/Ide/Logger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
17 changes: 9 additions & 8 deletions hls-plugin-api/src/Ide/Plugin/RangeMap.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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.
Expand Down
1 change: 0 additions & 1 deletion hls-plugin-api/src/Ide/Plugin/Resolve.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
Expand Down
1 change: 0 additions & 1 deletion hls-plugin-api/src/Ide/PluginUtils.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

Expand Down
18 changes: 10 additions & 8 deletions hls-plugin-api/test/Ide/PluginUtilsTest.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down
28 changes: 17 additions & 11 deletions hls-plugin-api/test/Ide/TypesTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand All @@ -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,
(===))
Expand All @@ -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))
Expand Down Expand Up @@ -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
Expand Down
6 changes: 5 additions & 1 deletion plugins/hls-floskell-plugin/hls-floskell-plugin.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand All @@ -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
Expand Down
1 change: 0 additions & 1 deletion plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down