haskell-lsp-0.21.0.0: test/URIFilePathSpec.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module URIFilePathSpec where

import Control.Monad                          (when)
import Data.List
#if __GLASGOW_HASKELL__ < 808
import Data.Monoid                            ((<>))
#endif
import Data.Text                              (Text, pack)
import Language.Haskell.LSP.Types

import Network.URI
import Test.Hspec
import Test.QuickCheck
#if !MIN_VERSION_QuickCheck(2,10,0)
import Data.Char                              (GeneralCategory(..), generalCategory)
#endif
import qualified System.FilePath.Windows as FPW
import System.FilePath                        (normalise)
import qualified System.Info
-- ---------------------------------------------------------------------

isWindows :: Bool
isWindows = System.Info.os == "mingw32"

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "Platform aware URI file path functions" platformAwareUriFilePathSpec
  describe "URI file path functions" uriFilePathSpec
  describe "URI normalization functions" uriNormalizeSpec
  describe "Normalized file path functions" normalizedFilePathSpec

windowsOS :: String
windowsOS = "mingw32"

testPosixUri :: Uri
testPosixUri = Uri $ pack "file:///home/myself/example.hs"

testPosixFilePath :: FilePath
testPosixFilePath = "/home/myself/example.hs"

relativePosixFilePath :: FilePath
relativePosixFilePath = "myself/example.hs"

testWindowsUri :: Uri
testWindowsUri = Uri $ pack "file:///c:/Users/myself/example.hs"

testWindowsFilePath :: FilePath
testWindowsFilePath = "c:\\Users\\myself\\example.hs"

