lsp-types-2.4.0.0: test/URIFilePathSpec.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- We're testing our own deprecated function here!
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

#if MIN_VERSION_filepath(1,4,100)

#define OS_PATH
#endif

module URIFilePathSpec where

#ifdef OS_PATH
import qualified System.OsPath           as OsPath
import Control.Exception (throwIO)
import Data.Maybe (fromJust)
#endif

import Control.Monad (when)
import Data.List
import Data.Text (Text, pack)
import Language.LSP.Protocol.Types

import GHC.IO.Encoding (setFileSystemEncoding)
import Network.URI
import System.FilePath (normalise)
import System.FilePath.Windows qualified as FPW
import System.IO
import System.Info qualified
import Test.Hspec
import Test.QuickCheck

-- ---------------------------------------------------------------------

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 unnecessary 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'

normalizedFilePathSpec :: Spec
normalizedFilePathSpec = beforeAll (setFileSystemEncoding utf8) $ 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

#ifdef OS_PATH
  it "converts to NormalizedFilePath and back sucessfully" $ property $ forAll genFilePath $ \fp -> do
    let osPath = fromJust (OsPath.encodeUtf fp)
    osPath' <- osPathToNormalizedFilePath osPath >>= normalizedFilePathToOsPath
    osPath' `shouldBe` OsPath.normalise osPath

  it "can not convert OsPath in non-standard encoding to NormalizedFilePath" $
    -- Windows always use UTF16LE, the following test case doesn't apply
    when (not isWindows) $
      -- \184921 is an example that the raw bytes of UTF16 is not valid UTF8.
      -- Case like this is not very common. I found it with the help of QuickCheck.
      case OsPath.encodeWith utf16be utf16be "\184921" of
        Left err -> throwIO err
        Right osPath  -> do
          osPathToNormalizedFilePath osPath `shouldThrow` \(_ :: EncodingException) -> True
#endif