Skip to content

Commit a3758b0

Browse files
runeksvendsenfendor
runeksvendsen
authored and
fendor
committed
hls-cabal-plugin: Add plugin
Add golden parse test for test/testdata/simple.cabal Add module Ide.Plugin.Cabal.Diag Also: add -Wall Add parseCabalFileContents Use VFS for cabal file contents Diagnostics * Parse and display Errors * Parse and display Warnings Code Actions * Code Action for License Field
1 parent e66b424 commit a3758b0

File tree

8 files changed

+356
-50
lines changed

8 files changed

+356
-50
lines changed

‎haskell-language-server.cabal

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -240,13 +240,6 @@ common cabal
240240
build-depends: hls-cabal-plugin ^>= 0.1
241241
cpp-options: -Dcabal
242242

243-
244-
common cabal
245-
if flag(cabal)
246-
build-depends: hls-cabal-plugin ^>= 0.1
247-
cpp-options: -Dcabal
248-
249-
250243
common class
251244
if flag(class)
252245
build-depends: hls-class-plugin ^>= 1.0

‎plugins/hls-cabal-plugin/hls-cabal-plugin.cabal

Lines changed: 33 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,37 +1,60 @@
11
cabal-version: 3.0
22
name: hls-cabal-plugin
33
version: 0.1.0.0
4-
synopsis:
4+
synopsis: Cabal integration plugin with Haskell Language Server
5+
description:
6+
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
7+
58
homepage:
69
license: MIT
710
license-file: LICENSE
811
author: Fendor
912
maintainer: [email protected]
1013
category: Development
11-
extra-source-files: CHANGELOG.md
14+
extra-source-files:
15+
CHANGELOG.md
16+
test/testdata/simple.cabal
17+
test/testdata/simple.cabal.golden.txt
18+
19+
common warnings
20+
ghc-options: -Wall
1221

1322
library
14-
exposed-modules: Ide.Plugin.Cabal
23+
import: warnings
24+
exposed-modules:
25+
Ide.Plugin.Cabal
26+
Ide.Plugin.Cabal.Diag
27+
Ide.Plugin.Cabal.LicenseSuggest
28+
Ide.Plugin.Cabal.Parse
29+
1530
build-depends:
1631
, aeson
17-
, base >=4.12 && <5
32+
, base >=4.12 && <5
33+
, bytestring
34+
, Cabal
1835
, czipwith
36+
, deepseq
37+
, directory
1938
, extra
2039
, filepath
2140
, ghc-exactprint
22-
, ghcide >=1.6 && <1.8
23-
, hls-plugin-api >=1.3 && <1.5
41+
, ghcide >=1.6 && <1.8
42+
, hashable
43+
, hls-plugin-api >=1.3 && <1.5
2444
, lens
45+
, lsp
2546
, lsp-types
47+
, regex-tdfa
48+
, stm
2649
, text
2750
, transformers
51+
, unordered-containers
2852

29-
-- see https://github.com/lspitzner/brittany/issues/364
30-
-- TODO: remove these when GH issue #2005 is resolved
3153
hs-source-dirs: src
3254
default-language: Haskell2010
3355

34-
test-suite hls-cabal-plugin-test
56+
test-suite tests
57+
import: warnings
3558
default-language: Haskell2010
3659
type: exitcode-stdio-1.0
3760
hs-source-dirs: test
@@ -43,4 +66,5 @@ test-suite hls-cabal-plugin-test
4366
, hls-test-utils ^>=1.3
4467
, lsp
4568
, lsp-types
69+
, tasty-hunit
4670
, text

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

