|
| 1 | +module Ide.Plugin.CabalProject.Diagnostics where |
| 2 | + |
| 3 | +diagnostic = undefined |
| 4 | + |
| 5 | +-- {-# LANGUAGE DuplicateRecordFields #-} |
| 6 | +-- {-# LANGUAGE OverloadedStrings #-} |
| 7 | +-- module Ide.Plugin.CabalProject.Diagnostics |
| 8 | +-- ( errorDiagnostic |
| 9 | +-- , warningDiagnostic |
| 10 | +-- , positionFromCabaProjectPosition |
| 11 | +-- , fatalParseErrorDiagnostic |
| 12 | +-- -- * Re-exports |
| 13 | +-- , FileDiagnostic |
| 14 | +-- , Diagnostic(..) |
| 15 | +-- ) |
| 16 | +-- where |
| 17 | + |
| 18 | +-- import Control.Lens ((&), (.~)) |
| 19 | +-- import qualified Data.Text as T |
| 20 | +-- import Development.IDE (FileDiagnostic) |
| 21 | +-- import Development.IDE.Types.Diagnostics (fdLspDiagnosticL, |
| 22 | +-- ideErrorWithSource) |
| 23 | +-- import Distribution.Fields (showPError, showPWarning) |
| 24 | +-- import qualified Distribution.Parsec as Syntax |
| 25 | +-- import Ide.PluginUtils (extendNextLine) |
| 26 | +-- import Language.LSP.Protocol.Lens (range) |
| 27 | +-- import Language.LSP.Protocol.Types (Diagnostic (..), |
| 28 | +-- DiagnosticSeverity (..), |
| 29 | +-- NormalizedFilePath, |
| 30 | +-- Position (Position), |
| 31 | +-- Range (Range), |
| 32 | +-- fromNormalizedFilePath) |
| 33 | + |
| 34 | +-- -- | Produce a diagnostic for a fatal Cabal parser error. |
| 35 | +-- fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic |
| 36 | +-- fatalParseErrorDiagnostic fp msg = |
| 37 | +-- mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg |
| 38 | + |
| 39 | +-- -- | Produce a diagnostic from a Cabal parser error |
| 40 | +-- errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic |
| 41 | +-- errorDiagnostic fp err@(Syntax.PError pos _) = |
| 42 | +-- mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg |
| 43 | +-- where |
| 44 | +-- msg = T.pack $ showPError (fromNormalizedFilePath fp) err |
| 45 | + |
| 46 | +-- -- | Produce a diagnostic from a Cabal parser warning |
| 47 | +-- warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic |
| 48 | +-- warningDiagnostic fp warning@(Syntax.PWarning _ pos _) = |
| 49 | +-- mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg |
| 50 | +-- where |
| 51 | +-- msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning |
| 52 | + |
| 53 | +-- -- | The Cabal parser does not output a _range_ for a warning/error, |
| 54 | +-- -- only a single source code 'Lib.Position'. |
| 55 | +-- -- We define the range to be _from_ this position |
| 56 | +-- -- _to_ the first column of the next line. |
| 57 | +-- toBeginningOfNextLine :: Syntax.Position -> Range |
| 58 | +-- toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos |
| 59 | +-- where |
| 60 | +-- pos = positionFromCabalPosition cabalPos |
| 61 | + |
| 62 | +-- -- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands. |
| 63 | +-- -- |
| 64 | +-- -- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based, |
| 65 | +-- -- while Cabal is one-based. |
| 66 | +-- -- |
| 67 | +-- -- >>> positionFromCabalPosition $ Lib.Position 1 1 |
| 68 | +-- -- Position 0 0 |
| 69 | +-- positionFromCabalPosition :: Syntax.Position -> Position |
| 70 | +-- positionFromCabalPosition (Syntax.Position line column) = Position (fromIntegral line') (fromIntegral col') |
| 71 | +-- where |
| 72 | +-- -- LSP is zero-based, Cabal is one-based |
| 73 | +-- -- Cabal can return line 0 for errors in the first line |
| 74 | +-- line' = if line <= 0 then 0 else line-1 |
| 75 | +-- col' = if column <= 0 then 0 else column-1 |
| 76 | + |
| 77 | +-- -- | Create a 'FileDiagnostic' |
| 78 | +-- mkDiag |
| 79 | +-- :: NormalizedFilePath |
| 80 | +-- -- ^ Cabal file path |
| 81 | +-- -> T.Text |
| 82 | +-- -- ^ Where does the diagnostic come from? |
| 83 | +-- -> DiagnosticSeverity |
| 84 | +-- -- ^ Severity |
| 85 | +-- -> Range |
| 86 | +-- -- ^ Which source code range should the editor highlight? |
| 87 | +-- -> T.Text |
| 88 | +-- -- ^ The message displayed by the editor |
| 89 | +-- -> FileDiagnostic |
| 90 | +-- mkDiag file diagSource sev loc msg = |
| 91 | +-- ideErrorWithSource |
| 92 | +-- (Just diagSource) |
| 93 | +-- (Just sev) |
| 94 | +-- file |
| 95 | +-- msg |
| 96 | +-- Nothing |
| 97 | +-- & fdLspDiagnosticL . range .~ loc |
0 commit comments