diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs index 5e063b5c9..3cdcde4c9 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs +++ b/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,11 +84,13 @@ 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) @@ -94,7 +98,7 @@ platformAdjustToUriPath systemOS srcPath -- 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` [':', '\\', '/'] diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs index bf2a0d35c..e563b191b 100644 --- a/test/URIFilePathSpec.hs +++ b/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