-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0


module Development.IDE.Types.Diagnostics (
  LSP.Diagnostic(..),
  ShowDiagnostic(..),
  FileDiagnostic,
  IdeResult,
  LSP.DiagnosticSeverity(..),
  DiagnosticStore,
  ideErrorText,
  ideErrorWithSource,
  showDiagnostics,
  showDiagnosticsColored,
  IdeResultNoDiagnosticsEarlyCutoff) where

import           Control.DeepSeq
import           Data.ByteString                (ByteString)
import           Data.Maybe                     as Maybe
import qualified Data.Text                      as T
import           Development.IDE.Types.Location
import           Language.LSP.Diagnostics
import           Language.LSP.Protocol.Types    as LSP (Diagnostic (..),
                                                        DiagnosticSeverity (..))
import           Prettyprinter
import           Prettyprinter.Render.Terminal  (Color (..), color)
import qualified Prettyprinter.Render.Terminal  as Terminal
import           Prettyprinter.Render.Text


-- | The result of an IDE operation. Warnings and errors are in the Diagnostic,
--   and a value is in the Maybe. For operations that throw an error you
--   expect a non-empty list of diagnostics, at least one of which is an error,
--   and a Nothing. For operations that succeed you expect perhaps some warnings
--   and a Just. For operations that depend on other failing operations you may
--   get empty diagnostics and a Nothing, to indicate this phase throws no fresh
--   errors but still failed.
--
--   A rule on a file should only return diagnostics for that given file. It should
--   not propagate diagnostic errors through multiple phases.
type IdeResult v = ([FileDiagnostic], Maybe v)

-- | an IdeResult with a fingerprint
type IdeResultNoDiagnosticsEarlyCutoff  v = (Maybe ByteString, Maybe v)

ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
ideErrorText :: NormalizedFilePath -> Text -> FileDiagnostic
ideErrorText = Maybe Text
-> Maybe DiagnosticSeverity
-> NormalizedFilePath
-> Text
-> FileDiagnostic
forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"compiler") (DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error)

ideErrorWithSource
  :: Maybe T.Text
  -> Maybe DiagnosticSeverity
  -> a
  -> T.Text
  -> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource :: forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource Maybe Text
source Maybe DiagnosticSeverity
sev a
fp Text
msg = (a
fp, ShowDiagnostic
ShowDiag, LSP.Diagnostic {
    $sel:_range:Diagnostic :: Range
_range = Range
noRange,
    $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = Maybe DiagnosticSeverity
sev,
    $sel:_code:Diagnostic :: Maybe (Int32 |? Text)
_code = Maybe (Int32 |? Text)
forall a. Maybe a
Nothing,
    $sel:_source:Diagnostic :: Maybe Text
_source = Maybe Text
source,
    $sel:_message:Diagnostic :: Text
_message = Text
msg,
    $sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
_relatedInformation = Maybe [DiagnosticRelatedInformation]
forall a. Maybe a
Nothing,
    $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags = Maybe [DiagnosticTag]
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
    })

