git.iko.soy/ghcide
on 163bbc9 help sign in
ghcide/src/Development/IDE/Types/Diagnostics.hs
187 lines 5.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
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
41import Data.Text.Prettyprint.Doc.Render.Text
42import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal
43import Data.Text.Prettyprint.Doc.Render.Terminal (Color(..), color)
45import Development.IDE.Types.Location
48ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
49ideErrorText fp = errorDiag fp "Ide Error"
51ideErrorPretty :: Pretty.Pretty e => NormalizedFilePath -> e -> FileDiagnostic
52ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow
54errorDiag :: NormalizedFilePath -> T.Text -> T.Text -> FileDiagnostic
55errorDiag fp src msg =
56 (fp, diagnostic noRange LSP.DsError src msg)
58-- | This is for compatibility with our old diagnostic type
59diagnostic :: Range
60 -> LSP.DiagnosticSeverity
61 -> T.Text -- ^ source
62 -> T.Text -- ^ message
63 -> LSP.Diagnostic
64diagnostic rng sev src msg
65 = LSP.Diagnostic {
66 _range = rng,
67 _severity = Just sev,
68 _code = Nothing,
69 _source = Just src,
70 _message = msg,
71 _relatedInformation = Nothing
72 }
75-- | Human readable diagnostics for a specific file.
76--
77-- This type packages a pretty printed, human readable error message
78-- along with the related source location so that we can display the error
79-- on either the console or in the IDE at the right source location.
80--
81type FileDiagnostic = (NormalizedFilePath, Diagnostic)
83prettyRange :: Range -> Doc Terminal.AnsiStyle
84prettyRange Range{..} = f _start <> "-" <> f _end
85 where f Position{..} = pretty (_line+1) <> colon <> pretty _character
87stringParagraphs :: T.Text -> Doc a
88stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines
90showDiagnostics :: [FileDiagnostic] -> T.Text
91showDiagnostics = srenderPlain . prettyDiagnostics
93showDiagnosticsColored :: [FileDiagnostic] -> T.Text
94showDiagnosticsColored = srenderColored . prettyDiagnostics
97prettyDiagnostics :: [FileDiagnostic] -> Doc Terminal.AnsiStyle
98prettyDiagnostics = vcat . map prettyDiagnostic
100prettyDiagnostic :: FileDiagnostic -> Doc Terminal.AnsiStyle
101prettyDiagnostic (fp, LSP.Diagnostic{..}) =
102 vcat
103 [ slabel_ "File: " $ pretty (fromNormalizedFilePath fp)
104 , slabel_ "Range: " $ prettyRange _range
105 , slabel_ "Source: " $ pretty _source
106 , slabel_ "Severity:" $ pretty $ show sev
107 , slabel_ "Message: "
108 $ case sev of
109 LSP.DsError -> annotate $ color Red
110 LSP.DsWarning -> annotate $ color Yellow
111 LSP.DsInfo -> annotate $ color Blue
112 LSP.DsHint -> annotate $ color Magenta
113 $ stringParagraphs _message
114 , slabel_ "Code:" $ pretty _code
115 ]
116 where
117 sev = fromMaybe LSP.DsError _severity
119getDiagnosticsFromStore :: StoreItem -> [Diagnostic]
120getDiagnosticsFromStore (StoreItem _ diags) =
121 toList =<< Map.elems diags
124-- | Sets the diagnostics for a file and compilation step
125-- if you want to clear the diagnostics call this with an empty list
126setStageDiagnostics ::
127 NormalizedFilePath ->
128 Maybe Int ->
129 -- ^ the time that the file these diagnostics originate from was last edited
130 T.Text ->
131 [LSP.Diagnostic] ->
132 DiagnosticStore ->
133 DiagnosticStore
134setStageDiagnostics fp timeM stage diags ds =
135 updateDiagnostics ds uri timeM diagsBySource
136 where
137 diagsBySource = Map.singleton (Just stage) (SL.toSortedList diags)
138 uri = filePathToUri' fp
140getAllDiagnostics ::
141 DiagnosticStore ->
142 [FileDiagnostic]
143getAllDiagnostics =
144 concatMap (\(k,v) -> map (fromUri k,) $ getDiagnosticsFromStore v) . Map.toList
146getFileDiagnostics ::
147 NormalizedFilePath ->
148 DiagnosticStore ->
149 [LSP.Diagnostic]
150getFileDiagnostics fp ds =
151 maybe [] getDiagnosticsFromStore $
152 Map.lookup (filePathToUri' fp) ds
154filterDiagnostics ::
155 (NormalizedFilePath -> Bool) ->
156 DiagnosticStore ->
157 DiagnosticStore
158filterDiagnostics keep =
159 Map.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)
163-- | Label a document.
164slabel_ :: String -> Doc a -> Doc a
165slabel_ t d = nest 2 $ sep [pretty t, d]
167-- | The layout options used for the SDK assistant.
168cliLayout ::
169 Int
170 -- ^ Rendering width of the pretty printer.
171 -> LayoutOptions
172cliLayout renderWidth = LayoutOptions
173 { layoutPageWidth = AvailablePerLine renderWidth 0.9
174 }
176-- | Render without any syntax annotations
177srenderPlain :: Doc ann -> T.Text
178srenderPlain = renderStrict . layoutSmart (cliLayout defaultTermWidth)
180-- | Render a 'Document' as an ANSII colored string.
181srenderColored :: Doc Terminal.AnsiStyle -> T.Text
182srenderColored =
183 Terminal.renderStrict .
184 layoutSmart defaultLayoutOptions { layoutPageWidth = AvailablePerLine 100 1.0 }
186defaultTermWidth :: Int
187defaultTermWidth = 80