Skip to content

Commit 5c592f5

Browse files
komikatkomikat
committed
refactor crade error to use Path
1 parent cd89602 commit 5c592f5

File tree

6 files changed

+40
-25
lines changed

6 files changed

+40
-25
lines changed

‎ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ import Data.Maybe
1010
import qualified Data.Text as T
1111
import Development.IDE.Types.Diagnostics
1212
import Development.IDE.Types.Location
13+
import Development.IDE.Types.Path
1314
import GHC.Generics
1415
import qualified HIE.Bios.Cradle as HieBios
1516
import HIE.Bios.Types hiding (Log)
@@ -26,7 +27,7 @@ data CradleErrorDetails =
2627
the cradle error occurred (of the file we attempted to load).
2728
Depicts the cradle error in a user-friendly way.
2829
-}
29-
renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic
30+
renderCradleError :: CradleError -> Cradle a -> Path Abs NormalizedFilePath -> FileDiagnostic
3031
renderCradleError (CradleError deps _ec ms) cradle nfp
3132
| HieBios.isCabalCradle cradle =
3233
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
4243
mkUnknownModuleMessage :: Maybe [String]
4344
mkUnknownModuleMessage
4445
| any (isInfixOf "Failed extracting script block:") ms =
45-
Just $ unknownModuleMessage (fromNormalizedFilePath nfp)
46+
Just $ unknownModuleMessage (fromNormalizedFilePath $ normalizeAbs nfp)
4647
| otherwise = Nothing
4748

4849
fileMissingMessage :: Maybe [String]

‎ghcide/src/Development/IDE/Core/Preprocessor.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import qualified Data.Text as T
2727
import Development.IDE.GHC.Error
2828
import Development.IDE.Types.Diagnostics
2929
import Development.IDE.Types.Location
30+
import Development.IDE.Types.Path
3031
import qualified GHC.LanguageExtensions as LangExt
3132
import qualified GHC.Runtime.Loader as Loader
3233
import GHC.Utils.Logger (LogFlags (..))
@@ -104,7 +105,7 @@ data CPPDiag
104105

105106
diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic]
106107
diagsFromCPPLogs filename logs =
107-
map (\d -> (toNormalizedFilePath' filename, ShowDiag, cppDiagToDiagnostic d)) $
108+
map (\d -> (mkAbsPath $ toNormalizedFilePath' filename, ShowDiag, cppDiagToDiagnostic d)) $
108109
go [] logs
109110
where
110111
-- On errors, CPP calls logAction with a real span for the initial log and

‎ghcide/src/Development/IDE/Core/Shake.hs

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -148,6 +148,7 @@ import Development.IDE.Types.KnownTargets
148148
import Development.IDE.Types.Location
149149
import Development.IDE.Types.Monitoring (Monitoring (..))
150150
import Development.IDE.Types.Options
151+
import Development.IDE.Types.Path
151152
import Development.IDE.Types.Shake
152153
import qualified Focus
153154
import GHC.Fingerprint
@@ -1204,7 +1205,7 @@ defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnost
12041205
fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file"
12051206

12061207
defineEarlyCutoff'
1207-
:: forall k v. IdeRule k v
1208+
:: forall k v. (IdeRule k v, NFData v)
12081209
=> (Maybe Int32 -> [FileDiagnostic] -> Action ()) -- ^ update diagnostics
12091210
-- | compare current and previous for freshness
12101211
-> (BS.ByteString -> BS.ByteString -> Bool)
@@ -1245,7 +1246,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do
12451246
(mbBs, (diags, mbRes)) <- actionCatch
12461247
(do v <- action staleV; liftIO $ evaluate $ force v) $
12471248
\(e :: SomeException) -> do
1248-
pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
1249+
pure (Nothing, ([ideErrorText (mkAbsPath file) $ T.pack $ show e | not $ isBadDependency e],Nothing))
12491250

12501251
ver <- estimateFileVersionUnsafely key mbRes file
12511252
(bs, res) <- case mbRes of
@@ -1354,7 +1355,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
13541355
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
13551356
let action = when (lastPublish /= newDiags) $ case lspEnv of
13561357
Nothing -> -- Print an LSP event.
1357-
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (fp, ShowDiag,) newDiags)
1358+
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (mkAbsPath fp, ShowDiag,) newDiags)
13581359
Just env -> LSP.runLspT env $ do
13591360
liftIO $ tag "count" (show $ Prelude.length newDiags)
13601361
liftIO $ tag "key" (show k)
@@ -1422,7 +1423,7 @@ getAllDiagnostics ::
14221423
STMDiagnosticStore ->
14231424
STM [FileDiagnostic]
14241425
getAllDiagnostics =
1425-
fmap (concatMap (\(k,v) -> map (fromUri k,ShowDiag,) $ getDiagnosticsFromStore v)) . ListT.toList . STM.listT
1426+
fmap (concatMap (\(k,v) -> map (mkAbsPath $ fromUri k,ShowDiag,) $ getDiagnosticsFromStore v)) . ListT.toList . STM.listT
14261427

14271428
updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> STM ()
14281429
updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes =

‎ghcide/src/Development/IDE/GHC/Error.hs

Lines changed: 16 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -45,25 +45,29 @@ import qualified Development.IDE.GHC.Compat.Util as Compat
4545
import Development.IDE.GHC.Orphans ()
4646
import Development.IDE.Types.Diagnostics as D
4747
import Development.IDE.Types.Location
48+
import Development.IDE.Types.Path
4849
import GHC
4950
import Language.LSP.Protocol.Types (isSubrangeOf)
5051
import Language.LSP.VFS (CodePointPosition (CodePointPosition),
5152
CodePointRange (CodePointRange))
5253

5354

5455
diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
55-
diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc,ShowDiag,)
56-
Diagnostic
57-
{ _range = fromMaybe noRange $ srcSpanToRange loc
58-
, _severity = Just sev
59-
, _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
60-
, _message = msg
61-
, _code = Nothing
62-
, _relatedInformation = Nothing
63-
, _tags = Nothing
64-
, _codeDescription = Nothing
65-
, _data_ = Nothing
66-
}
56+
diagFromText diagSource sev loc msg = (filePath, ShowDiag,)
57+
Diagnostic
58+
{ _range = fromMaybe noRange $ srcSpanToRange loc
59+
, _severity = Just sev
60+
, _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
61+
, _message = msg
62+
, _code = Nothing
63+
, _relatedInformation = Nothing
64+
, _tags = Nothing
65+
, _codeDescription = Nothing
66+
, _data_ = Nothing
67+
}
68+
where
69+
normPath = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc
70+
filePath = mkAbsPath normPath
6771

6872
-- | Produce a GHC-style error from a source span and a message.
6973
diagFromErrMsg :: T.Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic]

