@@ -7,38 +7,17 @@
77{-# LANGUAGE BlockArguments #-}
88module Development.IDE.Types.Diagnostics (
99 LSP.Diagnostic(..),
10− FileDiagnostics,
1110 FileDiagnostic,
12− Location(..),
13− Range(..),
1411 LSP.DiagnosticSeverity(..),
15− Position(..),
1612 DiagnosticStore,
1713 DiagnosticRelatedInformation(..),
1814 List(..),
1915 StoreItem(..),
20− Uri(..),
21− NormalizedUri,
22− LSP.toNormalizedUri,
23− LSP.fromNormalizedUri,
24− NormalizedFilePath,
25− toNormalizedFilePath,
26− fromNormalizedFilePath,
27− noLocation,
28− noRange,
29− noFilePath,
3016 ideErrorText,
3117 ideErrorPretty,
3218 errorDiag,
33− ideTryIOException,
3419 showDiagnostics,
3520 showDiagnosticsColored,
36− defDiagnostic,
37− filePathToUri,
38− filePathToUri',
39− uriToFilePath',
40− ProjectDiagnostics,
41− emptyDiagnostics,
4221 setStageDiagnostics,
4322 getAllDiagnostics,
4423 filterDiagnostics,
@@ -46,66 +25,24 @@ module Development.IDE.Types.Diagnostics (
4625 prettyDiagnostics
4726 ) where
4827
49−import Control.DeepSeq
50−import Control.Exception
51−import Data.Either.Combinators
5228import Data.Maybe as Maybe
5329import Data.Foldable
54−import Data.Hashable
5530import qualified Data.Map as Map
56−import Data.String
5731import qualified Data.Text as T
5832import Data.Text.Prettyprint.Doc.Syntax
5933import qualified Data.SortedList as SL
60−import System.FilePath
6134import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
6235import qualified Language.Haskell.LSP.Types as LSP
6336import Language.Haskell.LSP.Types as LSP (
6437 DiagnosticSeverity(..)
6538 , Diagnostic(..)
66− , filePathToUri
6739 , List(..)
6840 , DiagnosticRelatedInformation(..)
69− , NormalizedUri(..)
70− , Uri(..)
71− , toNormalizedUri
72− , fromNormalizedUri
7341 )
7442import Language.Haskell.LSP.Diagnostics
7543
7644import Development.IDE.Types.Location
7745
78−-- | Newtype wrapper around FilePath that always has normalized slashes.
79−newtype NormalizedFilePath = NormalizedFilePath FilePath
80− deriving (Eq, Ord, Show, Hashable, NFData)
81−
82−instance IsString NormalizedFilePath where
83− fromString = toNormalizedFilePath
84−
85−toNormalizedFilePath :: FilePath -> NormalizedFilePath
86−toNormalizedFilePath "" = NormalizedFilePath ""
87−toNormalizedFilePath fp = NormalizedFilePath $ normalise' fp
88− where
89− -- We do not use System.FilePath’s normalise here since that
90− -- also normalises things like the case of the drive letter
91− -- which NormalizedUri does not normalise so we get VFS lookup failures.
92− normalise' :: FilePath -> FilePath
93− normalise' = map (\c -> if isPathSeparator c then pathSeparator else c)
94−
95−fromNormalizedFilePath :: NormalizedFilePath -> FilePath
96−fromNormalizedFilePath (NormalizedFilePath fp) = fp
97−
98−-- | We use an empty string as a filepath when we don’t have a file.
99−-- However, haskell-lsp doesn’t support that in uriToFilePath and given
100−-- that it is not a valid filepath it does not make sense to upstream a fix.
101−-- So we have our own wrapper here that supports empty filepaths.
102−uriToFilePath' :: Uri -> Maybe FilePath
103−uriToFilePath' uri
104− | uri == filePathToUri "" = Just ""
105− | otherwise = LSP.uriToFilePath uri
106−
107−filePathToUri' :: NormalizedFilePath -> NormalizedUri
108−filePathToUri' = toNormalizedUri . filePathToUri . fromNormalizedFilePath
10946
11047ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
11148ideErrorText fp = errorDiag fp "Ide Error"
@@ -133,25 +70,6 @@ diagnostic rng sev src msg
13370 _relatedInformation = Nothing
13471 }
13572
136−-- | Any optional field is instantiated to Nothing
137−defDiagnostic ::
138− Range ->
139− T.Text -> -- ^ error message
140− LSP.Diagnostic
141−defDiagnostic _range _message = LSP.Diagnostic {
142− _range
143− , _message
144− , _severity = Nothing
145− , _code = Nothing
146− , _source = Nothing
147− , _relatedInformation = Nothing
148− }
149−
150−ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
151−ideTryIOException fp act =
152− mapLeft
153− (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e)
154− <$> try act
15573
15674-- | Human readable diagnostics for a specific file.
15775--
@@ -159,7 +77,6 @@ ideTryIOException fp act =
15977-- along with the related source location so that we can display the error
16078-- on either the console or in the IDE at the right source location.
16179--
162−type FileDiagnostics = (NormalizedFilePath, [Diagnostic])
16380type FileDiagnostic = (NormalizedFilePath, Diagnostic)
16481
16582prettyRange :: Range -> Doc SyntaxClass
@@ -202,55 +119,40 @@ getDiagnosticsFromStore :: StoreItem -> [Diagnostic]
202119getDiagnosticsFromStore (StoreItem _ diags) =
203120 toList =<< Map.elems diags
204121
205−-- | This represents every diagnostic in a LSP project, the stage type variable is
206−-- the type of the compiler stages, in this project that is always the Key data
207−-- type found in Development.IDE.State.Shake
208−newtype ProjectDiagnostics stage = ProjectDiagnostics {getStore :: DiagnosticStore}
209− deriving Show
210−
211−emptyDiagnostics :: ProjectDiagnostics stage
212−emptyDiagnostics = ProjectDiagnostics mempty
213122
214123-- | Sets the diagnostics for a file and compilation step
215124-- if you want to clear the diagnostics call this with an empty list
216125setStageDiagnostics ::
217− Show stage =>
218126 NormalizedFilePath ->
219127 Maybe Int ->
220128 -- ^ the time that the file these diagnostics originate from was last edited
221− stage ->
129+ T.Text ->
222130 [LSP.Diagnostic] ->
223− ProjectDiagnostics stage ->
224− ProjectDiagnostics stage
225−setStageDiagnostics fp timeM stage diags (ProjectDiagnostics ds) =
226− ProjectDiagnostics $ updateDiagnostics ds uri timeM diagsBySource
131+ DiagnosticStore ->
132+ DiagnosticStore
133+setStageDiagnostics fp timeM stage diags ds =
134+ updateDiagnostics ds uri timeM diagsBySource
227135 where
228− diagsBySource = Map.singleton (Just $ T.pack $ show stage) (SL.toSortedList diags)
136+ diagsBySource = Map.singleton (Just stage) (SL.toSortedList diags)
229137 uri = filePathToUri' fp
230138
231−fromUri :: LSP.NormalizedUri -> NormalizedFilePath
232−fromUri = toNormalizedFilePath . fromMaybe noFilePath . uriToFilePath' . fromNormalizedUri
233−
234139getAllDiagnostics ::
235− ProjectDiagnostics stage ->
140+ DiagnosticStore ->
236141 [FileDiagnostic]
237142getAllDiagnostics =
238− concatMap (\(k,v) -> map (fromUri k,) $ getDiagnosticsFromStore v) . Map.toList . getStore
143+ concatMap (\(k,v) -> map (fromUri k,) $ getDiagnosticsFromStore v) . Map.toList
239144
240145getFileDiagnostics ::
241146 NormalizedFilePath ->
242− ProjectDiagnostics stage ->
147+ DiagnosticStore ->
243148 [LSP.Diagnostic]
244149getFileDiagnostics fp ds =
245150 maybe [] getDiagnosticsFromStore $
246− Map.lookup (filePathToUri' fp) $
247− getStore ds
151+ Map.lookup (filePathToUri' fp) ds
248152
249153filterDiagnostics ::
250154 (NormalizedFilePath -> Bool) ->
251− ProjectDiagnostics stage ->
252− ProjectDiagnostics stage
155+ DiagnosticStore ->
156+ DiagnosticStore
253157filterDiagnostics keep =
254− ProjectDiagnostics .
255− Map.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri) .
256− getStore
158+ Map.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)