Normalize file paths before converting to Uri's

haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs

@@ -26,8 +26,10 @@ newtype NormalizedUri = NormalizedUri Text
   deriving (Eq,Ord,Read,Show,Generic,Hashable)
 
 toNormalizedUri :: Uri -> NormalizedUri
-toNormalizedUri (Uri t) =
+toNormalizedUri uri =
     NormalizedUri $ T.pack $ escapeURIString isUnescapedInURI $ unEscapeString $ T.unpack t
+  where (Uri t) = maybe uri filePathToUri (uriToFilePath uri)
+        -- To ensure all `Uri`s have the file path like the created ones by `filePathToUri`
 
 fromNormalizedUri :: NormalizedUri -> Uri
 fromNormalizedUri (NormalizedUri t) = Uri t
@@ -82,19 +84,21 @@ platformAdjustToUriPath systemOS srcPath
   | systemOS == windowsOS = '/' : escapedPath
   | otherwise = escapedPath
   where
-    (splitDirectories, splitDrive)
-      | systemOS == windowsOS = (FPW.splitDirectories, FPW.splitDrive)
-      | otherwise = (FPP.splitDirectories, FPP.splitDrive)
+    (splitDirectories, splitDrive, normalise)
+      | systemOS == windowsOS =
+          (FPW.splitDirectories, FPW.splitDrive, FPW.normalise)
+      | otherwise =
+          (FPP.splitDirectories, FPP.splitDrive, FPP.normalise)
     escapedPath =
