Use NormalizedFilePath and adapt types of haskell-lsp-0.21 (#479)

* Use custom version of h-l-t

* Use normalized path functions from h-l-t

* Restore empty path corner case

* Create a wrapper over NFP to override IsString

* Use maybe instead fromMaybe

* Use patched version of lsp-types in all yaml files

* Remove unused import

* Rename specific NormalizeFilePath to NormalizeFilePath'

* Remove specific newtype and IsString instance

* Use released haskell-lsp-0.21

* Adapt to type changes of haskell-lsp-0.21

* Add tags field to CompletionItem

* Fix test case about empty file path

* Correct stack.yaml used in azure ci cache

* Build ghcide including tests in windows azure ci

* Qualify haskell-lsp modules to avoid name clashes

.azure/linux-stack.yml

@@ -17,7 +17,7 @@ jobs:
   - checkout: self
   - task: Cache@2
     inputs:
-      key: stack-cache-v2 | $(Agent.OS) | $(Build.SourcesDirectory)/stack.yaml | $(Build.SourcesDirectory)/ghcide.cabal
+      key: stack-cache-v2 | $(Agent.OS) | $(Build.SourcesDirectory)/$(STACK_YAML) | $(Build.SourcesDirectory)/ghcide.cabal
       path: .azure-cache
       cacheHitVar: CACHE_RESTORED
     displayName: "Cache stack artifacts"

.azure/windows-stack.yml

@@ -46,11 +46,9 @@ jobs:
       stack install alex --stack-yaml $STACK_YAML
       stack build --only-dependencies --stack-yaml $STACK_YAML
     displayName: 'stack build --only-dependencies'
-  - bash: stack test --ghc-options=-Werror --stack-yaml $STACK_YAML || stack test --ghc-options=-Werror --stack-yaml $STACK_YAML || stack test --ghc-options=-Werror --stack-yaml $STACK_YAML
+  - bash: stack test --no-run-tests --ghc-options=-Werror --stack-yaml $STACK_YAML
-    # ghcide stack tests are flaky, see https://github.com/digital-asset/daml/issues/2606.
     displayName: 'stack test --ghc-options=-Werror'
-    # TODO: Enable when failing tests are fixed or marked as broken. See https://github.com/digital-asset/ghcide/issues/474
+    # TODO: run test suite when failing tests are fixed or marked as broken. See https://github.com/digital-asset/ghcide/issues/474
-    condition: False
   - bash: |
       mkdir -p .azure-cache
       tar -vczf .azure-cache/stack-root.tar.gz $(cygpath $STACK_ROOT)

exe/Main.hs

@@ -146,8 +146,8 @@ main = do
         ide <- initialise def (cradleRules >> mainRule) (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs
 
         putStrLn "\nStep 6/6: Type checking the files"
-        setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath files
+        setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath' files
-        results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files
+        results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath' files
         let (worked, failed) = partition fst $ zip (map isJust results) files
         when (failed /= []) $
             putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed
@@ -183,7 +183,7 @@ kick = do
 -- | Print an LSP event.
 showEvent :: Lock -> FromServerMessage -> IO ()
 showEvent _ (EventFileDiagnostics _ []) = return ()
-showEvent lock (EventFileDiagnostics (toNormalizedFilePath -> file) diags) =
+showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) =
     withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,ShowDiag,) diags
 showEvent lock e = withLock lock $ print e
 
@@ -199,7 +199,7 @@ loadSession dir = liftIO $ do
     let session :: Maybe FilePath -> Action HscEnvEq
         session file = do
           -- In the absence of a cradle file, just pass the directory from where to calculate an implicit cradle
-          let cradle = toNormalizedFilePath $ fromMaybe dir file
+          let cradle = toNormalizedFilePath' $ fromMaybe dir file
           use_ LoadCradle cradle
     return $ \file -> session =<< liftIO (cradleLoc file)
 

exe/Rules.hs

@@ -36,8 +36,8 @@ import qualified System.Directory.Extra         as IO
 import           System.Environment             (lookupEnv)
 import           System.FilePath.Posix          (addTrailingPathSeparator,
                                                  (</>))
-import Language.Haskell.LSP.Messages as LSP
+import qualified Language.Haskell.LSP.Messages  as LSP
-import Language.Haskell.LSP.Types as LSP
+import qualified Language.Haskell.LSP.Types     as LSP
 import Data.Aeson (ToJSON(toJSON))
 import Development.IDE.Types.Logger (logDebug)
 