platformAwareUriFilePathSpec :: Spec
platformAwareUriFilePathSpec = do
  it "converts a URI to a POSIX file path" $ do
    let theFilePath = platformAwareUriToFilePath "posix" testPosixUri
    theFilePath `shouldBe` Just testPosixFilePath

  it "converts a POSIX file path to a URI" $ do
    let theUri = platformAwareFilePathToUri "posix" testPosixFilePath
    theUri `shouldBe` testPosixUri

  it "converts a URI to a Windows file path" $ do
    let theFilePath = platformAwareUriToFilePath windowsOS testWindowsUri
    theFilePath `shouldBe` Just testWindowsFilePath

  it "converts a Windows file path to a URI" $ do
    let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePath
    theUri `shouldBe` testWindowsUri

  it "converts a POSIX file path to a URI" $ do
    let theFilePath = platformAwareFilePathToUri "posix" "./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")

  it "converts a Windows file path to a URI" $ do
    let theFilePath = platformAwareFilePathToUri windowsOS "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"
    (scheme',auth',path',query',frag') `shouldBe`
      ("file:"
      ,Just (URIAuth {uriUserInfo = "", uriRegName = ".", uriPort = ""}) -- AZ: Seems odd
      ,"/Functional.hs"
      ,""
      ,"")
    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
      platformAwareUriToFilePath "posix" uri `shouldBe` Just fp

  it "converts a Windows file path to a URI and back" $ property $ forAll genWindowsFilePath $ \fp -> do
      let uri = platformAwareFilePathToUri windowsOS fp
      -- We normalise to account for changes in the path separator.
      -- But driver letters are *not* normalized so we skip them
      when (not $ "c:" `isPrefixOf` fp) $
        platformAwareUriToFilePath windowsOS uri `shouldBe` Just (FPW.normalise fp)

  it "converts a relative POSIX file path to a URI and back" $ do
    let uri = platformAwareFilePathToUri "posix" relativePosixFilePath
    uri `shouldBe` Uri "file://myself/example.hs"
    let back = platformAwareUriToFilePath "posix" uri
    back `shouldBe` Just relativePosixFilePath


testUri :: Uri
testUri | isWindows = Uri "file:///C:/Users/myself/example.hs"
        | otherwise = Uri "file:///home/myself/example.hs"

testFilePath :: FilePath
testFilePath | isWindows = "C:\\Users\\myself\\example.hs"
             | otherwise = "/home/myself/example.hs"

withCurrentDirFilePath :: FilePath
withCurrentDirFilePath | isWindows = "C:\\Users\\.\\myself\\.\\.\\example.hs"
                       | otherwise = "/home/./myself/././example.hs"

fromRelativefilePathUri :: Uri
fromRelativefilePathUri | isWindows = Uri  "file:///myself/example.hs"
                        | otherwise = Uri "file://myself/example.hs"

relativeFilePath :: FilePath
relativeFilePath | isWindows = "myself\\example.hs"
                 | otherwise = "myself/example.hs"

withLowerCaseDriveLetterFilePath :: FilePath
withLowerCaseDriveLetterFilePath = "c:\\Users\\.\\myself\\.\\.\\example.hs"

withInitialCurrentDirUriStr :: String
withInitialCurrentDirUriStr | isWindows = "file:///Functional.hs"
                            | otherwise = "file://Functional.hs"

withInitialCurrentDirUriParts :: (String, Maybe URIAuth,  String, String, String)
withInitialCurrentDirUriParts
  | isWindows =
    ("file:"
    ,Just (URIAuth {uriUserInfo = "", uriRegName = "", uriPort = ""}) -- JNS: And asymmetrical
    ,"/Functional.hs","","")
  | otherwise =
     ("file:"
    ,Just (URIAuth {uriUserInfo = "", uriRegName = "Functional.hs", uriPort = ""}) -- AZ: Seems odd
    ,"","","")

withInitialCurrentDirFilePath :: FilePath
withInitialCurrentDirFilePath | isWindows = ".\\Functional.hs"
                              | otherwise = "./Functional.hs"

noNormalizedUriTxt :: Text
noNormalizedUriTxt | isWindows = "file:///c:/Users/./myself/././example.hs"
                   | otherwise = "file:///home/./myself/././example.hs"

noNormalizedUri :: Uri
noNormalizedUri = Uri noNormalizedUriTxt

uriFilePathSpec :: Spec
uriFilePathSpec = do
  it "converts a URI to a file path" $ do
    let theFilePath = uriToFilePath testUri
    theFilePath `shouldBe` Just testFilePath

  it "converts a file path to a URI" $ do
    let theUri = filePathToUri testFilePath
    theUri `shouldBe` testUri

  it "removes unnecesary current directory paths" $ do
    let theUri = filePathToUri withCurrentDirFilePath
    theUri `shouldBe` testUri

  when isWindows $
    it "make the drive letter upper case when converting a Windows file path to a URI" $ do
      let theUri = filePathToUri withLowerCaseDriveLetterFilePath
      theUri `shouldBe` testUri

  it "converts a file path to a URI and back" $ property $ forAll genFilePath $ \fp -> do
      let uri = filePathToUri fp
      uriToFilePath uri `shouldBe` Just (normalise fp)

  it "converts a relative file path to a URI and back" $ do
    let uri = filePathToUri relativeFilePath
    uri `shouldBe` fromRelativefilePathUri
    let back = uriToFilePath uri
    back `shouldBe` Just relativeFilePath

  it "converts a file path with initial current dir to a URI and back" $ do
    let uri = filePathToUri withInitialCurrentDirFilePath
    uri `shouldBe` (Uri (pack withInitialCurrentDirUriStr))
    let Just (URI scheme' auth' path' query' frag') =  parseURI withInitialCurrentDirUriStr
    (scheme',auth',path',query',frag') `shouldBe` withInitialCurrentDirUriParts
    Just "Functional.hs" `shouldBe` uriToFilePath uri

uriNormalizeSpec :: Spec
uriNormalizeSpec = do

  it "ignores differences in percent-encoding" $ property $ \uri ->
    toNormalizedUri (Uri $ pack $ escapeURIString isUnescapedInURI uri) `shouldBe`
        toNormalizedUri (Uri $ pack $ escapeURIString (const False) uri)

  it "ignores differences in percent-encoding (examples)" $ do
    toNormalizedUri (Uri $ pack "http://server/path%C3%B1?param=%C3%B1") `shouldBe`
        toNormalizedUri (Uri $ pack "http://server/path%c3%b1?param=%c3%b1")
    toNormalizedUri (Uri $ pack "file:///path%2A") `shouldBe`
        toNormalizedUri (Uri $ pack "file:///path%2a")

  it "normalizes uri file path when converting from uri to normalized uri" $ do
    let (NormalizedUri _ uri) = toNormalizedUri noNormalizedUri
    let (Uri nuri) = testUri
    uri `shouldBe` nuri

  it "converts a file path with reserved uri chars to a normalized URI and back" $ do
    let start = if isWindows then "C:\\" else "/"
    let fp = start ++ "path;part#fragmen?param=val"
    let nuri = toNormalizedUri (filePathToUri fp)
    uriToFilePath (fromNormalizedUri nuri) `shouldBe` Just fp

  it "converts a file path with substrings that looks like uri escaped chars and back" $ do
    let start = if isWindows then "C:\\" else "/"
    let fp = start ++ "ca%C3%B1a"
    let nuri = toNormalizedUri (filePathToUri fp)
    uriToFilePath (fromNormalizedUri nuri) `shouldBe` Just fp

  it "converts a file path to a normalized URI and back" $ property $ forAll genFilePath $ \fp -> do
    let nuri = toNormalizedUri (filePathToUri fp)
    case uriToFilePath (fromNormalizedUri nuri) of
      Just nfp -> nfp `shouldBe` (normalise fp)
      Nothing -> return () -- Some unicode paths creates invalid uris, ignoring for now

genFilePath :: Gen FilePath
genFilePath | isWindows = genWindowsFilePath
            | otherwise = genPosixFilePath

genWindowsFilePath :: Gen FilePath
genWindowsFilePath = do
    segments <- listOf1 pathSegment
    pathSep <- elements ['/', '\\']
    driveLetter <- elements ["C:", "c:"]
    pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments)
  where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/', '\\', ':']))

genPosixFilePath :: Gen FilePath
genPosixFilePath = do
    segments <- listOf1 pathSegment
    pure ("/" <> intercalate "/" segments)
  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
arbitraryUnicodeChar =
  arbitraryBoundedEnum `suchThat` (not . isSurrogate)
  where
    isSurrogate c = generalCategory c == Surrogate
#endif

normalizedFilePathSpec :: Spec
normalizedFilePathSpec = do
  it "makes file path normalized" $ property $ forAll genFilePath $ \fp -> do
    let nfp = toNormalizedFilePath fp
    fromNormalizedFilePath nfp `shouldBe` (normalise fp)

  it "converts to a normalized uri and back" $ property $ forAll genFilePath $ \fp -> do
    let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)
    case uriToNormalizedFilePath nuri of
      Just nfp -> fromNormalizedFilePath nfp `shouldBe` (normalise fp)
      Nothing -> return () -- Some unicode paths creates invalid uris, ignoring for now

  it "converts a file path with reserved uri chars to a normalized URI and back" $ do
    let start = if isWindows then "C:\\" else "/"
    let fp = start ++ "path;part#fragmen?param=val"
    let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)
    fmap fromNormalizedFilePath (uriToNormalizedFilePath nuri) `shouldBe` Just fp

  it "converts a file path with substrings that looks like uri escaped chars and back" $ do
    let start = if isWindows then "C:\\" else "/"
    let fp = start ++ "ca%C3%B1a"
    let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)
    fmap fromNormalizedFilePath (uriToNormalizedFilePath nuri) `shouldBe` Just fp

  it "creates the same NormalizedUri than the older implementation" $ property $ forAll genFilePath $ \fp -> do
    let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)
    let oldNuri = toNormalizedUri (filePathToUri fp)
    nuri `shouldBe` oldNuri