use OsPath based NormalizedFilePath

Author: kokobd

cabal.project

@@ -64,6 +64,28 @@ source-repository-package
   tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460
   -- https://github.com/tibbe/ekg-json/pull/12
 
+-- TODO: remove these source-repository-package
+source-repository-package
+  type: git
+  location: https://github.com/kokobd/lsp
+  -- kokobd/os-path
+  tag: 99452008e5f0f9147c7ff290ace122870487b3b5
+  subdir: lsp
+
+source-repository-package
+  type: git
+  location: https://github.com/kokobd/lsp
+  -- kokobd/os-path
+  tag: 99452008e5f0f9147c7ff290ace122870487b3b5
+  subdir: lsp-types
+
+source-repository-package
+  type: git
+  location: https://github.com/kokobd/lsp
+  -- kokobd/os-path
+  tag: 99452008e5f0f9147c7ff290ace122870487b3b5
+  subdir: lsp-test
+
 allow-newer:
   -- ghc-9.2
   ----------

docs/contributing/plugin-tutorial.md

@@ -160,7 +160,7 @@ type instance RuleResult GetModSummary = ModSummary
 
 The `use` family of combinators allow to request rule results. For example, the following code is used in the Eval plugin to request a GHC session and a module summary (for the imports) in order to set up an interactive evaluation environment
 ```haskell
-  let nfp = toNormalizedFilePath' fp
+  let nfp = unsafeToNormalizedFilePath' fp
   session <- runAction "runEvalCmd.ghcSession" state $ use_ GhcSessionDeps nfp
   ms <- runAction "runEvalCmd.getModSummary" state $ use_ GetModSummary nfp
 ```

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

@@ -636,11 +636,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
                  InstallationMismatch{..} ->
                      return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
                  InstallationChecked _compileTime _ghcLibCheck ->
-                   session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
+                   session (hieYaml, unsafeToNormalizedFilePath' cfp, opts, libDir)
              -- Failure case, either a cradle error or the none cradle
              Left err -> do
                dep_info <- getDependencyInfo (maybeToList hieYaml)
-               let ncfp = toNormalizedFilePath' cfp
+               let ncfp = unsafeToNormalizedFilePath' cfp
                let res = (map (renderCradleError ncfp) err, Nothing)
                void $ modifyVar' fileToFlags $
                     Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info))
@@ -654,7 +654,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
         sessionOpts (hieYaml, file) = do
           v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags
           cfp <- makeAbsolute file
