-- 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 = forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (forall a. a -> Maybe a
Just Text
"compiler") (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 = 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 = forall a. Maybe a
Nothing,
    $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags = forall a. Maybe a
Nothing,
    $sel:_codeDescription:Diagnostic :: Maybe CodeDescription
_codeDescription = forall a. Maybe a
Nothing,
    $sel:_data_:Diagnostic :: Maybe Value
_data_ = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowDiagnostic -> ShowDiagnostic -> Bool
$c/= :: ShowDiagnostic -> ShowDiagnostic -> Bool
== :: ShowDiagnostic -> ShowDiagnostic -> Bool
$c== :: ShowDiagnostic -> ShowDiagnostic -> Bool
Eq, Eq 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
min :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
$cmin :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
max :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
$cmax :: ShowDiagnostic -> ShowDiagnostic -> ShowDiagnostic
>= :: ShowDiagnostic -> ShowDiagnostic -> Bool
$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
compare :: ShowDiagnostic -> ShowDiagnostic -> Ordering
$ccompare :: ShowDiagnostic -> ShowDiagnostic -> Ordering
Ord, Int -> ShowDiagnostic -> ShowS
[ShowDiagnostic] -> ShowS
ShowDiagnostic -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ShowDiagnostic] -> ShowS
$cshowList :: [ShowDiagnostic] -> ShowS
show :: ShowDiagnostic -> FilePath
$cshow :: ShowDiagnostic -> FilePath
showsPrec :: Int -> ShowDiagnostic -> ShowS
$cshowsPrec :: Int -> ShowDiagnostic -> ShowS
Show)

instance NFData ShowDiagnostic where
    rnf :: ShowDiagnostic -> ()
rnf = 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
$sel:_start:Range :: Range -> Position
$sel:_end:Range :: Range -> Position
_end :: Position
_start :: Position
..} = forall {ann}. Position -> Doc ann
f Position
_start forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
"-" forall a. Semigroup a => a -> a -> a
<> forall {ann}. Position -> Doc ann
f Position
_end
    where f :: Position -> Doc ann
f Position{UInt
$sel:_line:Position :: Position -> UInt
$sel:_character:Position :: Position -> UInt
_character :: UInt
_line :: UInt
..} = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ UInt
_lineforall a. Num a => a -> a -> a
+UInt
1) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ UInt
_characterforall a. Num a => a -> a -> a
+UInt
1)

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

showDiagnostics :: [FileDiagnostic] -> T.Text
showDiagnostics :: [FileDiagnostic] -> Text
showDiagnostics = forall ann. Doc ann -> Text
srenderPlain 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileDiagnostic] -> Doc AnsiStyle
prettyDiagnostics


prettyDiagnostics :: [FileDiagnostic] -> Doc Terminal.AnsiStyle
prettyDiagnostics :: [FileDiagnostic] -> Doc AnsiStyle
prettyDiagnostics = forall ann. [Doc ann] -> Doc ann
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Text
Maybe Value
Maybe CodeDescription
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_data_ :: Maybe Value
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_tags :: Maybe [DiagnosticTag]
_message :: Text
_source :: Maybe Text
_codeDescription :: Maybe CodeDescription
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
..}) =
    forall ann. [Doc ann] -> Doc ann
vcat
        [ forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"File:    " forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
fp)
        , forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Hidden:  " forall a b. (a -> b) -> a -> b
$ if ShowDiagnostic
sh forall a. Eq a => a -> a -> Bool
== ShowDiagnostic
ShowDiag then Doc AnsiStyle
"no" else Doc AnsiStyle
"yes"
        , forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Range:   " forall a b. (a -> b) -> a -> b
$ Range -> Doc AnsiStyle
prettyRange Range
_range
        , forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Source:  " forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Maybe Text
_source
        , forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Severity:" forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show DiagnosticSeverity
sev
        , forall a. FilePath -> Doc a -> Doc a
slabel_ FilePath
"Message: "
            forall a b. (a -> b) -> a -> b
$ case DiagnosticSeverity
sev of
              DiagnosticSeverity
LSP.DiagnosticSeverity_Error       -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Red
              DiagnosticSeverity
LSP.DiagnosticSeverity_Warning     -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Yellow
              DiagnosticSeverity
LSP.DiagnosticSeverity_Information -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Blue
              DiagnosticSeverity
LSP.DiagnosticSeverity_Hint        -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Magenta
            forall a b. (a -> b) -> a -> b
$ forall a. Text -> Doc a
stringParagraphs Text
_message
        ]
    where
        sev :: DiagnosticSeverity
sev = 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 = forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
sep [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 = forall ann. SimpleDocStream ann -> Text
renderStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions { layoutPageWidth :: PageWidth
layoutPageWidth = Int -> Double -> PageWidth
AvailablePerLine Int
100 Double
1.0 }

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