mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-10-26 01:09:24 +03:00
refactor crade error to use Path
This commit is contained in:
parent
cd89602f63
commit
5c592f55a3
@ -10,6 +10,7 @@ import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Path
|
||||
import GHC.Generics
|
||||
import qualified HIE.Bios.Cradle as HieBios
|
||||
import HIE.Bios.Types hiding (Log)
|
||||
@ -26,7 +27,7 @@ data CradleErrorDetails =
|
||||
the cradle error occurred (of the file we attempted to load).
|
||||
Depicts the cradle error in a user-friendly way.
|
||||
-}
|
||||
renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic
|
||||
renderCradleError :: CradleError -> Cradle a -> Path Abs NormalizedFilePath -> FileDiagnostic
|
||||
renderCradleError (CradleError deps _ec ms) cradle nfp
|
||||
| HieBios.isCabalCradle cradle =
|
||||
let (fp, showDiag, diag) = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage in
|
||||
@ -42,7 +43,7 @@ renderCradleError (CradleError deps _ec ms) cradle nfp
|
||||
mkUnknownModuleMessage :: Maybe [String]
|
||||
mkUnknownModuleMessage
|
||||
| any (isInfixOf "Failed extracting script block:") ms =
|
||||
Just $ unknownModuleMessage (fromNormalizedFilePath nfp)
|
||||
Just $ unknownModuleMessage (fromNormalizedFilePath $ normalizeAbs nfp)
|
||||
| otherwise = Nothing
|
||||
|
||||
fileMissingMessage :: Maybe [String]
|
||||
|
@ -27,6 +27,7 @@ import qualified Data.Text as T
|
||||
import Development.IDE.GHC.Error
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Path
|
||||
import qualified GHC.LanguageExtensions as LangExt
|
||||
import qualified GHC.Runtime.Loader as Loader
|
||||
import GHC.Utils.Logger (LogFlags (..))
|
||||
@ -104,7 +105,7 @@ data CPPDiag
|
||||
|
||||
diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic]
|
||||
diagsFromCPPLogs filename logs =
|
||||
map (\d -> (toNormalizedFilePath' filename, ShowDiag, cppDiagToDiagnostic d)) $
|
||||
map (\d -> (mkAbsPath $ toNormalizedFilePath' filename, ShowDiag, cppDiagToDiagnostic d)) $
|
||||
go [] logs
|
||||
where
|
||||
-- On errors, CPP calls logAction with a real span for the initial log and
|
||||
|
@ -148,6 +148,7 @@ import Development.IDE.Types.KnownTargets
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Monitoring (Monitoring (..))
|
||||
import Development.IDE.Types.Options
|
||||
import Development.IDE.Types.Path
|
||||
import Development.IDE.Types.Shake
|
||||
import qualified Focus
|
||||
import GHC.Fingerprint
|
||||
@ -1204,7 +1205,7 @@ defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnost
|
||||
fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file"
|
||||
|
||||
defineEarlyCutoff'
|
||||
:: forall k v. IdeRule k v
|
||||
:: forall k v. (IdeRule k v, NFData v)
|
||||
=> (Maybe Int32 -> [FileDiagnostic] -> Action ()) -- ^ update diagnostics
|
||||
-- | compare current and previous for freshness
|
||||
-> (BS.ByteString -> BS.ByteString -> Bool)
|
||||
@ -1245,7 +1246,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do
|
||||
(mbBs, (diags, mbRes)) <- actionCatch
|
||||
(do v <- action staleV; liftIO $ evaluate $ force v) $
|
||||
\(e :: SomeException) -> do
|
||||
pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
|
||||
pure (Nothing, ([ideErrorText (mkAbsPath file) $ T.pack $ show e | not $ isBadDependency e],Nothing))
|
||||
|
||||
ver <- estimateFileVersionUnsafely key mbRes file
|
||||
(bs, res) <- case mbRes of
|
||||
@ -1354,7 +1355,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
|
||||
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
|
||||
let action = when (lastPublish /= newDiags) $ case lspEnv of
|
||||
Nothing -> -- Print an LSP event.
|
||||
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (fp, ShowDiag,) newDiags)
|
||||
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (mkAbsPath fp, ShowDiag,) newDiags)
|
||||
Just env -> LSP.runLspT env $ do
|
||||
liftIO $ tag "count" (show $ Prelude.length newDiags)
|
||||
liftIO $ tag "key" (show k)
|
||||
@ -1422,7 +1423,7 @@ getAllDiagnostics ::
|
||||
STMDiagnosticStore ->
|
||||
STM [FileDiagnostic]
|
||||
getAllDiagnostics =
|
||||
fmap (concatMap (\(k,v) -> map (fromUri k,ShowDiag,) $ getDiagnosticsFromStore v)) . ListT.toList . STM.listT
|
||||
fmap (concatMap (\(k,v) -> map (mkAbsPath $ fromUri k,ShowDiag,) $ getDiagnosticsFromStore v)) . ListT.toList . STM.listT
|
||||
|
||||
updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> STM ()
|
||||
updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes =
|
||||
|
@ -45,6 +45,7 @@ import qualified Development.IDE.GHC.Compat.Util as Compat
|
||||
import Development.IDE.GHC.Orphans ()
|
||||
import Development.IDE.Types.Diagnostics as D
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Path
|
||||
import GHC
|
||||
import Language.LSP.Protocol.Types (isSubrangeOf)
|
||||
import Language.LSP.VFS (CodePointPosition (CodePointPosition),
|
||||
@ -52,18 +53,21 @@ import Language.LSP.VFS (CodePointPosition (CodePoint
|
||||
|
||||
|
||||
diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
|
||||
diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc,ShowDiag,)
|
||||
Diagnostic
|
||||
{ _range = fromMaybe noRange $ srcSpanToRange loc
|
||||
, _severity = Just sev
|
||||
, _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
|
||||
, _message = msg
|
||||
, _code = Nothing
|
||||
, _relatedInformation = Nothing
|
||||
, _tags = Nothing
|
||||
, _codeDescription = Nothing
|
||||
, _data_ = Nothing
|
||||
}
|
||||
diagFromText diagSource sev loc msg = (filePath, ShowDiag,)
|
||||
Diagnostic
|
||||
{ _range = fromMaybe noRange $ srcSpanToRange loc
|
||||
, _severity = Just sev
|
||||
, _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
|
||||
, _message = msg
|
||||
, _code = Nothing
|
||||
, _relatedInformation = Nothing
|
||||
, _tags = Nothing
|
||||
, _codeDescription = Nothing
|
||||
, _data_ = Nothing
|
||||
}
|
||||
where
|
||||
normPath = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc
|
||||
filePath = mkAbsPath normPath
|
||||
|
||||
-- | Produce a GHC-style error from a source span and a message.
|
||||
diagFromErrMsg :: T.Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic]
|
||||
|
@ -20,6 +20,7 @@ import Data.ByteString (ByteString)
|
||||
import Data.Maybe as Maybe
|
||||
import qualified Data.Text as T
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Path
|
||||
import Language.LSP.Diagnostics
|
||||
import Language.LSP.Protocol.Types as LSP (Diagnostic (..),
|
||||
DiagnosticSeverity (..))
|
||||
@ -44,7 +45,7 @@ type IdeResult v = ([FileDiagnostic], Maybe v)
|
||||
-- | an IdeResult with a fingerprint
|
||||
type IdeResultNoDiagnosticsEarlyCutoff v = (Maybe ByteString, Maybe v)
|
||||
|
||||
ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
|
||||
ideErrorText :: Path Abs NormalizedFilePath -> T.Text -> FileDiagnostic
|
||||
ideErrorText = ideErrorWithSource (Just "compiler") (Just DiagnosticSeverity_Error)
|
||||
|
||||
ideErrorWithSource
|
||||
@ -86,7 +87,7 @@ instance NFData ShowDiagnostic where
|
||||
-- along with the related source location so that we can display the error
|
||||
-- on either the console or in the IDE at the right source location.
|
||||
--
|
||||
type FileDiagnostic = (NormalizedFilePath, ShowDiagnostic, Diagnostic)
|
||||
type FileDiagnostic = (Path Abs NormalizedFilePath, ShowDiagnostic, Diagnostic)
|
||||
|
||||
prettyRange :: Range -> Doc Terminal.AnsiStyle
|
||||
prettyRange Range{..} = f _start <> "-" <> f _end
|
||||
@ -108,7 +109,7 @@ prettyDiagnostics = vcat . map prettyDiagnostic
|
||||
prettyDiagnostic :: FileDiagnostic -> Doc Terminal.AnsiStyle
|
||||
prettyDiagnostic (fp, sh, LSP.Diagnostic{..}) =
|
||||
vcat
|
||||
[ slabel_ "File: " $ pretty (fromNormalizedFilePath fp)
|
||||
[ slabel_ "File: " $ pretty (fromNormalizedFilePath $ normalizeAbs fp)
|
||||
, slabel_ "Hidden: " $ if sh == ShowDiag then "no" else "yes"
|
||||
, slabel_ "Range: " $ prettyRange _range
|
||||
, slabel_ "Source: " $ pretty _source
|
||||
|
@ -1,11 +1,18 @@
|
||||
module Development.IDE.Types.Path
|
||||
()
|
||||
(Abs, Rel, normalizeAbs, mkAbsPath, Path)
|
||||
where
|
||||
|
||||
import Development.IDE (NormalizedFilePath)
|
||||
import Language.LSP.Protocol.Types
|
||||
|
||||
|
||||
data Abs
|
||||
data Rel
|
||||
|
||||
newtype Path a = Path { getRawPath :: NormalizedFilePath}
|
||||
newtype Path a b = MkPath { getRawPath :: b } deriving (Eq, Show)
|
||||
|
||||
normalizeAbs :: Path Abs NormalizedFilePath -> NormalizedFilePath
|
||||
normalizeAbs = getRawPath
|
||||
|
||||
-- | TODO: guarantee that path is absolute
|
||||
mkAbsPath :: NormalizedFilePath -> Path Abs NormalizedFilePath
|
||||
mkAbsPath path = MkPath path
|
||||
|
Loading…
Reference in New Issue
Block a user