@@ -8,6 +8,7 @@
88module Development.IDE.Types.Diagnostics (
99 LSP.Diagnostic(..),
1010 FileDiagnostics,
11+ FileDiagnostic,
1112 Location(..),
1213 Range(..),
1314 LSP.DiagnosticSeverity(..),
@@ -30,21 +31,17 @@ module Development.IDE.Types.Diagnostics (
3031 defDiagnostic,
3132 addDiagnostics,
3233 filterSeriousErrors,
33− dLocation,
34− dFilePath,
3534 filePathToUri,
3635 getDiagnosticsFromStore
3736 ) where
3837
3938import Control.Exception
40−import Control.Lens (Lens', lens, set, view)
4139import Data.Either.Combinators
4240import Data.Maybe as Maybe
4341import Data.Foldable
4442import qualified Data.Map as Map
4543import qualified Data.Text as T
4644import Data.Text.Prettyprint.Doc.Syntax
47−import Data.String (IsString(..))
4845import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
4946import Language.Haskell.LSP.Types as LSP (
5047 DiagnosticSeverity(..)
@@ -59,15 +56,15 @@ import Language.Haskell.LSP.Diagnostics
5956
6057import Development.IDE.Types.Location
6158
62−ideErrorText :: FilePath -> T.Text -> LSP.Diagnostic
59+ideErrorText :: FilePath -> T.Text -> FileDiagnostic
6360ideErrorText fp = errorDiag fp "Ide Error"
6461
65−ideErrorPretty :: Pretty.Pretty e => FilePath -> e -> LSP.Diagnostic
62+ideErrorPretty :: Pretty.Pretty e => FilePath -> e -> FileDiagnostic
6663ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow
6764
68−errorDiag :: FilePath -> T.Text -> T.Text -> LSP.Diagnostic
69−errorDiag fp src =
70− set dFilePath (Just fp) . diagnostic noRange LSP.DsError src
65+errorDiag :: FilePath -> T.Text -> T.Text -> FileDiagnostic
66+errorDiag fp src msg =
67+ (fp, diagnostic noRange LSP.DsError src msg)
7168
7269-- | This is for compatibility with our old diagnostic type
7370diagnostic :: Range
@@ -99,33 +96,6 @@ defDiagnostic _range _message = LSP.Diagnostic {
9996 , _relatedInformation = Nothing
10097 }
10198
102−-- | setLocation but with no range information
103−dFilePath ::
104− Lens' LSP.Diagnostic (Maybe FilePath)
105−dFilePath = lens g s where
106− g :: LSP.Diagnostic -> Maybe FilePath
107− g d = (uriToFilePath . _uri) =<< view dLocation d
108− s :: LSP.Diagnostic -> Maybe FilePath -> LSP.Diagnostic
109− s d@Diagnostic{..} fp = set dLocation
110− (Location <$> (filePathToUri <$> fp) <*> pure _range) d
111−
112−-- | This adds location information to the diagnostics but this is only used in
113−-- the case of serious errors to give some context to what went wrong
114−dLocation ::
115− Lens' LSP.Diagnostic (Maybe Location)
116−dLocation = lens g s where
117− s :: LSP.Diagnostic -> Maybe Location -> LSP.Diagnostic
118− s d = \case
119− Just loc ->
120− d {LSP._range=(_range :: Location -> Range) loc
121− , LSP._relatedInformation = Just $ LSP.List [DiagnosticRelatedInformation loc "dLocation: Unknown error"]}
122− Nothing -> d {LSP._range = noRange, LSP._relatedInformation = Nothing}
123− g :: LSP.Diagnostic -> Maybe Location
124− g Diagnostic{..} = case _relatedInformation of
125− Just (List [DiagnosticRelatedInformation loc _]) -> Just loc
126− Just (List xs) -> error $ "Diagnostic created, expected 1 related information but got" <> show xs
127− Nothing -> Nothing
128−
12999filterSeriousErrors ::
130100 FilePath ->
131101 [LSP.Diagnostic] ->
@@ -148,7 +118,7 @@ addDiagnostics fp diags ds =
148118 Nothing $
149119 partitionBySource diags
150120
151−ideTryIOException :: FilePath -> IO a -> IO (Either LSP.Diagnostic a)
121+ideTryIOException :: FilePath -> IO a -> IO (Either FileDiagnostic a)
152122ideTryIOException fp act =
153123 mapLeft (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e) <$> try act
154124
@@ -158,7 +128,8 @@ ideTryIOException fp act =
158128-- along with the related source location so that we can display the error
159129-- on either the console or in the IDE at the right source location.
160130--
161−type FileDiagnostics = (Uri, [Diagnostic])
131+type FileDiagnostics = (FilePath, [Diagnostic])
132+type FileDiagnostic = (FilePath, Diagnostic)
162133
163134prettyRange :: Range -> Doc SyntaxClass
164135prettyRange Range{..} = f _start <> "-" <> f _end
@@ -167,20 +138,20 @@ prettyRange Range{..} = f _start <> "-" <> f _end
167138stringParagraphs :: T.Text -> Doc a
168139stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines
169140
170−showDiagnostics :: [LSP.Diagnostic] -> T.Text
141+showDiagnostics :: [FileDiagnostic] -> T.Text
171142showDiagnostics = srenderPlain . prettyDiagnostics
172143
173−showDiagnosticsColored :: [LSP.Diagnostic] -> T.Text
144+showDiagnosticsColored :: [FileDiagnostic] -> T.Text
174145showDiagnosticsColored = srenderColored . prettyDiagnostics
175146
176147
177−prettyDiagnostics :: [LSP.Diagnostic] -> Doc SyntaxClass
148+prettyDiagnostics :: [FileDiagnostic] -> Doc SyntaxClass
178149prettyDiagnostics = vcat . map prettyDiagnostic
179150
180−prettyDiagnostic :: LSP.Diagnostic -> Doc SyntaxClass
181−prettyDiagnostic d@LSP.Diagnostic{..} =
151+prettyDiagnostic :: FileDiagnostic -> Doc SyntaxClass
152+prettyDiagnostic (fp, LSP.Diagnostic{..}) =
182153 vcat
183− [ slabel_ "File: " $ pretty $ view dFilePath d
154+ [ slabel_ "File: " $ pretty fp
184155 , slabel_ "Range: " $ prettyRange _range
185156 , slabel_ "Source: " $ pretty _source
186157 , slabel_ "Severity:" $ pretty $ show sev
@@ -199,38 +170,16 @@ prettyDiagnostic d@LSP.Diagnostic{..} =
199170prettyDiagnosticStore :: DiagnosticStore -> Doc SyntaxClass
200171prettyDiagnosticStore ds =
201172 vcat $
202− map prettyFileDiagnostics $
173+ map (\(uri, diags) -> prettyFileDiagnostics (fromMaybe noFilePath $ uriToFilePath uri, diags)) $
203174 Map.assocs $
204175 Map.map getDiagnosticsFromStore ds
205176
206177prettyFileDiagnostics :: FileDiagnostics -> Doc SyntaxClass
207−prettyFileDiagnostics (uri, diags) =
178+prettyFileDiagnostics (filePath, diags) =
208179 slabel_ "Compiler error in" $ vcat
209180 [ slabel_ "File:" $ pretty filePath
210− , slabel_ "Errors:" $ vcat $ map prettyDiagnostic diags
211− ] where
212−
213− -- prettyFileDiags :: (FilePath, [(T.Text, [LSP.Diagnostic])]) -> Doc SyntaxClass
214− -- prettyFileDiags (fp,stages) =
215− -- slabel_ ("File: "<>fp) $ vcat $ map prettyStage stages
216−
217− -- prettyStage :: (T.Text, [LSP.Diagnostic]) -> Doc SyntaxClass
218− -- prettyStage (stage,diags) =
219− -- slabel_ ("Stage: "<>T.unpack stage) $ vcat $ map prettyDiagnostic diags
220−
221− filePath :: FilePath
222− filePath = fromMaybe dontKnow $ uriToFilePath uri
223−
224− -- storeContents ::
225− -- (FilePath, [(T.Text, [LSP.Diagnostic])])
226− -- -- ^ Source File, Stage Source, Diags
227− -- storeContents = (fromMaybe dontKnow $ uriToFilePath uri, getDiags diags)
228−
229− dontKnow :: IsString s => s
230− dontKnow = "<unknown>"
231−
232− -- getDiags :: DiagnosticsBySource -> [(T.Text, [LSP.Diagnostic])]
233− -- getDiags = map (\(ds, diag) -> (fromMaybe dontKnow ds, toList diag)) . Map.assocs
181+ , slabel_ "Errors:" $ vcat $ map (prettyDiagnostic . (filePath,)) diags
182+ ]
234183
235184getDiagnosticsFromStore :: StoreItem -> [Diagnostic]
236185getDiagnosticsFromStore (StoreItem _ diags) =