ghcide.cabal

@@ -43,8 +43,8 @@ library
         filepath,
         haddock-library >= 1.8,
         hashable,
-        haskell-lsp-types == 0.20.*,
+        haskell-lsp-types == 0.21.*,
-        haskell-lsp == 0.20.*,
+        haskell-lsp == 0.21.*,
         mtl,
         network-uri,
         prettyprinter-ansi-terminal,

src/Development/IDE/Core/Compile.hs

@@ -93,7 +93,7 @@ computePackageDeps
 computePackageDeps env pkg = do
     let dflags = hsc_dflags env
     case lookupInstalledPackage dflags pkg of
-        Nothing -> return $ Left [ideErrorText (toNormalizedFilePath noFilePath) $
+        Nothing -> return $ Left [ideErrorText (toNormalizedFilePath' noFilePath) $
             T.pack $ "unknown package: " ++ show pkg]
         Just pkgInfo -> return $ Right $ depends pkgInfo
 

src/Development/IDE/Core/FileExists.hs

@@ -146,9 +146,10 @@ fileExistsFast getLspId vfs file = do
                                   WorkspaceDidChangeWatchedFiles
                                   (Just (A.toJSON regOptions))
       regOptions =
-        DidChangeWatchedFilesRegistrationOptions { watchers = List [watcher] }
+        DidChangeWatchedFilesRegistrationOptions { _watchers = List [watcher] }
-      watcher = FileSystemWatcher { globPattern = fromNormalizedFilePath fp
+      watchKind = WatchKind { _watchCreate = True, _watchChange = False, _watchDelete = True}
-                                  , kind        = Just 5 -- Create and Delete events only
+      watcher = FileSystemWatcher { _globPattern = fromNormalizedFilePath fp
+                                  , _kind        = Just watchKind
                                   }
 
     eventer $ ReqRegisterCapability req
@@ -174,29 +175,3 @@ getFileExistsVFS vfs file = do
     handle (\(_ :: IOException) -> return False) $
         (isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^
         Dir.doesFileExist (fromNormalizedFilePath file)
-
---------------------------------------------------------------------------------------------------
--- The message definitions below probably belong in haskell-lsp-types
-
-data DidChangeWatchedFilesRegistrationOptions = DidChangeWatchedFilesRegistrationOptions
-    { watchers :: List FileSystemWatcher
-    }
-
-instance A.ToJSON DidChangeWatchedFilesRegistrationOptions where
-  toJSON DidChangeWatchedFilesRegistrationOptions {..} =
-    A.object ["watchers" A..= watchers]
-
-data FileSystemWatcher = FileSystemWatcher
-    { -- | The glob pattern to watch.
-      --   For details on glob pattern syntax, check the spec: https://microsoft.github.io/language-server-protocol/specifications/specification-3-14/#workspace_didChangeWatchedFiles
-      globPattern :: String
-        -- | The kind of event to subscribe to. Defaults to all.
-        --   Defined as a bitmap of Create(1), Change(2), and Delete(4)
-    , kind        :: Maybe Int
-    }
-
-instance A.ToJSON FileSystemWatcher where
-  toJSON FileSystemWatcher {..} =
-    A.object
-      $  ["globPattern" A..= globPattern]
-      ++ [ "kind" A..= x | Just x <- [kind] ]

src/Development/IDE/Core/Preprocessor.hs

@@ -96,7 +96,7 @@ data CPPDiag
 
 diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic]
 diagsFromCPPLogs filename logs =
-  map (\d -> (toNormalizedFilePath filename, ShowDiag, cppDiagToDiagnostic d)) $
+  map (\d -> (toNormalizedFilePath' filename, ShowDiag, cppDiagToDiagnostic d)) $
     go [] logs
   where
     -- On errors, CPP calls logAction with a real span for the initial log and
@@ -118,7 +118,8 @@ diagsFromCPPLogs filename logs =
           _code = Nothing,
           _source = Just "CPP",
           _message = T.unlines $ cdMessage d,
-          _relatedInformation = Nothing
+          _relatedInformation = Nothing,
+          _tags = Nothing
         }
 
 

src/Development/IDE/Core/Rules.hs

@@ -80,14 +80,14 @@ useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT Action v
 useE k = MaybeT . use k
 
 useNoFileE :: IdeRule k v => k -> MaybeT Action v
-useNoFileE k = useE k ""
+useNoFileE k = useE k emptyFilePath
 
 usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT Action [v]
 usesE k = MaybeT . fmap sequence . uses k
 
 defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
 defineNoFile f = define $ \k file -> do
-    if file == "" then do res <- f k; return ([], Just res) else
+    if file == emptyFilePath then do res <- f k; return ([], Just res) else
         fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file"
 
 
@@ -130,7 +130,7 @@ getHieFile file mod = do
 getHomeHieFile :: NormalizedFilePath -> Action ([a], Maybe HieFile)
 getHomeHieFile f = do
   pm <- use_ GetParsedModule f
-  let normal_hie_f = toNormalizedFilePath hie_f
+  let normal_hie_f = toNormalizedFilePath' hie_f
       hie_f = ml_hie_file $ ms_location $ pm_mod_summary pm
   mbHieTimestamp <- use GetModificationTime normal_hie_f
   srcTimestamp   <- use_ GetModificationTime f
@@ -292,9 +292,10 @@ reportImportCyclesRule =
             , _message = "Cyclic module dependency between " <> showCycle mods
             , _code = Nothing
             , _relatedInformation = Nothing
+            , _tags = Nothing
             }
             where loc = srcSpanToLocation (getLoc imp)
-                  fp = toNormalizedFilePath $ srcSpanToFilename (getLoc imp)
+                  fp = toNormalizedFilePath' $ srcSpanToFilename (getLoc imp)
           getModuleName file = do
            pm <- use_ GetParsedModule file
            pure (moduleNameString . moduleName . ms_mod $ pm_mod_summary pm)

src/Development/IDE/Core/Shake.hs

@@ -414,7 +414,7 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts =
                             Right _ -> "completed"
                        profile = case res of
                             Right (_, Just fp) ->
-                                let link = case filePathToUri' $ toNormalizedFilePath fp of
+                                let link = case filePathToUri' $ toNormalizedFilePath' fp of
                                                 NormalizedUri _ x -> x
                                 in ", profile saved at " <> T.unpack link
                             _ -> ""
@@ -473,13 +473,13 @@ useWithStale :: IdeRule k v
 useWithStale key file = head <$> usesWithStale key [file]
 
 useNoFile :: IdeRule k v => k -> Action (Maybe v)
-useNoFile key = use key ""
+useNoFile key = use key emptyFilePath
 
 use_ :: IdeRule k v => k -> NormalizedFilePath -> Action v
 use_ key file = head <$> uses_ key [file]
 
 useNoFile_ :: IdeRule k v => k -> Action v
-useNoFile_ key = use_ key ""
+useNoFile_ key = use_ key emptyFilePath
 
 uses_ :: IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
 uses_ key files = do
@@ -819,7 +819,7 @@ filterDiagnostics ::
     DiagnosticStore ->
     DiagnosticStore
 filterDiagnostics keep =
-    HMap.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)
+    HMap.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath') $ uriToFilePath' $ fromNormalizedUri uri)
 
 filterVersionMap
     :: HMap.HashMap NormalizedUri (Set.Set TextDocumentVersion)

src/Development/IDE/GHC/Error.hs

@@ -40,7 +40,7 @@ import qualified Outputable                 as Out
 
 
 diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
-diagFromText diagSource sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,ShowDiag,)
+diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ srcSpanToFilename loc,ShowDiag,)
     Diagnostic
     { _range    = srcSpanToRange loc
     , _severity = Just sev
@@ -48,6 +48,7 @@ diagFromText diagSource sev loc msg = (toNormalizedFilePath $ srcSpanToFilename
     , _message  = msg
     , _code     = Nothing
     , _relatedInformation = Nothing
+    , _tags     = Nothing
     }
 
 -- | Produce a GHC-style error from a source span and a message.
@@ -80,7 +81,7 @@ srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
 srcSpanToLocation :: SrcSpan -> Location
 srcSpanToLocation src =
   -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
-  Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath $ srcSpanToFilename src) (srcSpanToRange src)
+  Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ srcSpanToFilename src) (srcSpanToRange src)
 
 isInsideSrcSpan :: Position -> SrcSpan -> Bool
 p `isInsideSrcSpan` r = sp <= p && p <= ep