‎ghcide/src/Development/IDE/Types/Diagnostics.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import Data.ByteString (ByteString)
2020
import Data.Maybe as Maybe
2121
import qualified Data.Text as T
2222
import Development.IDE.Types.Location
23+
import Development.IDE.Types.Path
2324
import Language.LSP.Diagnostics
2425
import Language.LSP.Protocol.Types as LSP (Diagnostic (..),
2526
DiagnosticSeverity (..))
@@ -44,7 +45,7 @@ type IdeResult v = ([FileDiagnostic], Maybe v)
4445
-- | an IdeResult with a fingerprint
4546
type IdeResultNoDiagnosticsEarlyCutoff v = (Maybe ByteString, Maybe v)
4647

47-
ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic
48+
ideErrorText :: Path Abs NormalizedFilePath -> T.Text -> FileDiagnostic
4849
ideErrorText = ideErrorWithSource (Just "compiler") (Just DiagnosticSeverity_Error)
4950

5051
ideErrorWithSource
@@ -86,7 +87,7 @@ instance NFData ShowDiagnostic where
8687
-- along with the related source location so that we can display the error
8788
-- on either the console or in the IDE at the right source location.
8889
--
89-
type FileDiagnostic = (NormalizedFilePath, ShowDiagnostic, Diagnostic)
90+
type FileDiagnostic = (Path Abs NormalizedFilePath, ShowDiagnostic, Diagnostic)
9091

9192
prettyRange :: Range -> Doc Terminal.AnsiStyle
9293
prettyRange Range{..} = f _start <> "-" <> f _end
@@ -108,7 +109,7 @@ prettyDiagnostics = vcat . map prettyDiagnostic
108109
prettyDiagnostic :: FileDiagnostic -> Doc Terminal.AnsiStyle
109110
prettyDiagnostic (fp, sh, LSP.Diagnostic{..}) =
110111
vcat
111-
[ slabel_ "File: " $ pretty (fromNormalizedFilePath fp)
112+
[ slabel_ "File: " $ pretty (fromNormalizedFilePath $ normalizeAbs fp)
112113
, slabel_ "Hidden: " $ if sh == ShowDiag then "no" else "yes"
113114
, slabel_ "Range: " $ prettyRange _range
114115
, slabel_ "Source: " $ pretty _source

‎ghcide/src/Development/IDE/Types/Path.hs

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,18 @@
11
module Development.IDE.Types.Path
2-
()
2+
(Abs, Rel, normalizeAbs, mkAbsPath, Path)
33
where
44

5-
import Development.IDE (NormalizedFilePath)
5+
import Language.LSP.Protocol.Types
6+
67

78
data Abs
89
data Rel
910

10-
newtype Path a = Path { getRawPath :: NormalizedFilePath}
11+
newtype Path a b = MkPath { getRawPath :: b } deriving (Eq, Show)
12+
13+
normalizeAbs :: Path Abs NormalizedFilePath -> NormalizedFilePath
14+
normalizeAbs = getRawPath
1115

16+
-- | TODO: guarantee that path is absolute
17+
mkAbsPath :: NormalizedFilePath -> Path Abs NormalizedFilePath
18+
mkAbsPath path = MkPath path

0 commit comments

Comments
 (0)