haskell-lsp-0.19.0.0: test/URIFilePathSpec.hs

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

import Data.List
import Data.Monoid ((<>))
import Data.Text                              (pack)
import Language.Haskell.LSP.Types

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

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

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "URI file path functions" uriFilePathSpec
  describe "file path URI functions" filePathUriSpec
  describe "URI normalization functions" uriNormalizeSpec

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

testPosixFilePath :: FilePath
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"

testWindowsFilePath :: FilePath
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
    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 "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")

  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 = "Functional.hs", uriPort = ""}) -- AZ: Seems odd
      ,""
      ,""
      ,"")
    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.
      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

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

genWindowsFilePath :: Gen FilePath
genWindowsFilePath = do
    segments <- listOf 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 <- listOf 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