Lines changed: 114 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -1,59 +1,140 @@
11
{-# LANGUAGE DataKinds #-}
2-
{-# LANGUAGE DeriveAnyClass #-}
32
{-# LANGUAGE DeriveGeneric #-}
43
{-# LANGUAGE DuplicateRecordFields #-}
54
{-# LANGUAGE FlexibleContexts #-}
65
{-# LANGUAGE FlexibleInstances #-}
76
{-# LANGUAGE LambdaCase #-}
7+
{-# LANGUAGE NamedFieldPuns #-}
88
{-# LANGUAGE OverloadedStrings #-}
9-
{-# LANGUAGE RecordWildCards #-}
10-
{-# LANGUAGE TupleSections #-}
119
{-# LANGUAGE TypeFamilies #-}
12-
{-# LANGUAGE ViewPatterns #-}
1310

1411
module Ide.Plugin.Cabal where
1512

13+
import Control.Concurrent.STM
14+
import Control.DeepSeq (NFData)
15+
import Control.Monad.Extra
1616
import Control.Monad.IO.Class
17-
import Data.Aeson
18-
import qualified Data.Text as T
19-
import Development.IDE as D
17+
import qualified Data.ByteString as BS
18+
import Data.Hashable
19+
import qualified Data.List.NonEmpty as NE
20+
import Data.Maybe (catMaybes)
21+
import qualified Data.Text as T
22+
import qualified Data.Text.Encoding as Encoding
23+
import Data.Typeable
24+
import Development.IDE as D
25+
import Development.IDE.Core.Shake (restartShakeSession)
26+
import qualified Development.IDE.Core.Shake as Shake
2027
import GHC.Generics
21-
import Ide.PluginUtils
28+
import qualified Ide.Plugin.Cabal.Diag as Diag
29+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
30+
import qualified Ide.Plugin.Cabal.Parse as Parse
31+
import Ide.Plugin.Config (Config)
2232
import Ide.Types
33+
import Language.LSP.Server (LspM)
2334
import Language.LSP.Types
35+
import qualified Language.LSP.Types as LSP
36+
import qualified Language.LSP.VFS as VFS
2437

25-
26-
newtype Log = LogText T.Text deriving Show
38+
data Log
39+
= LogModificationTime NormalizedFilePath (Maybe FileVersion)
40+
| LogDiagnostics NormalizedFilePath [FileDiagnostic]
41+
| LogShake Shake.Log
42+
deriving Show
2743

2844
instance Pretty Log where
2945
pretty = \case
30-
LogText log -> pretty log
46+
LogShake log' -> pretty log'
47+
LogModificationTime nfp modTime ->
48+
"Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime)
49+
LogDiagnostics nfp diags ->
50+
"Diagnostics for " <+> pretty (fromNormalizedFilePath nfp) <> ":" <+> pretty (show diags)
3151

3252
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
3353
descriptor recorder plId = (defaultCabalPluginDescriptor plId)
34-
{ pluginHandlers = mkPluginHandler STextDocumentCodeLens (codeLens recorder)
54+
{ pluginRules = cabalRules recorder
55+
, pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction
56+
, pluginNotificationHandlers = mconcat
57+
[ mkPluginNotificationHandler LSP.STextDocumentDidOpen $
58+
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
59+
whenUriFile _uri $ \file -> do
60+
logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri
61+
join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file]
62+
restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (opened)") []
63+
join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file
64+
65+
, mkPluginNotificationHandler LSP.STextDocumentDidChange $
66+
\ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
67+
whenUriFile _uri $ \file -> do
68+
logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri
69+
logDebug (ideLogger ide) $ "VFS State: " <> T.pack (show vfs)
70+
join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file]
71+
restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (modified)") []
72+
join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file
73+
74+
, mkPluginNotificationHandler LSP.STextDocumentDidSave $
75+
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
76+
whenUriFile _uri $ \file -> do
77+
logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri
78+
join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file]
79+
restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (saved)") []
80+
join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file
81+
82+
, mkPluginNotificationHandler LSP.STextDocumentDidClose $
83+
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
84+
whenUriFile _uri $ \file -> do
85+
let msg = "Closed text document: " <> getUri _uri
86+
logDebug (ideLogger ide) msg
87+
join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file]
88+
restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (closed)") []
89+
join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file
90+
]
3591
}
92+
where
93+
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
94+
whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'
95+
96+
-- ----------------------------------------------------------------
97+
-- Plugin Rules
98+
-- ----------------------------------------------------------------
3699

37-
-- ---------------------------------------------------------------------
38-
39-
codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeLens
40-
codeLens recorder _ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do
41-
log Debug $ LogText "ExampleCabal.codeLens entered (ideLogger)"
42-
case uriToFilePath' uri of
43-
Just (toNormalizedFilePath -> _filePath) -> do
44-
let
45-
title = "Add TODO Item via Code Lens"
46-
range = Range (Position 3 0) (Position 4 0)
47-
let cmdParams = AddTodoParams uri "do abc"
48-
cmd = mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams])
49-
pure $ Right $ List [ CodeLens range (Just cmd) Nothing ]
50-
Nothing -> pure $ Right $ List []
100+
data ParseCabal = ParseCabal
101+
deriving (Eq, Show, Typeable, Generic)
102+
instance Hashable ParseCabal
103+
instance NFData ParseCabal
104+
105+
type instance RuleResult ParseCabal = ()
106+
107+
cabalRules :: Recorder (WithPriority Log) -> Rules ()
108+
cabalRules recorder = do
109+
define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do
110+
t <- use GetModificationTime file
111+
log' Debug $ LogModificationTime file t
112+
mVirtualFile <- Shake.getVirtualFile file
113+
contents <- case mVirtualFile of
114+
Just vfile -> pure $ Encoding.encodeUtf8 $ VFS.virtualFileText vfile
115+
Nothing -> do
116+
liftIO $ BS.readFile $ fromNormalizedFilePath file
117+
118+
pm <- liftIO $ Parse.parseCabalFileContents contents
119+
let diagLst = case pm of
120+
(pWarnings, Left (_, pErrorNE)) ->
121+
let warningDiags = fmap (Diag.warningDiag file) pWarnings
122+
errorDiags = NE.toList $ NE.map (Diag.errorDiag file) pErrorNE
123+
in warningDiags <> errorDiags
124+
_ -> []
125+
log' Debug $ LogDiagnostics file diagLst
126+
return (diagLst, Just ())
51127
where
52-
log = logWith recorder
53-
-- ---------------------------------------------------------------------
128+
log' = logWith recorder
54129

55-
data AddTodoParams = AddTodoParams
56-
{ file :: Uri -- ^ Uri of the file to add the pragma to
57-
, todoText :: T.Text
58-
}
59-
deriving (Show, Eq, Generic, ToJSON, FromJSON)
130+
-- ----------------------------------------------------------------
131+
-- Code Actions
132+
-- ----------------------------------------------------------------
133+
134+
licenseSuggestCodeAction
135+
:: IdeState
136+
-> PluginId
137+
-> CodeActionParams
138+
-> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
139+
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
140+
pure $ Right $ List $ catMaybes $ map (fmap InR . LicenseSuggest.licenseErrorAction uri) diags

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diag.hs

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
{-# LANGUAGE DuplicateRecordFields #-}
2+
{-# LANGUAGE TupleSections #-}
3+
module Ide.Plugin.Cabal.Diag
4+
( errorDiag
5+
, warningDiag
6+
-- * Re-exports
7+
, FileDiagnostic
8+
, Diagnostic(..)
9+
)
10+
where
11+
12+
import qualified Data.Text as T
13+
import Development.IDE (FileDiagnostic,
14+
ShowDiagnostic (ShowDiag))
15+
import Distribution.Fields (showPError, showPWarning)
16+
import qualified Ide.Plugin.Cabal.Parse as Lib
17+
import Language.LSP.Types (Diagnostic (..),
18+
DiagnosticSeverity (..),
19+
DiagnosticSource, NormalizedFilePath,
20+
Position (Position), Range (Range),
21+
fromNormalizedFilePath)
22+
23+
-- | Produce a diagnostic from a Cabal parser error
24+
errorDiag :: NormalizedFilePath -> Lib.PError -> FileDiagnostic
25+
errorDiag fp err@(Lib.PError pos _) =
26+
mkDiag fp (T.pack "parsing") DsError (toBeginningOfNextLine pos) msg
27+
where
28+
msg = T.pack $ showPError (fromNormalizedFilePath fp) err
29+
30+
-- | Produce a diagnostic from a Cabal parser warning
31+
warningDiag :: NormalizedFilePath -> Lib.PWarning -> FileDiagnostic
32+
warningDiag fp warning@(Lib.PWarning _ pos _) =
33+
mkDiag fp (T.pack "parsing") DsWarning (toBeginningOfNextLine pos) msg
34+
where
35+
msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning
36+
37+
-- The Cabal parser does not output a _range_ for a warning/error,
38+
-- only a single source code 'Lib.Position'.
39+
-- We define the range to be _from_ this position
40+
-- _to_ the first column of the next line.
41+
toBeginningOfNextLine :: Lib.Position -> Range
42+
toBeginningOfNextLine (Lib.Position line column) =
43+
Range
44+
(Position (fromIntegral line') (fromIntegral col'))
45+
(Position (fromIntegral $ line' + 1) 0)
46+
where
47+
-- LSP is zero-based, Cabal is one-based
48+
line' = line-1
49+
col' = column-1
50+
51+
-- | Create a 'FileDiagnostic'
52+
mkDiag
53+
:: NormalizedFilePath
54+
-- ^ Cabal file path
55+
-> DiagnosticSource
56+
-- ^ Where does the diagnostic come from?
57+
-> DiagnosticSeverity
58+
-- ^ Severity
59+
-> Range
60+
-- ^ Which source code range should the editor highlight?
61+
-> T.Text
62+
-- ^ The message displayed by the editor
63+
-> FileDiagnostic
64+
mkDiag file diagSource sev loc msg = (file, ShowDiag,)
65+
Diagnostic
66+
{ _range = loc
67+
, _severity = Just sev
68+
, _source = Just diagSource
69+
, _message = msg
70+
, _code = Nothing
71+
, _tags = Nothing
72+
, _relatedInformation = Nothing
73+
}

0 commit comments

Comments
 (0)