-- | Defines whether a particular diagnostic should be reported
--   back to the user.
--
--   One important use case is "missing signature" code lenses,
--   for which we need to enable the corresponding warning during
--   type checking. However, we do not want to show the warning
--   unless the programmer asks for it (#261).
data ShowDiagnostic
    = ShowDiag  -- ^ Report back to the user
    | HideDiag  -- ^ Hide from user
    deriving (ShowDiagnostic -> ShowDiagnostic -> Bool
(ShowDiagnostic -> ShowDiagnostic -> Bool)
-> (ShowDiagnostic -> ShowDiagnostic -> Bool) -> Eq ShowDiagnostic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowDiagnostic -> ShowDiagnostic -> Bool
== :: ShowDiagnostic -> ShowDiagnostic -> Bool
$c/= :: ShowDiagnostic -> ShowDiagnostic -> Bool
/= :: ShowDiagnostic -> ShowDiagnostic -> Bool
Eq, Eq ShowDiagnostic
Eq ShowDiagnostic =>
(ShowDiagnostic -> ShowDiagnostic -> Ordering)
-> (ShowDiagnostic -> ShowDiagnostic -> Bool)
-> (ShowDiagnostic -> ShowDiagnostic -> Bool)
-> (ShowDiagnostic -> ShowDiagnostic -> Bool)
-> (ShowDiagnostic -> ShowDiagnostic -> Bool)
-> (ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic)
-> (ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic)
-> Ord ShowDiagnostic
ShowDiagnostic -> ShowDiagnostic -> Bool
ShowDiagnostic -> ShowDiagnostic -> Ordering
ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShowDiagnostic -> ShowDiagnostic -> Ordering
compare :: ShowDiagnostic -> ShowDiagnostic -> Ordering
$c< :: ShowDiagnostic -> ShowDiagnostic -> Bool
< :: ShowDiagnostic -> ShowDiagnostic -> Bool
$c<= :: ShowDiagnostic -> ShowDiagnostic -> Bool
<= :: ShowDiagnostic -> ShowDiagnostic -> Bool
$c> :: ShowDiagnostic -> ShowDiagnostic -> Bool
> :: ShowDiagnostic -> ShowDiagnostic -> Bool
$c>= :: ShowDiagnostic -> ShowDiagnostic -> Bool
>= :: ShowDiagnostic -> ShowDiagnostic -> Bool
$cmax :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
max :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
$cmin :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
min :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
Ord, Int -> ShowDiagnostic -> ShowS
[ShowDiagnostic] -> ShowS
ShowDiagnostic -> FilePath
(Int -> ShowDiagnostic -> ShowS)
-> (ShowDiagnostic -> FilePath)
-> ([ShowDiagnostic] -> ShowS)
-> Show ShowDiagnostic
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowDiagnostic -> ShowS
showsPrec :: Int -> ShowDiagnostic -> ShowS
$cshow :: ShowDiagnostic -> FilePath
show :: ShowDiagnostic -> FilePath
$cshowList :: [ShowDiagnostic] -> ShowS
showList :: [ShowDiagnostic] -> ShowS
Show)

instance NFData ShowDiagnostic where
    rnf :: ShowDiagnostic -> ()
rnf = ShowDiagnostic -> ()
forall a. a -> ()
rwhnf

-- | Human readable diagnostics for a specific file.
--
--   This type packages a pretty printed, human readable error message
--   along with the related source location so that we can display the error
--   on either the console or in the IDE at the right source location.
--
type FileDiagnostic = (NormalizedFilePath, ShowDiagnostic, Diagnostic)

prettyRange :: Range -> Doc Terminal.AnsiStyle
prettyRange :: Range -> Doc AnsiStyle
prettyRange Range{Position
_start :: Position
_end :: Position
$sel:_end:Range :: Range -> Position
$sel:_start:Range :: Range -> Position
..} = Position -> Doc AnsiStyle
forall {ann}. Position -> Doc ann
f Position
_start Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
"-" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Position -> Doc AnsiStyle
forall {ann}. Position -> Doc ann
f Position
_end
    where f :: Position -> Doc ann
f Position{UInt
_line :: UInt
_character :: UInt
$sel:_character:Position :: Position -> UInt
$sel:_line:Position :: Position -> UInt
..} = FilePath -> Doc ann
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (UInt -> FilePath
forall a. Show a => a -> FilePath
show (UInt -> FilePath) -> UInt -> FilePath
forall a b. (a -> b) -> a -> b
$ UInt
_lineUInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+UInt
1) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ann
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (UInt -> FilePath
forall a. Show a => a -> FilePath
show (UInt -> FilePath) -> UInt -> FilePath
forall a b. (a -> b) -> a -> b
$ UInt
_characterUInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+UInt
1)

stringParagraphs :: T.Text -> Doc a
stringParagraphs :: forall a. Text -> Doc a
stringParagraphs = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vcat ([Doc a] -> Doc a) -> (Text -> [Doc a]) -> Text -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc a) -> [Text] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc a] -> Doc a) -> (Text -> [Doc a]) -> Text -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc a) -> [Text] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc a
forall a. Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty ([Text] -> [Doc a]) -> (Text -> [Text]) -> Text -> [Doc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [Doc a]) -> (Text -> [Text]) -> Text -> [Doc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

showDiagnostics :: [FileDiagnostic] -> T.Text
showDiagnostics :: [FileDiagnostic] -> Text
showDiagnostics = Doc AnsiStyle -> Text
forall ann. Doc ann -> Text
srenderPlain (Doc AnsiStyle -> Text)
-> ([FileDiagnostic] -> Doc AnsiStyle) -> [FileDiagnostic] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileDiagnostic] -> Doc AnsiStyle
prettyDiagnostics

showDiagnosticsColored :: [FileDiagnostic] -> T.Text
showDiagnosticsColored :: [FileDiagnostic] -> Text
showDiagnosticsColored = Doc AnsiStyle -> Text
srenderColored (Doc AnsiStyle -> Text)
-> ([FileDiagnostic] -> Doc AnsiStyle) -> [FileDiagnostic] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileDiagnostic] -> Doc AnsiStyle
prettyDiagnostics


