From ce7d7da4b947d8062e7ec291ee34f6c7f44c615c Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 26 Nov 2019 12:09:58 +0100 Subject: [PATCH 1/8] Make driver upper case for windows --- haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) 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..36baa080f 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs @@ -5,6 +5,7 @@ module Language.Haskell.LSP.Types.Uri where import Control.DeepSeq import qualified Data.Aeson as A +import Data.Char (toUpper) import Data.Hashable import Data.Text (Text) import qualified Data.Text as T @@ -83,8 +84,10 @@ platformAdjustToUriPath systemOS srcPath | otherwise = escapedPath where (splitDirectories, splitDrive) - | systemOS == windowsOS = (FPW.splitDirectories, FPW.splitDrive) - | otherwise = (FPP.splitDirectories, FPP.splitDrive) + | systemOS == windowsOS = + (FPW.splitDirectories, (\(f,s)-> (map toUpper f, s)) . FPW.splitDrive) + | otherwise = + (FPP.splitDirectories, FPP.splitDrive) escapedPath = case splitDrive srcPath of (drv, rest) -> @@ -94,7 +97,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` [':', '\\', '/'] From bdbc380a27db4a02eec6116a57cdaf0170800cda Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 26 Nov 2019 14:21:54 +0100 Subject: [PATCH 2/8] Add coment about win driver letter --- haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs | 2 ++ 1 file changed, 2 insertions(+) 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 36baa080f..9beee3bbb 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs @@ -86,6 +86,8 @@ platformAdjustToUriPath systemOS srcPath (splitDirectories, splitDrive) | systemOS == windowsOS = (FPW.splitDirectories, (\(f,s)-> (map toUpper f, s)) . FPW.splitDrive) + -- We ensure the driver letter is upper case for windows to make `c:\` and `C:\` equivalent + -- See https://tools.ietf.org/html/rfc8089#page-13 | otherwise = (FPP.splitDirectories, FPP.splitDrive) escapedPath = From 9d39af80efb18e4fa7c8265689bf7e2439c1e402 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 26 Nov 2019 14:22:50 +0100 Subject: [PATCH 3/8] Update tests to cover win driver letter --- test/URIFilePathSpec.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs index bf2a0d35c..3ebc0eee7 100644 --- a/test/URIFilePathSpec.hs +++ b/test/URIFilePathSpec.hs @@ -34,10 +34,13 @@ relativePosixFilePath :: FilePath relativePosixFilePath = "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" uriFilePathSpec :: Spec uriFilePathSpec = do @@ -57,6 +60,10 @@ uriFilePathSpec = do let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePath 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 @@ -69,7 +76,7 @@ filePathUriSpec = do 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" @@ -108,7 +115,8 @@ genWindowsFilePath :: Gen FilePath genWindowsFilePath = do segments <- listOf pathSegment pathSep <- elements ['/', '\\'] - pure ("C:" <> [pathSep] <> intercalate [pathSep] segments) + driveLetter <- elements ["C:", "c:"] + pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments) where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '\\', '.', ':'])) genPosixFilePath :: Gen FilePath From ee05ef5229035abeea5e223be8dababe2bbaf5bd Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 28 Nov 2019 11:22:24 +0100 Subject: [PATCH 4/8] Ensure all `Uri`s have the file path normalized --- haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) 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 9beee3bbb..067875dbf 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs @@ -27,8 +27,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 From d12cf9cde0d370d69a945c3886a568f238fd66c5 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 5 Dec 2019 10:53:06 +0100 Subject: [PATCH 5/8] Use FP.normalise to ensure uniqueness of file paths --- .../src/Language/Haskell/LSP/Types/Uri.hs | 11 +++-- test/URIFilePathSpec.hs | 43 +++++++++++++------ 2 files changed, 36 insertions(+), 18 deletions(-) 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 067875dbf..471ab658e 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs @@ -11,6 +11,7 @@ import Data.Text (Text) import qualified Data.Text as T import GHC.Generics import Network.URI hiding (authority) +import qualified System.FilePath as FP import qualified System.FilePath.Posix as FPP import qualified System.FilePath.Windows as FPW import qualified System.Info @@ -85,15 +86,13 @@ platformAdjustToUriPath systemOS srcPath | systemOS == windowsOS = '/' : escapedPath | otherwise = escapedPath where - (splitDirectories, splitDrive) + (splitDirectories, splitDrive, normalise) | systemOS == windowsOS = - (FPW.splitDirectories, (\(f,s)-> (map toUpper f, s)) . FPW.splitDrive) - -- We ensure the driver letter is upper case for windows to make `c:\` and `C:\` equivalent - -- See https://tools.ietf.org/html/rfc8089#page-13 + (FPW.splitDirectories, FPW.splitDrive, FPW.normalise) | otherwise = - (FPP.splitDirectories, FPP.splitDrive) + (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) diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs index 3ebc0eee7..b6fbbb8b3 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,6 +35,9 @@ 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" @@ -42,6 +47,9 @@ 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 it "converts a URI to a POSIX file path" $ do @@ -60,6 +68,14 @@ 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 @@ -68,11 +84,11 @@ 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" @@ -80,15 +96,15 @@ filePathUriSpec = do 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 @@ -117,15 +133,18 @@ genWindowsFilePath = do pathSep <- elements ['/', '\\'] driveLetter <- elements ["C:", "c:"] pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments) - where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '\\', '.', ':'])) + where pathSegment = listOf1 (arbitraryUnicodeChar `suchThat` (`notElem` ['/', '\\', ':'])) genPosixFilePath :: Gen FilePath genPosixFilePath = do segments <- listOf pathSegment pure ("/" <> intercalate "/" segments) - where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '.'])) + where pathSegment = listOf1 (arbitraryUnicodeChar `suchThat` (`notElem` ['/'])) #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 From 8fc3e3fe68ee1672121304973ce7612b55e9952f Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 5 Dec 2019 10:58:54 +0100 Subject: [PATCH 6/8] Remove unused imports and formating --- haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs | 2 -- test/URIFilePathSpec.hs | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) 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 471ab658e..3cdcde4c9 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Uri.hs @@ -5,13 +5,11 @@ module Language.Haskell.LSP.Types.Uri where import Control.DeepSeq import qualified Data.Aeson as A -import Data.Char (toUpper) import Data.Hashable import Data.Text (Text) import qualified Data.Text as T import GHC.Generics import Network.URI hiding (authority) -import qualified System.FilePath as FP import qualified System.FilePath.Posix as FPP import qualified System.FilePath.Windows as FPW import qualified System.Info diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs index b6fbbb8b3..54688cdfd 100644 --- a/test/URIFilePathSpec.hs +++ b/test/URIFilePathSpec.hs @@ -12,7 +12,7 @@ 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) +import Data.Char (GeneralCategory(..), generalCategory) #endif -- --------------------------------------------------------------------- From b00a087d45457a0a93c867c41423ad9dd0edd8a3 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 5 Dec 2019 14:04:45 +0100 Subject: [PATCH 7/8] Remove non character from unicode points --- test/URIFilePathSpec.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs index 54688cdfd..f2e7937b9 100644 --- a/test/URIFilePathSpec.hs +++ b/test/URIFilePathSpec.hs @@ -133,7 +133,9 @@ genWindowsFilePath = do pathSep <- elements ['/', '\\'] driveLetter <- elements ["C:", "c:"] pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments) - where pathSegment = listOf1 (arbitraryUnicodeChar `suchThat` (`notElem` ['/', '\\', ':'])) + where pathSegment = listOf1 (validUnicodeChar `suchThat` (`notElem` ['/', '\\', ':'])) + validUnicodeChar = arbitraryUnicodeChar `suchThat` isValidUnicodeChar + isValidUnicodeChar x = x /= '\65534' && x /= '\65535' genPosixFilePath :: Gen FilePath genPosixFilePath = do From 1e46c3129c2e2250b1c2de645fae7e8eb0c03745 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 5 Dec 2019 14:13:09 +0100 Subject: [PATCH 8/8] Apply validUnicodeChars to posix file path generator --- test/URIFilePathSpec.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs index f2e7937b9..e563b191b 100644 --- a/test/URIFilePathSpec.hs +++ b/test/URIFilePathSpec.hs @@ -133,15 +133,17 @@ genWindowsFilePath = do pathSep <- elements ['/', '\\'] driveLetter <- elements ["C:", "c:"] pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments) - where pathSegment = listOf1 (validUnicodeChar `suchThat` (`notElem` ['/', '\\', ':'])) - validUnicodeChar = arbitraryUnicodeChar `suchThat` isValidUnicodeChar - isValidUnicodeChar x = x /= '\65534' && x /= '\65535' + where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/', '\\', ':'])) genPosixFilePath :: Gen FilePath genPosixFilePath = do segments <- listOf pathSegment pure ("/" <> intercalate "/" segments) - where pathSegment = listOf1 (arbitraryUnicodeChar `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) arbitraryUnicodeChar :: Gen Char