git.iko.soy/ghcide
on b9dfd49 help sign in
ghcide/src/Development/IDE/Types/Diagnostics.hs
186 lines 5.6 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE DuplicateRecordFields #-}
7{-# LANGUAGE BlockArguments #-}
8module Development.IDE.Types.Diagnostics (
9 LSP.Diagnostic(..),
10 FileDiagnostics,
11 FileDiagnostic,
12 Location(..),
13 Range(..),
14 LSP.DiagnosticSeverity(..),
15 Position(..),
16 DiagnosticStore,
17 DiagnosticRelatedInformation(..),
18 List(..),
19 StoreItem(..),
20 Uri(..),
21 noLocation,
22 noRange,
23 noFilePath,
24 ideErrorText,
25 ideErrorPretty,
26 errorDiag,
27 ideTryIOException,
28 showDiagnostics,
29 showDiagnosticsColored,
30 prettyDiagnosticStore,
31 defDiagnostic,
32 addDiagnostics,
33 filterSeriousErrors,
34 filePathToUri,
35 getDiagnosticsFromStore
36 ) where
38import Control.Exception
39import Data.Either.Combinators
40import Data.Maybe as Maybe
41import Data.Foldable
42import qualified Data.Map as Map
43import qualified Data.Text as T
44import Data.Text.Prettyprint.Doc.Syntax
45import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
46import Language.Haskell.LSP.Types as LSP (
47 DiagnosticSeverity(..)
48 , Diagnostic(..)
49 , filePathToUri
50 , uriToFilePath
51 , List(..)
52 , DiagnosticRelatedInformation(..)
53 , Uri(..)
54 )
55import Language.Haskell.LSP.Diagnostics
57import Development.IDE.Types.Location
59ideErrorText :: FilePath -> T.Text -> FileDiagnostic
60ideErrorText fp = errorDiag fp "Ide Error"
62ideErrorPretty :: Pretty.Pretty e => FilePath -> e -> FileDiagnostic
63ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow
65errorDiag :: FilePath -> T.Text -> T.Text -> FileDiagnostic
66errorDiag fp src msg =
67 (fp, diagnostic noRange LSP.DsError src msg)
69-- | This is for compatibility with our old diagnostic type
70diagnostic :: Range
71 -> LSP.DiagnosticSeverity
72 -> T.Text -- ^ source
73 -> T.Text -- ^ message
74 -> LSP.Diagnostic
75diagnostic rng sev src msg
76 = LSP.Diagnostic {
77 _range = rng,
78 _severity = Just sev,
79 _code = Nothing,
80 _source = Just src,
81 _message = msg,
82 _relatedInformation = Nothing
83 }
85-- | Any optional field is instantiated to Nothing
86defDiagnostic ::
87 Range ->
88 T.Text -> -- ^ error message
89 LSP.Diagnostic
90defDiagnostic _range _message = LSP.Diagnostic {
91 _range
92 , _message
93 , _severity = Nothing
94 , _code = Nothing
95 , _source = Nothing
96 , _relatedInformation = Nothing
97 }
99filterSeriousErrors ::
100 FilePath ->
101 [LSP.Diagnostic] ->
102 [LSP.Diagnostic]
103filterSeriousErrors fp =
104 filter (maybe False hasSeriousErrors . LSP._relatedInformation)
105 where
106 hasSeriousErrors :: List DiagnosticRelatedInformation -> Bool
107 hasSeriousErrors (List a) = any ((/=) uri . _uri . _location) a
108 uri = LSP.filePathToUri fp
110addDiagnostics ::
111 FilePath ->
112 [LSP.Diagnostic] ->
113 DiagnosticStore -> DiagnosticStore
114addDiagnostics fp diags ds =
115 updateDiagnostics
116 ds
117 (LSP.filePathToUri fp)
118 Nothing $
119 partitionBySource diags
121ideTryIOException :: FilePath -> IO a -> IO (Either FileDiagnostic a)
122ideTryIOException fp act =
123 mapLeft (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e) <$> try act
125-- | Human readable diagnostics for a specific file.
126--
127-- This type packages a pretty printed, human readable error message
128-- along with the related source location so that we can display the error
129-- on either the console or in the IDE at the right source location.
130--
131type FileDiagnostics = (FilePath, [Diagnostic])
132type FileDiagnostic = (FilePath, Diagnostic)
134prettyRange :: Range -> Doc SyntaxClass
135prettyRange Range{..} = f _start <> "-" <> f _end
136 where f Position{..} = pretty (_line+1) <> colon <> pretty _character
138stringParagraphs :: T.Text -> Doc a
139stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines
141showDiagnostics :: [FileDiagnostic] -> T.Text
142showDiagnostics = srenderPlain . prettyDiagnostics
144showDiagnosticsColored :: [FileDiagnostic] -> T.Text
145showDiagnosticsColored = srenderColored . prettyDiagnostics
148prettyDiagnostics :: [FileDiagnostic] -> Doc SyntaxClass
149prettyDiagnostics = vcat . map prettyDiagnostic
151prettyDiagnostic :: FileDiagnostic -> Doc SyntaxClass
152prettyDiagnostic (fp, LSP.Diagnostic{..}) =
153 vcat
154 [ slabel_ "File: " $ pretty fp
155 , slabel_ "Range: " $ prettyRange _range
156 , slabel_ "Source: " $ pretty _source
157 , slabel_ "Severity:" $ pretty $ show sev
158 , slabel_ "Message: "
159 $ case sev of
160 LSP.DsError -> annotate ErrorSC
161 LSP.DsWarning -> annotate WarningSC
162 LSP.DsInfo -> annotate InfoSC
163 LSP.DsHint -> annotate HintSC
164 $ stringParagraphs _message
165 , slabel_ "Code:" $ pretty _code
166 ]
167 where
168 sev = fromMaybe LSP.DsError _severity
170prettyDiagnosticStore :: DiagnosticStore -> Doc SyntaxClass
171prettyDiagnosticStore ds =
172 vcat $
173 map (\(uri, diags) -> prettyFileDiagnostics (fromMaybe noFilePath $ uriToFilePath uri, diags)) $
174 Map.assocs $
175 Map.map getDiagnosticsFromStore ds
177prettyFileDiagnostics :: FileDiagnostics -> Doc SyntaxClass
178prettyFileDiagnostics (filePath, diags) =
179 slabel_ "Compiler error in" $ vcat
180 [ slabel_ "File:" $ pretty filePath
181 , slabel_ "Errors:" $ vcat $ map (prettyDiagnostic . (filePath,)) diags
182 ]
184getDiagnosticsFromStore :: StoreItem -> [Diagnostic]
185getDiagnosticsFromStore (StoreItem _ diags) =
186 toList =<< Map.elems diags