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
type IdeResult v = ([FileDiagnostic], Maybe v)
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
})
data ShowDiagnostic
= ShowDiag
| HideDiag
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
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
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]
cliLayout ::
Int
-> LayoutOptions
cliLayout :: Int -> LayoutOptions
cliLayout Int
renderWidth = LayoutOptions
{ layoutPageWidth :: PageWidth
layoutPageWidth = Int -> Double -> PageWidth
AvailablePerLine Int
renderWidth Double
0.9
}
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)
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