-        case splitDrive srcPath of
+        case splitDrive (normalise 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
       | systemOS == windowsOS && FPW.hasTrailingPathSeparator drv =
-        FPP.addTrailingPathSeparator (init drv)
+          FPP.addTrailingPathSeparator (init drv)
       | otherwise = drv
     unescaped c
       | systemOS == windowsOS = isUnreserved c || c `elem` [':', '\\', '/']

test/URIFilePathSpec.hs

@@ -11,7 +11,9 @@ import           Network.URI
 import qualified System.FilePath.Windows as FPW
 import Test.Hspec
 import Test.QuickCheck
-
+#if !MIN_VERSION_QuickCheck(2,10,0)
+import Data.Char                              (GeneralCategory(..), generalCategory)
+#endif
 
 -- ---------------------------------------------------------------------
 
@@ -33,11 +35,20 @@ testPosixFilePath = "/home/myself/example.hs"
 relativePosixFilePath :: FilePath
 relativePosixFilePath = "myself/example.hs"
 
+withCurrentDirPosixFilePath :: FilePath
+withCurrentDirPosixFilePath = "/home/./myself/././example.hs"
+
 testWindowsUri :: Uri
-testWindowsUri = Uri $ pack "file:///c:/Users/myself/example.hs"
+testWindowsUri = Uri $ pack "file:///C:/Users/myself/example.hs"
 
 testWindowsFilePath :: FilePath
-testWindowsFilePath = "c:\\Users\\myself\\example.hs"
+testWindowsFilePath = "C:\\Users\\myself\\example.hs"
+
+testWindowsFilePathDriveLowerCase :: FilePath
+testWindowsFilePathDriveLowerCase = "c:\\Users\\myself\\example.hs"
+
+withCurrentDirWindowsFilePath :: FilePath
+withCurrentDirWindowsFilePath = "C:\\Users\\.\\myself\\.\\.\\example.hs"
 
 uriFilePathSpec :: Spec
 uriFilePathSpec = do
@@ -57,31 +68,43 @@ uriFilePathSpec = do
     let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePath
     theUri `shouldBe` testWindowsUri
 
+  it "removes unnecesary current directory paths" $ do
+    let theUri = platformAwareFilePathToUri "posix" withCurrentDirPosixFilePath
+    theUri `shouldBe` testPosixUri
+
+  it "removes unnecesary current directory paths in windows" $ do
+    let theUri = platformAwareFilePathToUri windowsOS withCurrentDirWindowsFilePath
+    theUri `shouldBe` testWindowsUri
+
+  it "make the drive letter upper case when converting a Windows file path to a URI" $ do
+    let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePathDriveLowerCase
+    theUri `shouldBe` testWindowsUri
+
 filePathUriSpec :: Spec
 filePathUriSpec = do
   it "converts a POSIX file path to a URI" $ do
     let theFilePath = platformAwareFilePathToUri "posix" "./Functional.hs"
-    theFilePath `shouldBe` (Uri "file://./Functional.hs")
+    theFilePath `shouldBe` (Uri "file://Functional.hs")
 
   it "converts a Windows file path to a URI" $ do
     let theFilePath = platformAwareFilePathToUri windowsOS "./Functional.hs"
-    theFilePath `shouldBe` (Uri "file:///./Functional.hs")
+    theFilePath `shouldBe` (Uri "file:///Functional.hs")
 
   it "converts a Windows file path to a URI" $ do
     let theFilePath = platformAwareFilePathToUri windowsOS "c:/Functional.hs"
-    theFilePath `shouldBe` (Uri "file:///c:/Functional.hs")
+    theFilePath `shouldBe` (Uri "file:///C:/Functional.hs")
 
   it "converts a POSIX file path to a URI and back" $ do
     let theFilePath = platformAwareFilePathToUri "posix" "./Functional.hs"
-    theFilePath `shouldBe` (Uri "file://./Functional.hs")
-    let Just (URI scheme' auth' path' query' frag') =  parseURI "file://./Functional.hs"
+    theFilePath `shouldBe` (Uri "file://Functional.hs")
+    let Just (URI scheme' auth' path' query' frag') =  parseURI "file://Functional.hs"
     (scheme',auth',path',query',frag') `shouldBe`
       ("file:"
-      ,Just (URIAuth {uriUserInfo = "", uriRegName = ".", uriPort = ""}) -- AZ: Seems odd
-      ,"/Functional.hs"
+      ,Just (URIAuth {uriUserInfo = "", uriRegName = "Functional.hs", uriPort = ""}) -- AZ: Seems odd
+      ,""
       ,""
       ,"")
-    Just "./Functional.hs" `shouldBe` platformAwareUriToFilePath "posix" theFilePath
+    Just "Functional.hs" `shouldBe` platformAwareUriToFilePath "posix" theFilePath
 
   it "converts a Posix file path to a URI and back" $ property $ forAll genPosixFilePath $ \fp -> do
       let uri = platformAwareFilePathToUri "posix" fp
@@ -108,16 +131,24 @@ genWindowsFilePath :: Gen FilePath
 genWindowsFilePath = do
     segments <- listOf pathSegment
     pathSep <- elements ['/', '\\']
-    pure ("C:" <> [pathSep] <> intercalate [pathSep] segments)
-  where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '\\', '.', ':']))
+    driveLetter <- elements ["C:", "c:"]
+    pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments)
+  where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/', '\\', ':']))
 
 genPosixFilePath :: Gen FilePath
 genPosixFilePath = do
     segments <- listOf pathSegment
     pure ("/" <> intercalate "/" segments)
-  where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '.']))
+  where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/']))
+
+genValidUnicodeChar :: Gen Char
+genValidUnicodeChar = arbitraryUnicodeChar `suchThat` isCharacter
+  where isCharacter x = x /= '\65534' && x /= '\65535'
 
 #if !MIN_VERSION_QuickCheck(2,10,0)
-arbitraryASCIIChar :: Gen Char
-arbitraryASCIIChar = arbitrary
+arbitraryUnicodeChar :: Gen Char
+arbitraryUnicodeChar =
+  arbitraryBoundedEnum `suchThat` (not . isSurrogate)
+  where
+    isSurrogate c = generalCategory c == Surrogate
 #endif