{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings     #-}
module Ide.Plugin.Cabal.Diagnostics
( errorDiagnostic
, warningDiagnostic
, positionFromCabalPosition
, fatalParseErrorDiagnostic
  -- * Re-exports
, FileDiagnostic
, Diagnostic(..)
)
where

import qualified Data.Text                   as T
import           Development.IDE             (FileDiagnostic,
                                              ShowDiagnostic (ShowDiag))
import           Distribution.Fields         (showPError, showPWarning)
import qualified Distribution.Parsec         as Syntax
import           Ide.PluginUtils             (extendNextLine)
import           Language.LSP.Protocol.Types (Diagnostic (..),
                                              DiagnosticSeverity (..),
                                              NormalizedFilePath,
                                              Position (Position),
                                              Range (Range),
                                              fromNormalizedFilePath)

-- | Produce a diagnostic for a fatal Cabal parser error.
fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic
fatalParseErrorDiagnostic :: NormalizedFilePath -> Text -> FileDiagnostic
fatalParseErrorDiagnostic NormalizedFilePath
fp Text
msg =
  NormalizedFilePath
-> Text -> DiagnosticSeverity -> Range -> Text -> FileDiagnostic
mkDiag NormalizedFilePath
fp Text
"cabal" DiagnosticSeverity
DiagnosticSeverity_Error (Position -> Range
toBeginningOfNextLine Position
Syntax.zeroPos) Text
msg

-- | Produce a diagnostic from a Cabal parser error
errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic
errorDiagnostic :: NormalizedFilePath -> PError -> FileDiagnostic
errorDiagnostic NormalizedFilePath
fp err :: PError
err@(Syntax.PError Position
pos String
_) =
  NormalizedFilePath
-> Text -> DiagnosticSeverity -> Range -> Text -> FileDiagnostic
mkDiag NormalizedFilePath
fp Text
"cabal" DiagnosticSeverity
DiagnosticSeverity_Error (Position -> Range
toBeginningOfNextLine Position
pos) Text
msg
  where
    msg :: Text
msg = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> PError -> String
showPError (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
fp) PError
err

-- | Produce a diagnostic from a Cabal parser warning
warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic
warningDiagnostic :: NormalizedFilePath -> PWarning -> FileDiagnostic
warningDiagnostic NormalizedFilePath
fp warning :: PWarning
warning@(Syntax.PWarning PWarnType
_ Position
pos String
_) =
  NormalizedFilePath
-> Text -> DiagnosticSeverity -> Range -> Text -> FileDiagnostic
mkDiag NormalizedFilePath
fp Text
"cabal" DiagnosticSeverity
DiagnosticSeverity_Warning (Position -> Range
toBeginningOfNextLine Position
pos) Text
msg
  where
    msg :: Text
msg = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> PWarning -> String
showPWarning (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
fp) PWarning
warning

-- | The Cabal parser does not output a _range_ for a warning/error,
-- only a single source code 'Lib.Position'.
-- We define the range to be _from_ this position
-- _to_ the first column of the next line.
toBeginningOfNextLine :: Syntax.Position -> Range
toBeginningOfNextLine :: Position -> Range
toBeginningOfNextLine Position
cabalPos = Range -> Range
extendNextLine (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Range
Range Position
pos Position
pos
   where
    pos :: Position
pos = Position -> Position
positionFromCabalPosition Position
cabalPos

-- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands.
--
-- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based,
-- while Cabal is one-based.
--
-- >>> positionFromCabalPosition $ Lib.Position 1 1
-- Position 0 0
positionFromCabalPosition :: Syntax.Position -> Position
positionFromCabalPosition :: Position -> Position
positionFromCabalPosition (Syntax.Position Int
line Int
column) = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line') (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
col')
  where
    -- LSP is zero-based, Cabal is one-based
    line' :: Int
line' = Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    col' :: Int
col' = Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1

-- | Create a 'FileDiagnostic'
mkDiag
  :: NormalizedFilePath
  -- ^ Cabal file path
  -> T.Text
  -- ^ Where does the diagnostic come from?
  -> DiagnosticSeverity
  -- ^ Severity
  -> Range
  -- ^ Which source code range should the editor highlight?
  -> T.Text
  -- ^ The message displayed by the editor
  -> FileDiagnostic
mkDiag :: NormalizedFilePath
-> Text -> DiagnosticSeverity -> Range -> Text -> FileDiagnostic
mkDiag NormalizedFilePath
file Text
diagSource DiagnosticSeverity
sev Range
loc Text
msg = (NormalizedFilePath
file, ShowDiagnostic
ShowDiag,)
    Diagnostic
    { $sel:_range:Diagnostic :: Range
_range    = Range
loc
    , $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
sev
    , $sel:_source:Diagnostic :: Maybe Text
_source   = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
diagSource
    , $sel:_message:Diagnostic :: Text
_message  = Text
msg
    , $sel:_code:Diagnostic :: Maybe (Int32 |? Text)
_code     = Maybe (Int32 |? Text)
forall a. Maybe a
Nothing
    , $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags     = Maybe [DiagnosticTag]
forall a. Maybe a
Nothing
    , $sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
_relatedInformation = Maybe [DiagnosticRelatedInformation]
forall a. Maybe a
Nothing
    , $sel:_codeDescription:Diagnostic :: Maybe CodeDescription
_codeDescription = Maybe CodeDescription
forall a. Maybe a
Nothing
    , $sel:_data_:Diagnostic :: Maybe Value
_data_ = Maybe Value
forall a. Maybe a
Nothing
    }