-          case HM.lookup (toNormalizedFilePath' cfp) v of
+          case HM.lookup (unsafeToNormalizedFilePath' cfp) v of
             Just (opts, old_di) -> do
               deps_ok <- checkDependencyInfo old_di
               if not deps_ok
@@ -674,7 +674,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
     -- before attempting to do so.
     let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
         getOptions file = do
-            ncfp <- toNormalizedFilePath' <$> makeAbsolute file
+            ncfp <- unsafeToNormalizedFilePath' <$> makeAbsolute file
             cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap
             hieYaml <- cradleLoc file
             sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e ->
@@ -745,11 +745,11 @@ fromTargetId is exts (GHC.TargetModule mod) env dep = do
               , i <- is
               , boot <- ["", "-boot"]
               ]
-    locs <- mapM (fmap toNormalizedFilePath' . makeAbsolute) fps
+    locs <- mapM (fmap unsafeToNormalizedFilePath' . makeAbsolute) fps
     return [TargetDetails (TargetModule mod) env dep locs]
 -- For a 'TargetFile' we consider all the possible module names
 fromTargetId _ _ (GHC.TargetFile f _) env deps = do
-    nf <- toNormalizedFilePath' <$> makeAbsolute f
+    nf <- unsafeToNormalizedFilePath' <$> makeAbsolute f
     return [TargetDetails (TargetFile nf) env deps [nf]]
 
 toFlagsMap :: TargetDetails -> [(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))]
@@ -1080,4 +1080,4 @@ showPackageSetupException (PackageCheckFailed BasePackageAbiMismatch{..}) = unwo
 
 renderPackageSetupException :: FilePath -> PackageSetupException -> (NormalizedFilePath, ShowDiagnostic, Diagnostic)
 renderPackageSetupException fp e =
-    ideErrorWithSource (Just "cradle") (Just DsError) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e)
+    ideErrorWithSource (Just "cradle") (Just DsError) (unsafeToNormalizedFilePath' fp) (T.pack $ showPackageSetupException e)

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

@@ -157,7 +157,7 @@ computePackageDeps
     -> IO (Either [FileDiagnostic] [UnitId])
 computePackageDeps env pkg = do
     case lookupUnit env pkg of
-        Nothing -> return $ Left [ideErrorText (toNormalizedFilePath' noFilePath) $
+        Nothing -> return $ Left [ideErrorText (unsafeToNormalizedFilePath' noFilePath) $
             T.pack $ "unknown package: " ++ show pkg]
         Just pkgInfo -> return $ Right $ unitDepends pkgInfo
 
@@ -285,7 +285,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
                   -- Non det OK as we will put it into maps later anyway
                  mods_transitive_list = nonDetEltsUniqSet mods_transitive
 
-           ; lbs <- getLinkables [toNormalizedFilePath' file | mod <- mkHomeModule
+           ; lbs <- getLinkables [unsafeToNormalizedFilePath' file | mod <- mkHomeModule
 #if MIN_VERSION_ghc(9,0,0)
                                                                       (hscHomeUnit hsc_env)
 #else
@@ -678,7 +678,7 @@ atomicFileWrite se targetPath write = do
   let dir = takeDirectory targetPath
   createDirectoryIfMissing True dir
   (tempFilePath, cleanUp) <- newTempFileWithin dir
-  (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> atomically (resetInterfaceStore se (toNormalizedFilePath' targetPath)) >> pure x)
+  (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> atomically (resetInterfaceStore se (unsafeToNormalizedFilePath' targetPath)) >> pure x)
     `onException` cleanUp
 
 generateHieAsts :: HscEnv -> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type))
@@ -1259,7 +1259,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do
 
     mb_dest_version <- case mb_old_version of
       Just ver -> pure $ Just ver
-      Nothing  -> get_file_version (toNormalizedFilePath' iface_file)
+      Nothing  -> get_file_version (unsafeToNormalizedFilePath' iface_file)
 
     -- The source is modified if it is newer than the destination (iface file)
     -- A more precise check for the core file is performed later
@@ -1343,7 +1343,7 @@ checkLinkableDependencies get_linkable_hashes graph runtime_deps = do
       go (mod, hash) = do
         ms <- mgLookupModule graph mod
         let hs = fromJust $ ml_hs_file $ ms_location ms
-        pure (toNormalizedFilePath' hs, hash)
+        pure (unsafeToNormalizedFilePath' hs, hash)
   case hs_files of
     Nothing -> error "invalid module graph"
     Just fs -> do

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

@@ -95,7 +95,7 @@ data CPPDiag
 
 diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic]
 diagsFromCPPLogs filename logs =
-  map (\d -> (toNormalizedFilePath' filename, ShowDiag, cppDiagToDiagnostic d)) $
+  map (\d -> (unsafeToNormalizedFilePath' 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/Rules.hs

@@ -297,7 +297,7 @@ getParsedModuleRule recorder =
                   -- by us and not the user, so our IDE shouldn't stop working because of it.
                   _ -> pure (diagsM, res)
     -- Add dependencies on included files
-    _ <- uses GetModificationTime $ map toNormalizedFilePath' (maybe [] pm_extra_src_files pmod)
+    _ <- uses GetModificationTime $ map unsafeToNormalizedFilePath' (maybe [] pm_extra_src_files pmod)
     pure res
 
 withOptHaddock :: ModSummary -> ModSummary
@@ -401,7 +401,7 @@ getLocatedImportsRule recorder =
         {- IS THIS REALLY NEEDED? DOESNT SEEM SO
 
         -- does this module have an hs-boot file? If so add a direct dependency
-        let bootPath = toNormalizedFilePath' $ fromNormalizedFilePath file <.> "hs-boot"
+        let bootPath = unsafeToNormalizedFilePath' $ fromNormalizedFilePath file <.> "hs-boot"
         boot <- use GetFileExists bootPath
         bootArtifact <- if boot == Just True
               then do
@@ -514,7 +514,7 @@ rawDependencyInformation fs = do
     updateBootMap pm boot_mod_id ArtifactsLocation{..} bm =
       if not artifactIsSource
         then
-          let msource_mod_id = lookupPathToId (rawPathIdMap pm) (toNormalizedFilePath' $ dropBootSuffix $ fromNormalizedFilePath artifactFilePath)
+          let msource_mod_id = lookupPathToId (rawPathIdMap pm) (unsafeToNormalizedFilePath' $ dropBootSuffix $ fromNormalizedFilePath artifactFilePath)
           in case msource_mod_id of
                Just source_mod_id -> insertBootId source_mod_id (FilePathId boot_mod_id) bm
                Nothing -> bm
@@ -557,7 +557,7 @@ reportImportCyclesRule recorder =
             , _tags = Nothing
             }
             where rng = fromMaybe noRange $ srcSpanToRange (getLoc imp)
-                  fp = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp)
+                  fp = unsafeToNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp)
           getModuleName file = do
            ms <- msrModSummary <$> use_ GetModSummaryWithoutTimestamps file
            pure (moduleNameString . moduleName . ms_mod $ ms)
@@ -707,7 +707,7 @@ typeCheckRuleDefinition hsc pm = do
       r@(_, mtc) <- a
       forM_ mtc $ \tc -> do
         used_files <- liftIO $ readIORef $ tcg_dependent_files $ tmrTypechecked tc
-        void $ uses_ GetModificationTime (map toNormalizedFilePath' used_files)
+        void $ uses_ GetModificationTime (map unsafeToNormalizedFilePath' used_files)
       return r
 
 -- | Get all the linkables stored in the graph, i.e. the ones we *do not* need to unload.
@@ -737,7 +737,7 @@ loadGhcSession recorder ghcSessionDepsConfig = do
         let addDependency fp = do
                 -- VSCode uses absolute paths in its filewatch notifications
                 afp <- liftIO $ makeAbsolute fp
-                let nfp = toNormalizedFilePath' afp
+                let nfp = unsafeToNormalizedFilePath' afp
                 itExists <- getFileExists nfp
                 when itExists $ void $ do
                   use_ GetModificationTime nfp

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

@@ -33,7 +33,8 @@ import           Development.IDE                      (Action, IdeRule,
                                                        NormalizedFilePath,
                                                        Range,
                                                        rangeToRealSrcSpan,
-                                                       realSrcSpanToRange)
+                                                       realSrcSpanToRange,
+                                                       unsafeToNormalizedFilePath')
 import qualified Development.IDE.Core.PositionMapping as P
 import qualified Development.IDE.Core.Shake           as IDE
 import           Development.IDE.GHC.Compat           (RealSrcSpan, srcSpanFile)
@@ -113,7 +114,7 @@ instance MapAge Range where
 
 instance MapAge RealSrcSpan where
   mapAgeFrom =
-    invMapAge (\fs -> rangeToRealSrcSpan (fromString $ unpackFS fs))
+    invMapAge (\fs -> rangeToRealSrcSpan (unsafeToNormalizedFilePath' $ unpackFS fs))
               (srcSpanFile &&& realSrcSpanToRange)
       .  mapAgeFrom
 

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

@@ -45,7 +45,7 @@ import           GHC
 
 
 diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
-diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc,ShowDiag,)
+diagFromText diagSource sev loc msg = (unsafeToNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc,ShowDiag,)
     Diagnostic
     { _range    = fromMaybe noRange $ srcSpanToRange loc
     , _severity = Just sev
@@ -90,14 +90,14 @@ srcSpanToFilename (Compat.RealSrcSpan real _) = Just $ Compat.unpackFS $ srcSpan
 
 realSrcSpanToLocation :: RealSrcSpan -> Location
 realSrcSpanToLocation real = Location file (realSrcSpanToRange real)
-  where file = fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ Compat.unpackFS $ srcSpanFile real
+  where file = fromNormalizedUri $ filePathToUri' $ unsafeToNormalizedFilePath' $ Compat.unpackFS $ srcSpanFile real
 
 srcSpanToLocation :: SrcSpan -> Maybe Location
 srcSpanToLocation src = do
   fs <- srcSpanToFilename src
   rng <- srcSpanToRange src
   -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
-  pure $ Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' fs) rng
+  pure $ Location (fromNormalizedUri $ filePathToUri' $ unsafeToNormalizedFilePath' fs) rng
 
 rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan
 rangeToSrcSpan = fmap (\x -> Compat.RealSrcSpan x Nothing) . rangeToRealSrcSpan

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

@@ -169,7 +169,7 @@ moduleImportPath (takeDirectory . fromNormalizedFilePath -> pathDir) mn
     -- A for module A.B
     modDir =
         takeDirectory $
-        fromNormalizedFilePath $ toNormalizedFilePath' $
+        fromNormalizedFilePath $ unsafeToNormalizedFilePath' $
         moduleNameSlashes mn
 
 -- | Read a UTF8 file, with lenient decoding, so it will never raise a decoding error.

ghcide/src/Development/IDE/Import/FindImports.hs

@@ -69,7 +69,7 @@ locateModuleFile :: MonadIO m
              -> m (Maybe NormalizedFilePath)
 locateModuleFile import_dirss exts targetFor isSource modName = do
   let candidates import_dirs =
-        [ toNormalizedFilePath' (prefix </> moduleNameSlashes modName <.> maybeBoot ext)
+        [ unsafeToNormalizedFilePath' (prefix </> moduleNameSlashes modName <.> maybeBoot ext)
            | prefix <- import_dirs , ext <- exts]
   firstJustM (targetFor modName) (concatMap candidates import_dirss)
   where

ghcide/src/Development/IDE/LSP/HoverDefinition.hs

@@ -39,7 +39,7 @@ references :: IdeState -> ReferenceParams -> LSP.LspM c (Either ResponseError (L
 references ide (ReferenceParams (TextDocumentIdentifier uri) pos _ _ _) = liftIO $
   case uriToFilePath' uri of
     Just path -> do
-      let filePath = toNormalizedFilePath' path
+      let filePath = unsafeToNormalizedFilePath' path
       logDebug (ideLogger ide) $
         "References request at position " <> T.pack (showPosition pos) <>
         " in file: " <> T.pack path
@@ -72,7 +72,7 @@ request label getResults notFound found ide (TextDocumentPositionParams (TextDoc
 
 logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> IdeAction b) -> IdeState -> Position -> String -> IO b
 logAndRunRequest label getResults ide pos path = do
-  let filePath = toNormalizedFilePath' path
+  let filePath = unsafeToNormalizedFilePath' path
   logDebug (ideLogger ide) $
     label <> " request at position " <> T.pack (showPosition pos) <>
     " in file: " <> T.pack path

ghcide/src/Development/IDE/LSP/Notifications.hs

@@ -52,7 +52,7 @@ instance Pretty Log where
     LogFileStore log -> pretty log
 
 whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
-whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'
+whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . unsafeToNormalizedFilePath'
 
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
 descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = mconcat
@@ -100,7 +100,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHa
         let fileEvents' =
                 [ (nfp, event) | (FileEvent uri event) <- fileEvents
                 , Just fp <- [uriToFilePath uri]
-                , let nfp = toNormalizedFilePath fp
+                , let nfp = unsafeToNormalizedFilePath fp
                 , not $ HM.member nfp filesOfInterest
                 ]
         unless (null fileEvents') $ do

ghcide/src/Development/IDE/LSP/Outline.hs

@@ -28,7 +28,7 @@ import           Language.LSP.Types             (DocumentSymbol (..),
                                                  SymbolInformation,
                                                  SymbolKind (SkConstructor, SkField, SkFile, SkFunction, SkInterface, SkMethod, SkModule, SkObject, SkStruct, SkTypeParameter, SkUnknown),
                                                  TextDocumentIdentifier (TextDocumentIdentifier),
-                                                 type (|?) (InL), uriToFilePath)
+                                                 type (|?) (InL), uriToFilePath, unsafeFilePathToNormalizedFilePath)
 #if MIN_VERSION_ghc(9,2,0)
 import Data.List.NonEmpty (nonEmpty, toList)
 #endif
@@ -37,7 +37,7 @@ moduleOutline
   :: IdeState -> DocumentSymbolParams -> LspM c (Either ResponseError (List DocumentSymbol |? List SymbolInformation))
 moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentifier uri }
   = liftIO $ case uriToFilePath uri of
-    Just (toNormalizedFilePath' -> fp) -> do
+    Just (unsafeToNormalizedFilePath' -> fp) -> do
       mb_decls <- fmap fst <$> runAction "Outline" ideState (useWithStale GetParsedModule fp)
       pure $ Right $ case mb_decls of
         Nothing -> InL (List [])
@@ -219,7 +219,7 @@ documentSymbolForImportSummary importSymbols =
       mergeRanges xs = Range (minimum $ map _start xs) (maximum $ map _end xs)
       importRange = mergeRanges $ map (_range :: DocumentSymbol -> Range) importSymbols
     in
-      Just (defDocumentSymbol (rangeToRealSrcSpan "" importRange))
+      Just (defDocumentSymbol (rangeToRealSrcSpan (unsafeFilePathToNormalizedFilePath "") importRange))
           { _name = "imports"
           , _kind = SkModule
           , _children = Just (List importSymbols)

ghcide/src/Development/IDE/Main.hs

@@ -86,7 +86,7 @@ import           Development.IDE.Session                  (SessionLoadingOptions
                                                            setInitialDynFlags)
 import qualified Development.IDE.Session                  as Session
 import           Development.IDE.Types.Location           (NormalizedUri,
-                                                           toNormalizedFilePath')
+                                                           unsafeToNormalizedFilePath')
 import           Development.IDE.Types.Logger             (Logger,
                                                            Pretty (pretty),
                                                            Priority (Info, Warning),
@@ -427,10 +427,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
             registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
 
             putStrLn "\nStep 4/4: Type checking the files"
-            setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files
-            results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files)
-            _results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' files)
-            _results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' files)
+            setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . unsafeToNormalizedFilePath') files
+            results <- runAction "User TypeCheck" ide $ uses TypeCheck (map unsafeToNormalizedFilePath' files)
+            _results <- runAction "GetHie" ide $ uses GetHieAst (map unsafeToNormalizedFilePath' files)
+            _results <- runAction "GenerateCore" ide $ uses GenerateCore (map unsafeToNormalizedFilePath' files)
             let (worked, failed) = partition fst $ zip (map isJust results) files
             when (failed /= []) $
                 putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed