refactor crade error to use Path

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

@@ -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]

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

@@ -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

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

@@ -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 =

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

@@ -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]

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

@@ -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

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

@@ -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