-- 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,
  List(..),
  ideErrorText,
  ideErrorWithSource,
  showDiagnostics,
  showDiagnosticsColored,
  IdeResultNoDiagnosticsEarlyCutoff) where

import           Control.DeepSeq
import           Data.Maybe                                as Maybe
import qualified Data.Text                                 as T
import           Data.Text.Prettyprint.Doc
import           Data.Text.Prettyprint.Doc.Render.Terminal (Color (..), color)
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal
import           Data.Text.Prettyprint.Doc.Render.Text
import           Language.LSP.Diagnostics
import           Language.LSP.Types                        as LSP (Diagnostic (..),
                                                                   DiagnosticSeverity (..),
                                                                   DiagnosticSource,
                                                                   List (..))

import           Data.ByteString                           (ByteString)
import           Development.IDE.Types.Location


-- | 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 -> DiagnosticSource -> FileDiagnostic
ideErrorText = forall a.
Maybe DiagnosticSource
-> Maybe DiagnosticSeverity
-> a
-> DiagnosticSource
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (forall a. a -> Maybe a
Just DiagnosticSource
"compiler") (forall a. a -> Maybe a
Just DiagnosticSeverity
DsError)

ideErrorWithSource
  :: Maybe DiagnosticSource
  -> Maybe DiagnosticSeverity
  -> a
  -> T.Text
  -> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource :: forall a.
Maybe DiagnosticSource
-> Maybe DiagnosticSeverity
-> a
-> DiagnosticSource
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource Maybe DiagnosticSource
source Maybe DiagnosticSeverity
sev a
fp DiagnosticSource
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 |? DiagnosticSource)
_code = forall a. Maybe a
Nothing,
    $sel:_source:Diagnostic :: Maybe DiagnosticSource
_source = Maybe DiagnosticSource
source,
    $sel:_message:Diagnostic :: DiagnosticSource
_message = DiagnosticSource
msg,
    $sel:_relatedInformation:Diagnostic :: Maybe (List DiagnosticRelatedInformation)
_relatedInformation = forall a. Maybe a
Nothing,
    $sel:_tags:Diagnostic :: Maybe (List DiagnosticTag)
_tags = 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
_start :: Range -> Position
_end :: 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
_line :: Position -> UInt
_character :: 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. DiagnosticSource -> 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
. DiagnosticSource -> [DiagnosticSource]
T.words) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiagnosticSource -> [DiagnosticSource]
T.lines

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

showDiagnosticsColored :: [FileDiagnostic] -> T.Text
showDiagnosticsColored :: [FileDiagnostic] -> DiagnosticSource
showDiagnosticsColored = Doc AnsiStyle -> DiagnosticSource
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 DiagnosticSource
Maybe DiagnosticSeverity
Maybe (Int32 |? DiagnosticSource)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
DiagnosticSource
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: DiagnosticSource
_source :: Maybe DiagnosticSource
_code :: Maybe (Int32 |? DiagnosticSource)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> DiagnosticSource
$sel:_source:Diagnostic :: Diagnostic -> Maybe DiagnosticSource
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? DiagnosticSource)
$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 DiagnosticSource
_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.DsError   -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Red
              DiagnosticSeverity
LSP.DsWarning -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Yellow
              DiagnosticSeverity
LSP.DsInfo    -> forall ann. ann -> Doc ann -> Doc ann
annotate forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Blue
              DiagnosticSeverity
LSP.DsHint    -> 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. DiagnosticSource -> Doc a
stringParagraphs DiagnosticSource
_message
        ]
    where
        sev :: DiagnosticSeverity
sev = forall a. a -> Maybe a -> a
fromMaybe DiagnosticSeverity
LSP.DsError 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 -> DiagnosticSource
srenderPlain = forall ann. SimpleDocStream ann -> DiagnosticSource
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 -> DiagnosticSource
srenderColored =
    SimpleDocStream AnsiStyle -> DiagnosticSource
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