prettyDiagnostics :: [FileDiagnostic] -> Doc Terminal.AnsiStyle
prettyDiagnostics :: [FileDiagnostic] -> Doc AnsiStyle
prettyDiagnostics = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([FileDiagnostic] -> [Doc AnsiStyle])
-> [FileDiagnostic]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileDiagnostic -> Doc AnsiStyle)
-> [FileDiagnostic] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map FileDiagnostic -> Doc AnsiStyle
prettyDiagnostic

prettyDiagnostic :: FileDiagnostic -> Doc Terminal.AnsiStyle
prettyDiagnostic :: FileDiagnostic -> Doc AnsiStyle
prettyDiagnostic (NormalizedFilePath
fp, ShowDiagnostic
sh, LSP.Diagnostic{Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe CodeDescription
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}) =
    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat
        [ FilePath -> Doc AnsiStyle -> Doc AnsiStyle
forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"File:    " (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
fp)
        , FilePath -> Doc AnsiStyle -> Doc AnsiStyle
forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Hidden:  " (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ if ShowDiagnostic
sh ShowDiagnostic -> ShowDiagnostic -> Bool
forall a. Eq a => a -> a -> Bool
== ShowDiagnostic
ShowDiag then Doc AnsiStyle
"no" else Doc AnsiStyle
"yes"
        , FilePath -> Doc AnsiStyle -> Doc AnsiStyle
forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Range:   " (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Range -> Doc AnsiStyle
prettyRange Range
_range
        , FilePath -> Doc AnsiStyle -> Doc AnsiStyle
forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Source:  " (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Doc AnsiStyle
forall ann. Maybe Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe Text
_source
        , FilePath -> Doc AnsiStyle -> Doc AnsiStyle
forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Severity:" (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath -> Doc AnsiStyle) -> FilePath -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ DiagnosticSeverity -> FilePath
forall a. Show a => a -> FilePath
show DiagnosticSeverity
sev
        , FilePath -> Doc AnsiStyle -> Doc AnsiStyle
forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Message: "
            (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ case DiagnosticSeverity
sev of
              DiagnosticSeverity
LSP.DiagnosticSeverity_Error       -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Red
              DiagnosticSeverity
LSP.DiagnosticSeverity_Warning     -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Yellow
              DiagnosticSeverity
LSP.DiagnosticSeverity_Information -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Blue
              DiagnosticSeverity
LSP.DiagnosticSeverity_Hint        -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Magenta
            (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Text -> Doc AnsiStyle
forall a. Text -> Doc a
stringParagraphs Text
_message
        ]
    where
        sev :: DiagnosticSeverity
sev = DiagnosticSeverity
-> Maybe DiagnosticSeverity -> DiagnosticSeverity
forall a. a -> Maybe a -> a
fromMaybe DiagnosticSeverity
LSP.DiagnosticSeverity_Error Maybe DiagnosticSeverity
_severity


-- | Label a document.
slabel_ :: String -> Doc a -> Doc a
slabel_ :: forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
t Doc a
d = Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [FilePath -> Doc a
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
t, Doc a
d]

-- | The layout options used for the SDK assistant.
cliLayout ::
       Int
    -- ^ Rendering width of the pretty printer.
    -> LayoutOptions
cliLayout :: Int -> LayoutOptions
cliLayout Int
renderWidth = LayoutOptions
    { layoutPageWidth :: PageWidth
layoutPageWidth = Int -> Double -> PageWidth
AvailablePerLine Int
renderWidth Double
0.9
    }

-- | Render without any syntax annotations
srenderPlain :: Doc ann -> T.Text
srenderPlain :: forall ann. Doc ann -> Text
srenderPlain = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart (Int -> LayoutOptions
cliLayout Int
defaultTermWidth)

-- | Render a 'Document' as an ANSII colored string.
srenderColored :: Doc Terminal.AnsiStyle -> T.Text
srenderColored :: Doc AnsiStyle -> Text
srenderColored =
    SimpleDocStream AnsiStyle -> Text
Terminal.renderStrict (SimpleDocStream AnsiStyle -> Text)
-> (Doc AnsiStyle -> SimpleDocStream AnsiStyle)
-> Doc AnsiStyle
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    LayoutOptions -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions { layoutPageWidth = AvailablePerLine 100 1.0 }

defaultTermWidth :: Int
defaultTermWidth :: Int
defaultTermWidth = Int
80