diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,16 @@ +filepath-bytestring (1.4.2.1.1) unstable; urgency=medium + + * When running on Windows, RawFilePath is assumed to be encoded with + UTF-8, rather than the windows default of UTF-16. This lets the user + use OverloadedStrings for RawFilePaths embedded in their code. + * Added two conversion functions, encodeFilePath and decodeFilePath. + * Added normalise. + * Optimise with -O2, a benchmark shows that improves the speed + of by around 7%. + * Inline , which speeds it up by around 3%. + + -- Joey Hess Wed, 18 Dec 2019 13:42:16 -0400 + filepath-bytestring (1.4.2.1.0) unstable; urgency=medium * Initial release, based on filepath 1.4.2.1. diff --git a/System/FilePath/ByteString.hs b/System/FilePath/ByteString.hs --- a/System/FilePath/ByteString.hs +++ b/System/FilePath/ByteString.hs @@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 704 -{-# LANGUAGE Safe #-} -#endif {- | Module : System.FilePath.ByteString Copyright : (c) Neil Mitchell 2005-2014, (c) Joey Hess 2019 diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -1,6 +1,3 @@ -#if __GLASGOW_HASKELL__ >= 704 -{-# LANGUAGE Safe #-} -#endif {-# LANGUAGE OverloadedStrings #-} -- This template expects CPP definitions for: @@ -63,6 +60,40 @@ ( -- * Types RawFilePath, + -- * Filename encoding + -- + -- | When using `FilePath`, you do not usually need to care about how + -- it is encoded, because it is a @[Char]@ and encoding and decoding is + -- handled by IO actions as needed. Unfortunately the situation is more + -- complicated when using `RawFilePath`. + -- + -- It's natural to enable `OverloadedStrings` and use it to construct + -- a `RawFilePath`, eg @"foo" '' "bar"@. A gotcha though is that + -- any non-ascii characters will be truncated to 8 bits. That is not a + -- limitation of this library, but of the `IsString` implementation + -- of `ByteString`. + -- + -- Posix filenames do not have any defined encoding. This library + -- assumes that whatever encoding may be used for a `RawFilePath`, + -- it is compatable with ASCII. In particular, 0x2F (/) is always + -- a path separator, and 0x2E (.) is assumed to be an extension + -- separator. All encodings in common use are compatible with ASCII, + -- and unix tools have always made similar assumptions, + -- so this is unlikely to be a problem, unless you are dealing with + -- EBCDIC or similar historical oddities. + -- + -- Windows's API expects filenames to be encoded with UTF-16. + -- This is especially problimatic when using OverloadedStrings + -- since a ByteString "bar" is not a valid encoding for a + -- Windows filename (but "b\\0a\\0r\\0" is). To avoid this problem, + -- and to simplify the implementation, + -- `RawFilePath` is assumed to be encoded with UTF-8 (not UTF-16) + -- when this library is used on Windows. + -- There are not currently any libraries for Windows that use + -- `RawFilePath`, so you will probably need to convert them back to + -- `FilePath` in order to do IO in any case. + encodeFilePath, + decodeFilePath, -- * Separator predicates pathSeparator, pathSeparators, isPathSeparator, searchPathSeparator, isSearchPathSeparator, @@ -95,10 +126,10 @@ dropTrailingPathSeparator, -- * File name manipulations - --normalise, equalFilePath, + normalise, --equalFilePath, --makeRelative, isRelative, isAbsolute, - isValid, -- makeValid + isValid, --makeValid ) where @@ -108,6 +139,13 @@ import Data.Char(ord, chr, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.Word(Word8) +#ifdef mingw32_HOST_OS +import qualified Data.ByteString.UTF8 as UTF8 +#else +import qualified GHC.Foreign as GHC +import qualified GHC.IO.Encoding as Encoding +import System.IO.Unsafe (unsafePerformIO) +#endif #ifndef mingw32_HOST_OS -- Import from unix, rather than redefining, so users who import both @@ -123,6 +161,45 @@ infixr 5 +-- | Convert from FilePath to RawFilePath. +-- +-- When run on Unix, this applies the filesystem encoding +-- (see `Encoding.getFileSystemEncoding`). +-- +-- When run on Windows, this encodes as UTF-8. +encodeFilePath :: FilePath -> RawFilePath +#ifdef mingw32_HOST_OS +encodeFilePath = UTF8.fromString +#else +encodeFilePath = B.pack . map (fromIntegral . fromEnum) . encodeFilePath' + +{-# NOINLINE encodeFilePath' #-} +encodeFilePath' :: FilePath -> String +encodeFilePath' f = unsafePerformIO $ do + enc <- Encoding.getFileSystemEncoding + GHC.withCString enc f (GHC.peekCString Encoding.char8) +#endif + +-- | Convert from RawFilePath to FilePath +-- +-- When run on Unix, this applies the filesystem encoding +-- (see `Encoding.getFileSystemEncoding`). +-- +-- When run on Windows, this decodes UTF-8. +decodeFilePath :: RawFilePath -> FilePath +#ifdef mingw32_HOST_OS +decodeFilePath = UTF8.toString +#else +decodeFilePath = decodeFilePath' . map (toEnum . fromIntegral) . B.unpack + +{-# NOINLINE decodeFilePath' #-} +decodeFilePath' :: String -> FilePath +decodeFilePath' s = unsafePerformIO $ do + enc <- Encoding.getFileSystemEncoding + GHC.withCString Encoding.char8 s (GHC.peekCString enc) +#endif + + --------------------------------------------------------------------- -- Platform Abstraction Methods (private) @@ -688,9 +765,10 @@ replaceDirectory :: RawFilePath -> ByteString -> RawFilePath replaceDirectory x dir = combineAlways dir (takeFileName x) +{-# INLINE combine #-} -- | An alias for ''. combine :: RawFilePath -> RawFilePath -> RawFilePath -combine a b | hasLeadingPathSeparator b || hasDrive b = b +combine a b | hasLeadingPathSeparator b || (not isPosix && hasDrive b) = b | otherwise = combineAlways a b -- | Combine two paths, assuming rhs is NOT absolute. @@ -794,7 +872,6 @@ {- - --------------------------------------------------------------------- -- File name manipulators @@ -810,13 +887,17 @@ -- > untested Posix: not (equalFilePath "foo" "FOO") -- > untested Windows: equalFilePath "foo" "FOO" -- > untested Windows: not (equalFilePath "C:" "C:/") -equalFilePath :: FilePath -> FilePath -> Bool +equalFilePath :: RawFilePath -> RawFilePath -> Bool equalFilePath a b = f a == f b where - f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x +-- FIXME: B8.map will not lower-case non-ascii characters. + f x | isWindows = dropTrailingPathSeparator $ B8.map toLower $ normalise x | otherwise = dropTrailingPathSeparator $ normalise x +-} +{- + -- | Contract a filename, based on a relative path. Note that the resulting path -- will never introduce @..@ paths, as the presence of symlinks means @..\/b@ -- may not reach @a\/b@ if it starts from @a\/c@. For a worked example see @@ -862,6 +943,8 @@ takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator] takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x +-} + -- | Normalise a file -- -- * \/\/ outside of the drive can be made blank @@ -870,29 +953,31 @@ -- -- * .\/ -> \"\" -- --- > untested Posix: normalise "/file/\\test////" == "/file/\\test/" --- > untested Posix: normalise "/file/./test" == "/file/test" --- > untested Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" --- > untested Posix: normalise "../bob/fred/" == "../bob/fred/" --- > untested Posix: normalise "./bob/fred/" == "bob/fred/" --- > untested Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" --- > untested Windows: normalise "c:\\" == "C:\\" --- > untested Windows: normalise "C:.\\" == "C:" --- > untested Windows: normalise "\\\\server\\test" == "\\\\server\\test" --- > untested Windows: normalise "//server/test" == "\\\\server\\test" --- > untested Windows: normalise "c:/file" == "C:\\file" --- > untested Windows: normalise "/file" == "\\file" --- > untested Windows: normalise "\\" == "\\" --- > untested Windows: normalise "/./" == "\\" --- > untested normalise "." == "." --- > untested Posix: normalise "./" == "./" --- > untested Posix: normalise "./." == "./" --- > untested Posix: normalise "/./" == "/" --- > untested Posix: normalise "/" == "/" --- > untested Posix: normalise "bob/fred/." == "bob/fred/" --- > untested Posix: normalise "//home" == "/home" -normalise :: FilePath -> FilePath -normalise path = result ++ [pathSeparator | addPathSeparator] +-- > Posix: normalise "/file/\\test////" == "/file/\\test/" +-- > Posix: normalise "/file/./test" == "/file/test" +-- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" +-- > Posix: normalise "../bob/fred/" == "../bob/fred/" +-- > Posix: normalise "./bob/fred/" == "bob/fred/" +-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" +-- > Windows: normalise "c:\\" == "C:\\" +-- > Windows: normalise "C:.\\" == "C:" +-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" +-- > Windows: normalise "//server/test" == "\\\\server\\test" +-- > Windows: normalise "c:/file" == "C:\\file" +-- > Windows: normalise "/file" == "\\file" +-- > Windows: normalise "\\" == "\\" +-- > Windows: normalise "/./" == "\\" +-- > normalise "." == "." +-- > Posix: normalise "./" == "./" +-- > Posix: normalise "./." == "./" +-- > Posix: normalise "/./" == "/" +-- > Posix: normalise "/" == "/" +-- > Posix: normalise "bob/fred/." == "bob/fred/" +-- > Posix: normalise "//home" == "/home" +normalise :: RawFilePath -> RawFilePath +normalise path + | addPathSeparator = result <> B.singleton pathSeparator + | otherwise = result where (drv,pth) = splitDrive path result = joinDrive' (normaliseDrive drv) (f pth) @@ -905,28 +990,33 @@ && not (isRelativeDrive drv) isDirPath xs = hasTrailingPathSeparator xs - || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs) + || not (B.null xs) && B.last xs == extSeparator && hasTrailingPathSeparator (B.init xs) + f :: RawFilePath -> RawFilePath f = joinPath . dropDots . propSep . splitDirectories - propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs + propSep :: [RawFilePath] -> [RawFilePath] + propSep (x:xs) | B.all isPathSeparator x = B.singleton pathSeparator : xs | otherwise = x : xs propSep [] = [] + dropDots :: [RawFilePath] -> [RawFilePath] dropDots = filter ("." /=) -normaliseDrive :: FilePath -> FilePath +normaliseDrive :: RawFilePath -> RawFilePath normaliseDrive "" = "" -normaliseDrive _ | isPosix = [pathSeparator] +normaliseDrive _ | isPosix = B.singleton pathSeparator normaliseDrive drive = if isJust $ readDriveLetter x2 - then map toUpper x2 + then upcasedriveletter x2 else x2 where - x2 = map repSlash drive + x2 = B.map repSlash drive repSlash x = if isPathSeparator x then pathSeparator else x --} + -- A Windows drive letter is an ascii character, so it's safe to + -- operate on the ByteString containing it using B8. + upcasedriveletter = B8.map toUpper -- Information for validity functions on Windows. See [1]. isBadCharacter :: Word8 -> Bool diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,11 +1,3 @@ * Some functions have not been ported from FilePath and are commented out: splitSearchPath, getSearchPath, normalise, equalFilePath, makeRelative, makeValid. Implementations would be accepted if you need any of these. -* combine checks hasDrive on posix, this is unnecessary - since hasLeadingPathSeparator checks the same thing - there. isWindows && hasDrive would cover windows while - avoiding that overhead. Benchmark to see if it improves. -* Test suite may not build on Windows due to its use of - getFileSystemEncoding. -* How filename encoding even works in this ByteString library should perhaps be - documented. diff --git a/filepath-bytestring.cabal b/filepath-bytestring.cabal --- a/filepath-bytestring.cabal +++ b/filepath-bytestring.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.18 name: filepath-bytestring -version: 1.4.2.1.0 +version: 1.4.2.1.1 -- NOTE: Don't forget to update CHANGELOG and the filepath version below license: BSD3 license-file: LICENSE @@ -51,10 +51,12 @@ build-depends: base >= 4 && < 4.15, bytestring - if !os(Windows) + if os(Windows) + build-depends: utf8-string + else build-depends: unix - ghc-options: -Wall + ghc-options: -O2 -Wall test-suite filepath-tests type: exitcode-stdio-1.0 diff --git a/tests/TestEquiv.hs b/tests/TestEquiv.hs --- a/tests/TestEquiv.hs +++ b/tests/TestEquiv.hs @@ -44,6 +44,7 @@ ,("equiv Posix.hasTrailingPathSeparator", equiv_1 OurPosix.hasTrailingPathSeparator TheirPosix.hasTrailingPathSeparator) ,("equiv Posix.addTrailingPathSeparator", equiv_1 OurPosix.addTrailingPathSeparator TheirPosix.addTrailingPathSeparator) ,("equiv Posix.dropTrailingPathSeparator", equiv_1 OurPosix.dropTrailingPathSeparator TheirPosix.dropTrailingPathSeparator) + ,("equiv Posix.normalise", equiv_1 OurPosix.normalise TheirPosix.normalise) ,("equiv Windows.isPathSeparator", equiv_0 OurWindows.isPathSeparator TheirWindows.isPathSeparator) ,("equiv Windows.isSearchPathSeparator", equiv_0 OurWindows.isSearchPathSeparator TheirWindows.isSearchPathSeparator) ,("equiv Windows.isExtSeparator", equiv_0 OurWindows.isExtSeparator TheirWindows.isExtSeparator) @@ -80,4 +81,5 @@ ,("equiv Windows.hasTrailingPathSeparator", equiv_1 OurWindows.hasTrailingPathSeparator TheirWindows.hasTrailingPathSeparator) ,("equiv Windows.addTrailingPathSeparator", equiv_1 OurWindows.addTrailingPathSeparator TheirWindows.addTrailingPathSeparator) ,("equiv Windows.dropTrailingPathSeparator", equiv_1 OurWindows.dropTrailingPathSeparator TheirWindows.dropTrailingPathSeparator) + ,("equiv Windows.normalise", equiv_1 OurWindows.normalise TheirWindows.normalise) ] diff --git a/tests/TestGen.hs b/tests/TestGen.hs --- a/tests/TestGen.hs +++ b/tests/TestGen.hs @@ -345,6 +345,28 @@ ,("P.joinPath [] == \"\"", property $ P.joinPath [] == "") ,("W.joinPath [] == \"\"", property $ W.joinPath [] == "") ,("P.joinPath [\"test\", \"file\", \"path\"] == \"test/file/path\"", property $ P.joinPath ["test", "file", "path"] == "test/file/path") + ,("P.normalise \"/file/\\\\test////\" == \"/file/\\\\test/\"", property $ P.normalise "/file/\\test////" == "/file/\\test/") + ,("P.normalise \"/file/./test\" == \"/file/test\"", property $ P.normalise "/file/./test" == "/file/test") + ,("P.normalise \"/test/file/../bob/fred/\" == \"/test/file/../bob/fred/\"", property $ P.normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/") + ,("P.normalise \"../bob/fred/\" == \"../bob/fred/\"", property $ P.normalise "../bob/fred/" == "../bob/fred/") + ,("P.normalise \"./bob/fred/\" == \"bob/fred/\"", property $ P.normalise "./bob/fred/" == "bob/fred/") + ,("W.normalise \"c:\\\\file/bob\\\\\" == \"C:\\\\file\\\\bob\\\\\"", property $ W.normalise "c:\\file/bob\\" == "C:\\file\\bob\\") + ,("W.normalise \"c:\\\\\" == \"C:\\\\\"", property $ W.normalise "c:\\" == "C:\\") + ,("W.normalise \"C:.\\\\\" == \"C:\"", property $ W.normalise "C:.\\" == "C:") + ,("W.normalise \"\\\\\\\\server\\\\test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "\\\\server\\test" == "\\\\server\\test") + ,("W.normalise \"//server/test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "//server/test" == "\\\\server\\test") + ,("W.normalise \"c:/file\" == \"C:\\\\file\"", property $ W.normalise "c:/file" == "C:\\file") + ,("W.normalise \"/file\" == \"\\\\file\"", property $ W.normalise "/file" == "\\file") + ,("W.normalise \"\\\\\" == \"\\\\\"", property $ W.normalise "\\" == "\\") + ,("W.normalise \"/./\" == \"\\\\\"", property $ W.normalise "/./" == "\\") + ,("P.normalise \".\" == \".\"", property $ P.normalise "." == ".") + ,("W.normalise \".\" == \".\"", property $ W.normalise "." == ".") + ,("P.normalise \"./\" == \"./\"", property $ P.normalise "./" == "./") + ,("P.normalise \"./.\" == \"./\"", property $ P.normalise "./." == "./") + ,("P.normalise \"/./\" == \"/\"", property $ P.normalise "/./" == "/") + ,("P.normalise \"/\" == \"/\"", property $ P.normalise "/" == "/") + ,("P.normalise \"bob/fred/.\" == \"bob/fred/\"", property $ P.normalise "bob/fred/." == "bob/fred/") + ,("P.normalise \"//home\" == \"/home\"", property $ P.normalise "//home" == "/home") ,("P.isValid \"\" == False", property $ P.isValid "" == False) ,("W.isValid \"\" == False", property $ W.isValid "" == False) ,("P.isValid \"\\0\" == False", property $ P.isValid "\0" == False) diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs --- a/tests/TestUtil.hs +++ b/tests/TestUtil.hs @@ -16,11 +16,7 @@ import Control.Monad import qualified System.FilePath.Windows as W import qualified System.FilePath.Posix as P -import System.FilePath.ByteString (RawFilePath) -import qualified GHC.Foreign as GHC -import qualified GHC.IO.Encoding as Encoding -import System.IO.Unsafe -import qualified Data.ByteString as B +import System.FilePath.ByteString (RawFilePath, encodeFilePath) infixr 0 ==> a ==> b = not a || b @@ -29,32 +25,7 @@ toRawFilePath :: t -> RawFilePath instance ToRawFilePath [Char] where - toRawFilePath = B.pack . decodeW8NUL - -decodeW8NUL :: String -> [Word8] -decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul - where - nul = '\NUL' - -c2w8 :: Char -> Word8 -c2w8 = fromIntegral . fromEnum - -s2w8 :: String -> [Word8] -s2w8 = map c2w8 - -splitc :: Eq c => c -> [c] -> [[c]] -splitc c s = case break (== c) s of - (i, _c:rest) -> i : splitc c rest - (i, []) -> i : [] - -decodeW8 :: FilePath -> [Word8] -decodeW8 = s2w8 . encodeFilePath - -{-# NOINLINE encodeFilePath #-} -encodeFilePath :: String -> String -encodeFilePath fp = unsafePerformIO $ do - enc <- Encoding.getFileSystemEncoding - GHC.withCString enc fp (GHC.peekCString Encoding.char8) + toRawFilePath = encodeFilePath newtype QFilePathValidW = QFilePathValidW FilePath deriving Show