git.iko.soy/ghcide
on bbdcbdd help sign in
ghcide/src/Development/IDE/Types/Diagnostics.hs
139 lines 4.5 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 #-}
6module Development.IDE.Types.Diagnostics (
7 Diagnostic(..),
8 FileDiagnostics(..),
9 Location(..),
10 Range(..),
11 Severity(..),
12 Position(..),
13 noLocation,
14 noRange,
15 ideErrorText,
16 ideErrorPretty,
17 errorDiag,
18 ideTryIOException,
19 prettyFileDiagnostics,
20 prettyDiagnostic
21 ) where
23import Control.DeepSeq
24import Control.Exception
25import Data.Aeson (FromJSON, ToJSON)
26import Data.Either.Combinators
27import Data.List.Extra
28import qualified Data.Text as T
29import Data.Text.Prettyprint.Doc.Syntax
30import GHC.Generics
31import qualified Network.URI.Encode
32import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
34import Development.IDE.Types.Location
36ideErrorText :: FilePath -> T.Text -> Diagnostic
37ideErrorText absFile = errorDiag absFile "Ide Error"
39ideErrorPretty :: Pretty.Pretty e => FilePath -> e -> Diagnostic
40ideErrorPretty absFile = ideErrorText absFile . T.pack . Pretty.prettyShow
42errorDiag :: FilePath -> T.Text -> T.Text -> Diagnostic
43errorDiag fp src msg =
44 Diagnostic
45 { dFilePath = fp
46 , dRange = noRange
47 , dSeverity = Error
48 , dSource = src
49 , dMessage = msg
50 }
52ideTryIOException :: FilePath -> IO a -> IO (Either Diagnostic a)
53ideTryIOException fp act =
54 mapLeft (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e) <$> try act
56data Diagnostic = Diagnostic
57 { dFilePath :: !FilePath
58 -- ^ Specific file that the diagnostic refers to.
59 , dRange :: !Range
60 -- ^ The range to which the diagnostic applies.
61 , dSeverity :: !Severity
62 -- ^ The severity of the diagnostic, such as 'SError' or 'SWarning'.
63 , dSource :: !T.Text
64 -- ^ Human-readable description for the source of the diagnostic,
65 -- for example 'parser'.
66 , dMessage :: !T.Text
67 -- ^ The diagnostic's message.
68 }
69 deriving (Eq, Ord, Show, Generic)
71instance NFData Diagnostic
73-- | The diagnostic severity.
74data Severity
75 = Error | Warning
76 deriving (Eq, Ord, Show, Generic)
78instance NFData Severity
80-- | Human readable diagnostics for a specific file.
81--
82-- This type packages a pretty printed, human readable error message
83-- along with the related source location so that we can display the error
84-- on either the console or in the IDE at the right source location.
85--
86data FileDiagnostics = FileDiagnostics
87 { fdFilePath :: !FilePath
88 -- ^ Path of the module that we were trying to process.
89 -- In a multi-module program this is the file that we started
90 -- trying to compile, not necessarily the one in which we found the
91 -- reported errors or warnings.
92 , fdDiagnostics :: ![Diagnostic]
93 -- ^ Diagnostics for the desired module,
94 -- as well as any transitively imported modules.
95 }
96 deriving (Eq, Ord, Show, Generic)
98instance FromJSON Diagnostic
99instance ToJSON Diagnostic
101instance FromJSON Severity
102instance ToJSON Severity
104instance FromJSON FileDiagnostics
105instance ToJSON FileDiagnostics
107prettyFileDiagnostics :: FileDiagnostics -> Doc SyntaxClass
108prettyFileDiagnostics (FileDiagnostics filePath diagnostics) =
109 label_ "Compiler error in" $ vcat
110 [ label_ "File:" $ pretty filePath
111 , label_ "Errors:" $ vcat $ map prettyDiagnostic $ nubOrd diagnostics
112 ]
114stringParagraphs :: T.Text -> Doc a
115stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines
117prettyDiagnostic :: Diagnostic -> Doc SyntaxClass
118prettyDiagnostic (Diagnostic filePath range severity source msg) =
119 vcat
120 [ label_ "File: " $ pretty filePath
121 , label_ "Range: "
122 $ annotate (LinkSC uri title)
123 $ pretty range
124 , label_ "Source: " $ pretty source
125 , label_ "Severity:" $ pretty $ show severity
126 , label_ "Message: "
127 $ case severity of
128 Error -> annotate ErrorSC
129 Warning -> annotate WarningSC
130 $ stringParagraphs msg
131 ]
132 where
133 -- FIXME(JM): Move uri construction to DA.Pretty?
134 Position sline _ = rangeStart range
135 Position eline _ = rangeEnd range
136 uri = "command:daml.revealLocation?"
137 <> Network.URI.Encode.encodeText ("[\"file://" <> T.pack filePath <> "\","
138 <> T.pack (show sline) <> ", " <> T.pack (show eline) <> "]")
139 title = T.pack filePath