src/Development/IDE/GHC/Util.hs

@@ -139,7 +139,7 @@ moduleImportPath (takeDirectory . fromNormalizedFilePath -> pathDir) pm
     -- A for module A.B
     modDir =
         takeDirectory $
-        fromNormalizedFilePath $ toNormalizedFilePath $
+        fromNormalizedFilePath $ toNormalizedFilePath' $
         moduleNameSlashes $ GHC.moduleName mod'
 
 -- | An 'HscEnv' with equality. Two values are considered equal

src/Development/IDE/Import/FindImports.hs

@@ -58,7 +58,7 @@ locateModuleFile :: MonadIO m
              -> m (Maybe NormalizedFilePath)
 locateModuleFile dflags exts doesExist isSource modName = do
   let candidates =
-        [ toNormalizedFilePath (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)
+        [ toNormalizedFilePath' (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)
            | prefix <- importPaths dflags, ext <- exts]
   findM doesExist candidates
   where

src/Development/IDE/LSP/HoverDefinition.hs

@@ -55,7 +55,7 @@ request label getResults notFound found ide (TextDocumentPositionParams (TextDoc
 
 logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b) -> IdeState -> Position -> String -> IO b
 logAndRunRequest label getResults ide pos path = do
-  let filePath = toNormalizedFilePath path
+  let filePath = toNormalizedFilePath' path
   logInfo (ideLogger ide) $
     label <> " request at position " <> T.pack (showPosition pos) <>
     " in file: " <> T.pack path

src/Development/IDE/LSP/Notifications.hs

@@ -30,7 +30,7 @@ import           Development.IDE.Core.OfInterest
 
 
 whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
-whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath
+whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'
 
 setHandlersNotifications :: PartialHandlers c
 setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
@@ -62,7 +62,7 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
             let events =
                     mapMaybe
                         (\(FileEvent uri ev) ->
-                            (, ev /= FcDeleted) . toNormalizedFilePath
+                            (, ev /= FcDeleted) . toNormalizedFilePath'
                             <$> LSP.uriToFilePath uri
                         )
                         ( F.toList fileEvents )

src/Development/IDE/LSP/Outline.hs

@@ -37,7 +37,7 @@ moduleOutline
   :: LSP.LspFuncs c -> IdeState -> DocumentSymbolParams -> IO (Either ResponseError DSResult)
 moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentIdentifier uri }
   = case uriToFilePath uri of
-    Just (toNormalizedFilePath -> fp) -> do
+    Just (toNormalizedFilePath' -> fp) -> do
       mb_decls <- runAction ideState $ use GetParsedModule fp
       pure $ Right $ case mb_decls of
         Nothing -> DSDocumentSymbols (List [])

src/Development/IDE/Plugin/CodeAction.hs

@@ -64,7 +64,7 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
     -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
     contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
     let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
-        mbFile = toNormalizedFilePath <$> uriToFilePath uri
+        mbFile = toNormalizedFilePath' <$> uriToFilePath uri
     (ideOptions, parsedModule, join -> env) <- runAction state $
       (,,) <$> getIdeOptions
             <*> getParsedModule `traverse` mbFile
@@ -85,7 +85,7 @@ codeLens
     -> IO (Either ResponseError (List CodeLens))
 codeLens _lsp ideState CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
     fmap (Right . List) $ case uriToFilePath' uri of
-      Just (toNormalizedFilePath -> filePath) -> do
+      Just (toNormalizedFilePath' -> filePath) -> do
         _ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath
         diag <- getDiagnostics ideState
         hDiag <- getHiddenDiagnostics ideState

src/Development/IDE/Plugin/Completions.hs

@@ -66,7 +66,7 @@ getCompletionsLSP lsp ide
     contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
     fmap Right $ case (contents, uriToFilePath' uri) of
       (Just cnts, Just path) -> do
-        let npath = toNormalizedFilePath path
+        let npath = toNormalizedFilePath' path
         (ideOpts, compls) <- runAction ide $ do
             opts <- getIdeOptions
             compls <- useWithStale ProduceCompletions npath

src/Development/IDE/Plugin/Completions/Logic.hs

@@ -132,7 +132,7 @@ occNameToComKind ty oc
 
 mkCompl :: IdeOptions -> CompItem -> CompletionItem
 mkCompl IdeOptions{..} CI{origName,importedFrom,thingType,label,isInfix,docs} =
-  CompletionItem label kind ((colon <>) <$> typeText)
+  CompletionItem label kind (List []) ((colon <>) <$> typeText)
     (Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs')
     Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
     Nothing Nothing Nothing Nothing Nothing
@@ -186,13 +186,13 @@ getArgText typ = argText
 
 mkModCompl :: T.Text -> CompletionItem
 mkModCompl label =
-  CompletionItem label (Just CiModule) Nothing
+  CompletionItem label (Just CiModule) (List []) Nothing
     Nothing Nothing Nothing Nothing Nothing Nothing Nothing
     Nothing Nothing Nothing Nothing Nothing
 
 mkImportCompl :: T.Text -> T.Text -> CompletionItem
 mkImportCompl enteredQual label =
-  CompletionItem m (Just CiModule) (Just label)
+  CompletionItem m (Just CiModule) (List []) (Just label)
     Nothing Nothing Nothing Nothing Nothing Nothing Nothing
     Nothing Nothing Nothing Nothing Nothing
   where
@@ -200,13 +200,13 @@ mkImportCompl enteredQual label =
 
 mkExtCompl :: T.Text -> CompletionItem
 mkExtCompl label =
-  CompletionItem label (Just CiKeyword) Nothing
+  CompletionItem label (Just CiKeyword) (List []) Nothing
     Nothing Nothing Nothing Nothing Nothing Nothing Nothing
     Nothing Nothing Nothing Nothing Nothing
 
 mkPragmaCompl :: T.Text -> T.Text -> CompletionItem
 mkPragmaCompl label insertText =
-  CompletionItem label (Just CiKeyword) Nothing
+  CompletionItem label (Just CiKeyword) (List []) Nothing
     Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
     Nothing Nothing Nothing Nothing Nothing
 

src/Development/IDE/Types/Diagnostics.hs

@@ -38,7 +38,8 @@ ideErrorText fp msg = (fp, ShowDiag, LSP.Diagnostic {
     _code = Nothing,
     _source = Just "compiler",
     _message = msg,
-    _relatedInformation = Nothing
+    _relatedInformation = Nothing,
+    _tags = Nothing
     })
 
 -- | Defines whether a particular diagnostic should be reported

src/Development/IDE/Types/Location.hs

@@ -10,15 +10,15 @@ module Development.IDE.Types.Location
     , Position(..)
     , showPosition
     , Range(..)
-    , Uri(..)
+    , LSP.Uri(..)
-    , NormalizedUri
+    , LSP.NormalizedUri
     , LSP.toNormalizedUri
     , LSP.fromNormalizedUri
-    , NormalizedFilePath
+    , LSP.NormalizedFilePath
     , fromUri
-    , toNormalizedFilePath
+    , emptyFilePath
-    , fromNormalizedFilePath
+    , toNormalizedFilePath'
-    , filePathToUri
+    , LSP.fromNormalizedFilePath
     , filePathToUri'
     , uriToFilePath'
     , readSrcSpan
@@ -26,135 +26,40 @@ module Development.IDE.Types.Location
 
 import Control.Applicative
 import Language.Haskell.LSP.Types (Location(..), Range(..), Position(..))
-import Control.DeepSeq
 import Control.Monad
-import Data.Binary
+import Data.Hashable (Hashable(hash))
-import Data.Maybe as Maybe
-import Data.Hashable
 import Data.String
-import qualified Data.Text as T
 import FastString
-import Network.URI
-import System.FilePath
-import qualified System.FilePath.Posix as FPP
-import qualified System.FilePath.Windows as FPW
-import System.Info.Extra
 import qualified Language.Haskell.LSP.Types as LSP
-import Language.Haskell.LSP.Types as LSP (
-    filePathToUri
-  , NormalizedUri(..)
-  , Uri(..)
-  , toNormalizedUri
-  , fromNormalizedUri
-  )
 import SrcLoc as GHC
 import Text.ParserCombinators.ReadP as ReadP
-import GHC.Generics
+import Data.Maybe (fromMaybe)
 
-
+toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath
--- | Newtype wrapper around FilePath that always has normalized slashes.
--- The NormalizedUri and hash of the FilePath are cached to avoided
--- repeated normalisation when we need to compute them (which is a lot).
---
--- This is one of the most performance critical parts of ghcide, do not
--- modify it without profiling.
-data NormalizedFilePath = NormalizedFilePath NormalizedUriWrapper !Int !FilePath
-    deriving (Generic, Eq, Ord)
-
-instance NFData NormalizedFilePath where
-instance Binary NormalizedFilePath where
-  put (NormalizedFilePath _ _ fp) = put fp
-  get = do
-    v <- Data.Binary.get :: Get FilePath
-    return (toNormalizedFilePath v)
-
-
-instance Show NormalizedFilePath where
-  show (NormalizedFilePath _ _ fp) = "NormalizedFilePath " ++ show fp
-
-instance Hashable NormalizedFilePath where
-  hash (NormalizedFilePath _ h _) = h
-
--- Just to define NFData and Binary
-newtype NormalizedUriWrapper =
-  NormalizedUriWrapper { unwrapNormalizedFilePath :: NormalizedUri }
-  deriving (Show, Generic, Eq, Ord)
-
-instance NFData NormalizedUriWrapper where
-  rnf = rwhnf
-
-
-instance Hashable NormalizedUriWrapper where
-
-instance IsString NormalizedFilePath where
-    fromString = toNormalizedFilePath
-
-toNormalizedFilePath :: FilePath -> NormalizedFilePath
 -- We want to keep empty paths instead of normalising them to "."
-toNormalizedFilePath "" = NormalizedFilePath (NormalizedUriWrapper emptyPathUri) (hash ("" :: String)) ""
+toNormalizedFilePath' "" = emptyFilePath
-toNormalizedFilePath fp =
+toNormalizedFilePath' fp = LSP.toNormalizedFilePath fp
-  let nfp = normalise fp
-  in NormalizedFilePath (NormalizedUriWrapper $ filePathToUriInternal' nfp) (hash nfp) nfp
 
-fromNormalizedFilePath :: NormalizedFilePath -> FilePath
+emptyFilePath :: LSP.NormalizedFilePath
-fromNormalizedFilePath (NormalizedFilePath _ _ fp) = fp
+emptyFilePath = LSP.NormalizedFilePath emptyPathUri ""
 
 -- | We use an empty string as a filepath when we don’t have a file.
 -- However, haskell-lsp doesn’t support that in uriToFilePath and given
 -- that it is not a valid filepath it does not make sense to upstream a fix.
 -- So we have our own wrapper here that supports empty filepaths.
-uriToFilePath' :: Uri -> Maybe FilePath
+uriToFilePath' :: LSP.Uri -> Maybe FilePath
 uriToFilePath' uri
-    | uri == fromNormalizedUri emptyPathUri = Just ""
+    | uri == LSP.fromNormalizedUri emptyPathUri = Just ""
     | otherwise = LSP.uriToFilePath uri
 
-emptyPathUri :: NormalizedUri
+emptyPathUri :: LSP.NormalizedUri
-emptyPathUri = filePathToUriInternal' ""
+emptyPathUri = LSP.NormalizedUri (hash ("" :: String)) ""
 
-filePathToUri' :: NormalizedFilePath -> NormalizedUri
+filePathToUri' :: LSP.NormalizedFilePath -> LSP.NormalizedUri
-filePathToUri' (NormalizedFilePath (NormalizedUriWrapper u) _ _) = u
+filePathToUri' = LSP.normalizedFilePathToUri
-
-filePathToUriInternal' :: FilePath -> NormalizedUri
-filePathToUriInternal' fp = toNormalizedUri $ Uri $ T.pack $ LSP.fileScheme <> "//" <> platformAdjustToUriPath fp
-  where
-    -- The definitions below are variants of the corresponding functions in Language.Haskell.LSP.Types.Uri that assume that
-    -- the filepath has already been normalised. This is necessary since normalising the filepath has a nontrivial cost.
-
-    toNormalizedUri :: Uri -> NormalizedUri
-    toNormalizedUri (Uri t) =
-        let fp = T.pack $ escapeURIString isUnescapedInURI $ unEscapeString $ T.unpack t
-        in NormalizedUri (hash fp) fp
-
-    platformAdjustToUriPath :: FilePath -> String
-    platformAdjustToUriPath srcPath
-      | isWindows = '/' : escapedPath
-      | otherwise = escapedPath
-      where
-        (splitDirectories, splitDrive)
-          | isWindows =
-              (FPW.splitDirectories, FPW.splitDrive)
-          | otherwise =
-              (FPP.splitDirectories, FPP.splitDrive)
-        escapedPath =
-            case splitDrive srcPath of
-                (drv, rest) ->
-                    convertDrive drv `FPP.joinDrive`
-                    FPP.joinPath (map (escapeURIString unescaped) $ splitDirectories rest)
-        -- splitDirectories does not remove the path separator after the drive so
-        -- we do a final replacement of \ to /
-        convertDrive drv
-          | isWindows && FPW.hasTrailingPathSeparator drv =
-              FPP.addTrailingPathSeparator (init drv)
-          | otherwise = drv
-        unescaped c
-          | isWindows = isUnreserved c || c `elem` [':', '\\', '/']
-          | otherwise = isUnreserved c || c == '/'
-
-
-
-fromUri :: LSP.NormalizedUri -> NormalizedFilePath
-fromUri = toNormalizedFilePath . fromMaybe noFilePath . uriToFilePath' . fromNormalizedUri
 
+fromUri :: LSP.NormalizedUri -> LSP.NormalizedFilePath
+fromUri = fromMaybe (toNormalizedFilePath' noFilePath) . LSP.uriToNormalizedFilePath
 
 noFilePath :: FilePath
 noFilePath = "<unknown>"

stack-ghc-lib.yaml

@@ -2,9 +2,9 @@ resolver: nightly-2019-09-16
 packages:
 - .
 extra-deps:
-- haskell-lsp-0.20.0.0
+- haskell-lsp-0.21.0.0
-- haskell-lsp-types-0.20.0.0
+- haskell-lsp-types-0.21.0.0
-- lsp-test-0.10.1.0
+- lsp-test-0.10.2.0
 - hie-bios-0.4.0
 - ghc-lib-parser-8.8.1
 - ghc-lib-8.8.1

stack.yaml

@@ -2,9 +2,9 @@ resolver: nightly-2019-09-21
 packages:
 - .
 extra-deps:
-- haskell-lsp-0.20.0.0
+- haskell-lsp-0.21.0.0
-- haskell-lsp-types-0.20.0.0
+- haskell-lsp-types-0.21.0.0
-- lsp-test-0.10.1.0
+- lsp-test-0.10.2.0
 - hie-bios-0.4.0
 - fuzzy-0.1.0.0
 - regex-pcre-builtin-0.95.1.1.8.43

stack84.yaml

@@ -5,9 +5,9 @@ packages:
 extra-deps:
 - aeson-1.4.6.0
 - base-orphans-0.8.2
-- haskell-lsp-0.20.0.0
+- haskell-lsp-0.21.0.0
-- haskell-lsp-types-0.20.0.0
+- haskell-lsp-types-0.21.0.0
-- lsp-test-0.10.1.0
+- lsp-test-0.10.2.0
 - rope-utf16-splay-0.3.1.0
 - filepattern-0.1.1
 - js-dgtable-0.5.2

stack88.yaml

@@ -2,5 +2,9 @@ resolver: nightly-2020-02-13
 packages:
 - .
 extra-deps:
+- haskell-lsp-0.21.0.0
+- haskell-lsp-types-0.21.0.0
+- lsp-test-0.10.2.0
+
 nix:
   packages: [zlib]

test/exe/Main.hs

@@ -1658,6 +1658,7 @@ completionTests
     complItem label kind ty = CompletionItem
       { _label = label
       , _kind = kind
+      , _tags = List []
       , _detail = (":: " <>) <$> ty
       , _documentation = Nothing
       , _deprecated = Nothing
@@ -1675,6 +1676,7 @@ completionTests
     keywordItem label = CompletionItem
       { _label = label
       , _kind = Just CiKeyword
+      , _tags = List []
       , _detail = Nothing
       , _documentation = Nothing
       , _deprecated = Nothing
@@ -2104,8 +2106,10 @@ findCodeAction doc range t = head <$> findCodeActions doc range [t]
 unitTests :: TestTree
 unitTests = do
   testGroup "Unit"
-     [ testCase "empty file path" $
+     [ testCase "empty file path does NOT work with the empty String literal" $
-         uriToFilePath' (fromNormalizedUri $ filePathToUri' "") @?= Just ""
+         uriToFilePath' (fromNormalizedUri $ filePathToUri' "") @?= Just "."
+     , testCase "empty file path works using toNormalizedFilePath'" $
+         uriToFilePath' (fromNormalizedUri $ filePathToUri' (toNormalizedFilePath' "")) @?= Just ""
      ]
 
 -- | Wrapper around 'LSPTest.openDoc'' that sends file creation events