diff --git a/dhall-lsp-server.cabal b/dhall-lsp-server.cabal --- a/dhall-lsp-server.cabal +++ b/dhall-lsp-server.cabal @@ -1,5 +1,5 @@ name: dhall-lsp-server -Version: 1.0.7 +Version: 1.0.8 cabal-version: 1.12 synopsis: Language Server Protocol (LSP) server for Dhall homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme @@ -43,15 +43,15 @@ src default-extensions: RecordWildCards OverloadedStrings build-depends: - aeson >= 1.3.1.1 && < 1.5 + aeson >= 1.3.1.1 && < 1.6 , aeson-pretty >= 0.8.7 && < 0.9 , base >= 4.11 && < 5 , bytestring >= 0.10.8.2 && < 0.11 , containers >= 0.5.11.0 && < 0.7 , data-default >= 0.7.1.1 && < 0.8 , directory >= 1.2.2.0 && < 1.4 - , dhall >= 1.29.0 && < 1.33 - , dhall-json >= 1.4 && < 1.7 + , dhall >= 1.29.0 && < 1.34 + , dhall-json >= 1.4 && < 1.8 , filepath >= 1.4.2 && < 1.5 , haskell-lsp >= 0.19.0.0 && < 0.23 , rope-utf16-splay >= 0.3.1.0 && < 0.4 @@ -98,15 +98,10 @@ base , directory >= 1.3.1.5 && < 1.4 , filepath < 1.5 , - doctest >= 0.7.0 && < 0.17, + doctest >= 0.7.0 && < 0.18, QuickCheck Other-Extensions: OverloadedStrings RecordWildCards Default-Language: Haskell2010 - -- `doctest` doesn't work with `MIN_VERSION` macros before GHC 8 - -- - -- See: https://ghc.haskell.org/trac/ghc/ticket/10970 - if impl(ghc < 8.0) - Buildable: False Test-Suite tests Type: exitcode-stdio-1.0 @@ -116,8 +111,8 @@ Build-Depends: base , haskell-lsp-types >= 0.19.0 && < 0.23 , - lsp-test >= 0.9 && < 0.11 , - tasty >= 0.11.2 && < 1.3 , + lsp-test >= 0.9 && < 0.12 , + tasty >= 0.11.2 && < 1.4 , tasty-hspec >= 1.1 && < 1.2 , text >= 0.11 && < 1.3 Default-Language: Haskell2010 diff --git a/src/Dhall/LSP/Backend/Linting.hs b/src/Dhall/LSP/Backend/Linting.hs --- a/src/Dhall/LSP/Backend/Linting.hs +++ b/src/Dhall/LSP/Backend/Linting.hs @@ -1,23 +1,25 @@ +{-# LANGUAGE NamedFieldPuns #-} + module Dhall.LSP.Backend.Linting ( Suggestion(..) , suggest - , Dhall.lint + , Lint.lint ) where -import Dhall.Parser (Src) -import Dhall.Core ( Expr(..), Binding(..), MultiLet(..), Import - , subExpressions, multiLet, wrapInLets) -import qualified Dhall.Lint as Dhall - -import Dhall.LSP.Backend.Diagnostics - -import qualified Data.List.NonEmpty as NonEmpty +import Control.Lens (universeOf) import Data.Maybe (maybeToList) import Data.Monoid ((<>)) import Data.Text (Text) -import Control.Lens (universeOf) +import Dhall.LSP.Backend.Diagnostics +import Dhall.Parser (Src) +import Dhall.Core (Expr(..), Binding(..), MultiLet(..), Import) +import qualified Data.Maybe as Maybe +import qualified Dhall.Core as Core +import qualified Dhall.Lint as Lint +import qualified Data.List.NonEmpty as NonEmpty + data Suggestion = Suggestion { range :: Range, suggestion :: Text @@ -29,29 +31,38 @@ -- the search beginning at different @let@s in the same let-block – only -- the outermost 'Let' of a let-block is wrapped in a 'Note'. diagLetInLet :: Expr Src a -> Maybe Suggestion -diagLetInLet (Note _ (Let b e)) = case multiLet b e of +diagLetInLet (Note _ (Let b e)) = case Core.multiLet b e of MultiLet _ (Note src (Let {})) -> Just (Suggestion (rangeFromDhall src) "Superfluous 'in' before nested let binding") _ -> Nothing diagLetInLet _ = Nothing -- Given a let-block compute all unused variables in the block. -unusedBindings :: Eq a => MultiLet s a -> [Text] +unusedBindings :: Eq a => MultiLet s a -> [ (Text, Maybe s) ] unusedBindings (MultiLet bindings d) = - let go bs@(Binding { variable = var} : _) | Just _ <- Dhall.removeUnusedBindings (wrapInLets bs d) = [var] + let go bs@(Binding { variable = var, value } : _) + | Just _ <- Lint.removeUnusedBindings (Core.wrapInLets bs d) = + [ (var, maybeSrc) ] + where + maybeSrc = case value of + Note src _ -> Just src + _ -> Nothing go _ = [] in foldMap go (NonEmpty.tails bindings) -- Diagnose unused let bindings. diagUnusedBindings :: Eq a => Expr Src a -> [Suggestion] -diagUnusedBindings (Note src (Let b e)) = map - (\var -> - Suggestion (rangeFromDhall src) ("Unused let binding '" <> var <> "'")) - (unusedBindings (multiLet b e)) +diagUnusedBindings (Note src (Let b e)) = + map adapt (unusedBindings (Core.multiLet b e)) + where + adapt (var, maybeSrc) = + Suggestion (rangeFromDhall finalSrc) ("Unused let binding '" <> var <> "'") + where + finalSrc = Maybe.fromMaybe src maybeSrc diagUnusedBindings _ = [] -- | Given an dhall expression suggest all the possible improvements that would -- be made by the linter. suggest :: Expr Src Import -> [Suggestion] suggest expr = concat [ maybeToList (diagLetInLet e) ++ diagUnusedBindings e - | e <- universeOf subExpressions expr ] + | e <- universeOf Core.subExpressions expr ] diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromJust) @@ -6,13 +7,14 @@ import qualified GHC.IO.Encoding import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types - ( CompletionItem (..), - Diagnostic (..), - DiagnosticSeverity (..), - Hover (..), - HoverContents (..), - MarkupContent (..), - Position (..), + ( CompletionItem(..) + , Diagnostic(..) + , DiagnosticSeverity(..) + , Hover(..) + , HoverContents(..) + , MarkupContent(..) + , Position(..) + , Range(..) ) import Test.Tasty import Test.Tasty.Hspec @@ -48,15 +50,36 @@ $ runSession "dhall-lsp-server" fullCaps fixtureDir $ do _ <- openDoc "UnusedBindings.dhall" "dhall" + diags <- waitForDiagnosticsSource "Dhall.Lint" - _ <- - liftIO $ - mapM - ( \diag -> do - _severity diag `shouldBe` Just DsHint - T.unpack (_message diag) `shouldContain` "Unused let binding" - ) - diags + + liftIO $ diags `shouldBe` + [ Diagnostic + { _range = Range + {_start = Position { _line = 2, _character = 10 } + , _end = Position { _line = 2, _character = 36 } + } + , _severity = Just DsHint + , _code = Nothing + , _source = Just "Dhall.Lint" + , _message = "Unused let binding 'bob'" + , _tags = Nothing + , _relatedInformation = Nothing + } + , Diagnostic + { _range = Range + { _start = Position { _line = 4, _character = 11 } + , _end = Position { _line = 4, _character = 38 } + } + , _severity = Just DsHint + , _code = Nothing + , _source = Just "Dhall.Lint" + , _message = "Unused let binding 'carl'" + , _tags = Nothing + , _relatedInformation = Nothing + } + ] + pure () it "reports multiple hints" $ runSession "dhall-lsp-server" fullCaps fixtureDir