Skip to content

Commit 8e85d9a

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 46f8049 commit 8e85d9a

File tree

8 files changed

+355
-50
lines changed

8 files changed

+355
-50
lines changed

‎haskell-language-server.cabal

-7
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

+33-9
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

+113-33
Original file line numberDiff line numberDiff line change
@@ -1,59 +1,139 @@
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.Encoding as Encoding
22+
import Data.Typeable
23+
import Development.IDE as D
24+
import Development.IDE.Core.Shake (restartShakeSession)
25+
import qualified Development.IDE.Core.Shake as Shake
2026
import GHC.Generics
21-
import Ide.PluginUtils
27+
import qualified Ide.Plugin.Cabal.Diag as Diag
28+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
29+
import qualified Ide.Plugin.Cabal.Parse as Parse
30+
import Ide.Plugin.Config (Config)
2231
import Ide.Types
32+
import Language.LSP.Server (LspM)
2333
import Language.LSP.Types
34+
import qualified Language.LSP.Types as LSP
35+
import qualified Language.LSP.VFS as VFS
2436

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

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

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

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 []
99+
data ParseCabal = ParseCabal
100+
deriving (Eq, Show, Typeable, Generic)
101+
instance Hashable ParseCabal
102+
instance NFData ParseCabal
103+
104+
type instance RuleResult ParseCabal = ()
105+
106+
cabalRules :: Recorder (WithPriority Log) -> Rules ()
107+
cabalRules recorder = do
108+
define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do
109+
t <- use GetModificationTime file
110+
log' Debug $ LogModificationTime file t
111+
mVirtualFile <- Shake.getVirtualFile file
112+
contents <- case mVirtualFile of
113+
Just vfile -> pure $ Encoding.encodeUtf8 $ VFS.virtualFileText vfile
114+
Nothing -> do
115+
liftIO $ BS.readFile $ fromNormalizedFilePath file
116+
117+
pm <- liftIO $ Parse.parseCabalFileContents contents
118+
let diagLst = case pm of
119+
(pWarnings, Left (_, pErrorNE)) ->
120+
let warningDiags = fmap (Diag.warningDiag file) pWarnings
121+
errorDiags = NE.toList $ NE.map (Diag.errorDiag file) pErrorNE
122+
in warningDiags <> errorDiags
123+
_ -> []
124+
log' Debug $ LogDiagnostics file diagLst
125+
return (diagLst, Just ())
51126
where
52-
log = logWith recorder
53-
-- ---------------------------------------------------------------------
127+
log' = logWith recorder
54128

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)
129+
-- ----------------------------------------------------------------
130+
-- Code Actions
131+
-- ----------------------------------------------------------------
132+
133+
licenseSuggestCodeAction
134+
:: IdeState
135+
-> PluginId
136+
-> CodeActionParams
137+
-> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
138+
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
139+
pure $ Right $ List $ catMaybes $ map (fmap InR . LicenseSuggest.licenseErrorAction uri) diags

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

+73
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)