git.iko.soy/ghcide
on 0336e41 help sign in
ghcide/src/Development/IDE/Types/Diagnostics.hs
119 lines 3.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 List(..),
12 ideErrorText,
13 ideErrorPretty,
14 showDiagnostics,
15 showDiagnosticsColored,
16 ) where
18import Data.Maybe as Maybe
19import qualified Data.Text as T
20import Data.Text.Prettyprint.Doc
21import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
22import qualified Language.Haskell.LSP.Types as LSP
23import Language.Haskell.LSP.Types as LSP (
24 DiagnosticSeverity(..)
25 , Diagnostic(..)
26 , List(..)
27 )
28import Language.Haskell.LSP.Diagnostics
29import Data.Text.Prettyprint.Doc.Render.Text
30import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal
31import Data.Text.Prettyprint.Doc.Render.Terminal (Color(..), color)
33import Development.IDE.Types.Location
36ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
37ideErrorText fp msg = (fp, LSP.Diagnostic {
38 _range = noRange,
39 _severity = Just LSP.DsError,
40 _code = Nothing,
41 _source = Just "compiler",
42 _message = msg,
43 _relatedInformation = Nothing
44 })
46ideErrorPretty :: Pretty.Pretty e => NormalizedFilePath -> e -> FileDiagnostic
47ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow
50-- | Human readable diagnostics for a specific file.
51--
52-- This type packages a pretty printed, human readable error message
53-- along with the related source location so that we can display the error
54-- on either the console or in the IDE at the right source location.
55--
56type FileDiagnostic = (NormalizedFilePath, Diagnostic)
58prettyRange :: Range -> Doc Terminal.AnsiStyle
59prettyRange Range{..} = f _start <> "-" <> f _end
60 where f Position{..} = pretty (_line+1) <> colon <> pretty _character
62stringParagraphs :: T.Text -> Doc a
63stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines
65showDiagnostics :: [FileDiagnostic] -> T.Text
66showDiagnostics = srenderPlain . prettyDiagnostics
68showDiagnosticsColored :: [FileDiagnostic] -> T.Text
69showDiagnosticsColored = srenderColored . prettyDiagnostics
72prettyDiagnostics :: [FileDiagnostic] -> Doc Terminal.AnsiStyle
73prettyDiagnostics = vcat . map prettyDiagnostic
75prettyDiagnostic :: FileDiagnostic -> Doc Terminal.AnsiStyle
76prettyDiagnostic (fp, LSP.Diagnostic{..}) =
77 vcat
78 [ slabel_ "File: " $ pretty (fromNormalizedFilePath fp)
79 , slabel_ "Range: " $ prettyRange _range
80 , slabel_ "Source: " $ pretty _source
81 , slabel_ "Severity:" $ pretty $ show sev
82 , slabel_ "Message: "
83 $ case sev of
84 LSP.DsError -> annotate $ color Red
85 LSP.DsWarning -> annotate $ color Yellow
86 LSP.DsInfo -> annotate $ color Blue
87 LSP.DsHint -> annotate $ color Magenta
88 $ stringParagraphs _message
89 , slabel_ "Code:" $ pretty _code
90 ]
91 where
92 sev = fromMaybe LSP.DsError _severity
95-- | Label a document.
96slabel_ :: String -> Doc a -> Doc a
97slabel_ t d = nest 2 $ sep [pretty t, d]
99-- | The layout options used for the SDK assistant.
100cliLayout ::
101 Int
102 -- ^ Rendering width of the pretty printer.
103 -> LayoutOptions
104cliLayout renderWidth = LayoutOptions
105 { layoutPageWidth = AvailablePerLine renderWidth 0.9
106 }
108-- | Render without any syntax annotations
109srenderPlain :: Doc ann -> T.Text
110srenderPlain = renderStrict . layoutSmart (cliLayout defaultTermWidth)
112-- | Render a 'Document' as an ANSII colored string.
113srenderColored :: Doc Terminal.AnsiStyle -> T.Text
114srenderColored =
115 Terminal.renderStrict .
116 layoutSmart defaultLayoutOptions { layoutPageWidth = AvailablePerLine 100 1.0 }
118defaultTermWidth :: Int
119defaultTermWidth = 80