Skip to content

Commit

Permalink
Fix -Wall and -Wunused-packages in plugins api and floskell (haskell#…
Browse files Browse the repository at this point in the history
…4005)

* Fix -Wall and -Wunused-packages in plugins api and floskell

* stylish-haskell

---------

Co-authored-by: Michael Peyton Jones <me@michaelpj.com>
  • Loading branch information
jhrcek and michaelpj authored Jan 22, 2024
1 parent f4f5cce commit dc9326c
Show file tree
Hide file tree
Showing 9 changed files with 51 additions and 37 deletions.
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

0 comments on commit dc9326c

Please sign in to comment.