git.iko.soy/ghcide
on 0452205 help sign in
ghcide/src/Development/IDE/Types/Diagnostics.hs
156 lines 4.9 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 OverloadedStrings #-}
6module Development.IDE.Types.Diagnostics (
7 LSP.Diagnostic(..),
8 FileDiagnostic,
9 LSP.DiagnosticSeverity(..),
10 DiagnosticStore,
11 DiagnosticRelatedInformation(..),
12 List(..),
13 StoreItem(..),
14 ideErrorText,
15 ideErrorPretty,
16 errorDiag,
17 showDiagnostics,
18 showDiagnosticsColored,
19 setStageDiagnostics,
20 getAllDiagnostics,
21 filterDiagnostics,
22 getFileDiagnostics,
23 prettyDiagnostics
24 ) where
26import Data.Maybe as Maybe
27import Data.Foldable
28import qualified Data.Map as Map
29import qualified Data.Text as T
30import Data.Text.Prettyprint.Doc.Syntax
31import qualified Data.SortedList as SL
32import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
33import qualified Language.Haskell.LSP.Types as LSP
34import Language.Haskell.LSP.Types as LSP (
35 DiagnosticSeverity(..)
36 , Diagnostic(..)
37 , List(..)
38 , DiagnosticRelatedInformation(..)
39 )
40import Language.Haskell.LSP.Diagnostics
42import Development.IDE.Types.Location
45ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
46ideErrorText fp = errorDiag fp "Ide Error"
48ideErrorPretty :: Pretty.Pretty e => NormalizedFilePath -> e -> FileDiagnostic
49ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow
51errorDiag :: NormalizedFilePath -> T.Text -> T.Text -> FileDiagnostic
52errorDiag fp src msg =
53 (fp, diagnostic noRange LSP.DsError src msg)
55-- | This is for compatibility with our old diagnostic type
56diagnostic :: Range
57 -> LSP.DiagnosticSeverity
58 -> T.Text -- ^ source
59 -> T.Text -- ^ message
60 -> LSP.Diagnostic
61diagnostic rng sev src msg
62 = LSP.Diagnostic {
63 _range = rng,
64 _severity = Just sev,
65 _code = Nothing,
66 _source = Just src,
67 _message = msg,
68 _relatedInformation = Nothing
69 }
72-- | Human readable diagnostics for a specific file.
73--
74-- This type packages a pretty printed, human readable error message
75-- along with the related source location so that we can display the error
76-- on either the console or in the IDE at the right source location.
77--
78type FileDiagnostic = (NormalizedFilePath, Diagnostic)
80prettyRange :: Range -> Doc SyntaxClass
81prettyRange Range{..} = f _start <> "-" <> f _end
82 where f Position{..} = pretty (_line+1) <> colon <> pretty _character
84stringParagraphs :: T.Text -> Doc a
85stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines
87showDiagnostics :: [FileDiagnostic] -> T.Text
88showDiagnostics = srenderPlain . prettyDiagnostics
90showDiagnosticsColored :: [FileDiagnostic] -> T.Text
91showDiagnosticsColored = srenderColored . prettyDiagnostics
94prettyDiagnostics :: [FileDiagnostic] -> Doc SyntaxClass
95prettyDiagnostics = vcat . map prettyDiagnostic
97prettyDiagnostic :: FileDiagnostic -> Doc SyntaxClass
98prettyDiagnostic (fp, LSP.Diagnostic{..}) =
99 vcat
100 [ slabel_ "File: " $ pretty (fromNormalizedFilePath fp)
101 , slabel_ "Range: " $ prettyRange _range
102 , slabel_ "Source: " $ pretty _source
103 , slabel_ "Severity:" $ pretty $ show sev
104 , slabel_ "Message: "
105 $ case sev of
106 LSP.DsError -> annotate ErrorSC
107 LSP.DsWarning -> annotate WarningSC
108 LSP.DsInfo -> annotate InfoSC
109 LSP.DsHint -> annotate HintSC
110 $ stringParagraphs _message
111 , slabel_ "Code:" $ pretty _code
112 ]
113 where
114 sev = fromMaybe LSP.DsError _severity
116getDiagnosticsFromStore :: StoreItem -> [Diagnostic]
117getDiagnosticsFromStore (StoreItem _ diags) =
118 toList =<< Map.elems diags
121-- | Sets the diagnostics for a file and compilation step
122-- if you want to clear the diagnostics call this with an empty list
123setStageDiagnostics ::
124 NormalizedFilePath ->
125 Maybe Int ->
126 -- ^ the time that the file these diagnostics originate from was last edited
127 T.Text ->
128 [LSP.Diagnostic] ->
129 DiagnosticStore ->
130 DiagnosticStore
131setStageDiagnostics fp timeM stage diags ds =
132 updateDiagnostics ds uri timeM diagsBySource
133 where
134 diagsBySource = Map.singleton (Just stage) (SL.toSortedList diags)
135 uri = filePathToUri' fp
137getAllDiagnostics ::
138 DiagnosticStore ->
139 [FileDiagnostic]
140getAllDiagnostics =
141 concatMap (\(k,v) -> map (fromUri k,) $ getDiagnosticsFromStore v) . Map.toList
143getFileDiagnostics ::
144 NormalizedFilePath ->
145 DiagnosticStore ->
146 [LSP.Diagnostic]
147getFileDiagnostics fp ds =
148 maybe [] getDiagnosticsFromStore $
149 Map.lookup (filePathToUri' fp) ds
151filterDiagnostics ::
152 (NormalizedFilePath -> Bool) ->
153 DiagnosticStore ->
154 DiagnosticStore
155filterDiagnostics keep =
156 Map.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)