diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,5 @@ +filepath-bytestring (1.4.2.1.0) unstable; urgency=medium + + * Initial release, based on filepath 1.4.2.1. + + -- Joey Hess Tue, 10 Dec 2019 15:21:14 -0400 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Neil Mitchell 2005-2019. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Neil Mitchell nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,31 @@ +# FilePath [![Hackage version](https://img.shields.io/hackage/v/filepath.svg?label=Hackage)](https://hackage.haskell.org/package/filepath) [![Linux build status](https://img.shields.io/travis/haskell/filepath/master.svg?label=Linux%20build)](https://travis-ci.org/haskell/filepath) [![Windows build status](https://img.shields.io/appveyor/ci/ndmitchell/filepath/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/filepath) + +The `filepath-bytestring` package provides functionality for manipulating `RawFilePath` values (`ByteString`s). +Its interface is equivilant to the `filepath` package. +It provides three modules: + +* [`System.FilePath.Posix.ByteString`](http://hackage.haskell.org/package/filepath-bytestring/docs/System-FilePath-Posix-ByteString.html) manipulates POSIX/Linux style `RawFilePath` values (with `/` as the path separator). +* [`System.FilePath.Windows.ByteString`](http://hackage.haskell.org/package/filepath-bytestring/docs/System-FilePath-Windows-ByteString.html) manipulates Windows style `RawFilePath` values (with either `\` or `/` as the path separator, and deals with drives). +* [`System.FilePath.ByteString`](http://hackage.haskell.org/package/filepath-bytestring/docs/System-FilePath-ByteString.html) is an alias for the module appropriate to your platform. + +All three modules provide the same API, and the same documentation (calling out differences in the different variants). + +### Developer notes + +This package's version should be the same as the `filepath` it's derived +from, with an added revision number. + +Most of the code is in `System/FilePath/Internal.hs` which is `#include`'d into both `System/FilePath/Posix.hs` and `System/FilePath/Windows.hs` with the `IS_WINDOWS` CPP define set to either `True` or `False`. This Internal module is a bit weird in that it isn't really a Haskell module, but is more an include file. + +The library has extensive doc tests. Anything starting with `-- >` is transformed into a doc test as a predicate that must evaluate to `True`. These tests follow a few rules: + +* Tests prefixed with `Windows:` or `Posix:` are only tested against that specific implementation - otherwise tests are run against both implementations. +* Any single letter variable, e.g. `x`, is considered universal quantification, and is checked with `QuickCheck`. +* If `Valid x =>` appears at the start of a doc test, that means the property will only be tested with `x` passing the `isValid` predicate. + +Also, all exported functions are quickchecked against the ones from +`filepath` to make sure thay generate equivilant results. + +The tests can be generated by `Generate.hs` in the root of the repo, and will be placed in `tests/TestGen.hs`. The `TestGen.hs` file is checked into the repo, and the CI scripts check that `TestGen.hs` is in sync with what would be generated a fresh - if you don't regenerate `TestGen.hs` the CI will fail. + +The `.ghci` file is set up to allow you to type `ghci` to open the library, then `:go` will regenerate the tests and run them. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/FilePath/ByteString.hs b/System/FilePath/ByteString.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/ByteString.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Safe #-} +#endif +{- | +Module : System.FilePath.ByteString +Copyright : (c) Neil Mitchell 2005-2014, (c) Joey Hess 2019 +License : BSD3 + +Maintainer : id@joeyh.name +Stability : stable +Portability : portable + +A library for 'RawFilePath' manipulations, using Posix or Windows filepaths +depending on the platform. + +Both "System.FilePath.Posix.ByteString" +and "System.FilePath.Windows.ByteString" provide the +same interface. See either for examples and a list of the available +functions. +-} + + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +module System.FilePath.ByteString(module System.FilePath.Windows.ByteString) where +import System.FilePath.Windows.ByteString +#else +module System.FilePath.ByteString(module System.FilePath.Posix.ByteString) where +import System.FilePath.Posix.ByteString +#endif diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/Internal.hs @@ -0,0 +1,1083 @@ +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Safe #-} +#endif +{-# LANGUAGE OverloadedStrings #-} + +-- This template expects CPP definitions for: +-- MODULE_NAME = Posix | Windows +-- IS_WINDOWS = False | True + +-- | +-- Module : System.FilePath.MODULE_NAME.ByteString +-- Copyright : (c) Neil Mitchell 2005-2014, (c) Joey Hess 2019 +-- License : BSD3 +-- +-- Maintainer : id@joeyh.name +-- Stability : stable +-- Portability : portable +-- +-- A library for 'RawFilePath' manipulations, using MODULE_NAME style paths on +-- all platforms. Importing "System.FilePath.ByteString" is usually better. +-- +-- This module is the same as System.FilePath.MODULE_NAME from the filepath +-- library, except it uses 'RawFilePath'. +-- +-- Given the example 'RawFilePath': @\/directory\/file.ext@ +-- +-- We can use the following functions to extract pieces. +-- +-- * 'takeFileName' gives @\"file.ext\"@ +-- +-- * 'takeDirectory' gives @\"\/directory\"@ +-- +-- * 'takeExtension' gives @\".ext\"@ +-- +-- * 'dropExtension' gives @\"\/directory\/file\"@ +-- +-- * 'takeBaseName' gives @\"file\"@ +-- +-- And we could have built an equivalent path with the following expressions: +-- +-- * @\"\/directory\" '' \"file.ext\"@. +-- +-- * @\"\/directory\/file" '<.>' \"ext\"@. +-- +-- * @\"\/directory\/file.txt" '-<.>' \"ext\"@. +-- +-- Each function in this module is documented with several examples, +-- which are also used as tests. +-- +-- Here are a few examples of using the @filepath@ functions together: +-- +-- /Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@: +-- +-- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@ +-- +-- /Example 2:/ Compile a Haskell file, putting the @.hi@ file under @interface@: +-- +-- @'takeDirectory' file '' \"interface\" '' ('takeFileName' file '-<.>' \"hi\")@ +-- +-- References: +-- [1] (Microsoft MSDN) +module System.FilePath.MODULE_NAME.ByteString + ( + -- * Types + RawFilePath, + -- * Separator predicates + pathSeparator, pathSeparators, isPathSeparator, + searchPathSeparator, isSearchPathSeparator, + extSeparator, isExtSeparator, + + -- * @$PATH@ methods + --splitSearchPath, getSearchPath, + + -- * Extension functions + splitExtension, + takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>), + splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf, + stripExtension, + + -- * Filename\/directory functions + splitFileName, + takeFileName, replaceFileName, dropFileName, + takeBaseName, replaceBaseName, + takeDirectory, replaceDirectory, + combine, (), + splitPath, joinPath, splitDirectories, + + -- * Drive functions + splitDrive, joinDrive, + takeDrive, hasDrive, dropDrive, isDrive, + + -- * Trailing slash functions + hasTrailingPathSeparator, + addTrailingPathSeparator, + dropTrailingPathSeparator, + + -- * File name manipulations + --normalise, equalFilePath, + --makeRelative, + isRelative, isAbsolute, + isValid, -- makeValid + ) + where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import Data.Char(ord, chr, toUpper, isAsciiLower, isAsciiUpper) +import Data.Maybe(isJust) +import Data.Word(Word8) + +#ifndef mingw32_HOST_OS +-- Import from unix, rather than redefining, so users who import both +-- will not get an ambiguous occurance of RawFilePath. +import System.Posix.ByteString(RawFilePath) +#else +-- | A literal file path +type RawFilePath = ByteString +#endif + + +infixr 7 <.>, -<.> +infixr 5 + + +--------------------------------------------------------------------- +-- Platform Abstraction Methods (private) + +-- | Is the operating system Unix or Linux like +isPosix :: Bool +isPosix = not isWindows + +-- | Is the operating system Windows like +isWindows :: Bool +isWindows = IS_WINDOWS + + +--------------------------------------------------------------------- +-- The basic functions + +-- | The character that separates directories. In the case where more than +-- one character is possible, 'pathSeparator' is the \'ideal\' one. +-- +-- > Windows: pathSeparator == fromIntegral (ord '\\') +-- > Posix: pathSeparator == fromIntegral (ord '/') +-- > isPathSeparator pathSeparator +pathSeparator :: Word8 +pathSeparator = if isWindows then fromIntegral (ord '\\') else fromIntegral (ord '/') + +-- | The list of all possible separators. +-- +-- > Windows: pathSeparators == [fromIntegral (ord '\\'), fromIntegral (ord '/')] +-- > Posix: pathSeparators == [fromIntegral (ord '/')] +-- > pathSeparator `elem` pathSeparators +pathSeparators :: [Word8] +pathSeparators = if isWindows then [fromIntegral (ord '\\'), fromIntegral (ord '/')] else [fromIntegral (ord '/')] + +-- | Rather than using @(== 'pathSeparator')@, use this. Test if something +-- is a path separator. +-- +-- > isPathSeparator a == (a `elem` pathSeparators) +isPathSeparator :: Word8 -> Bool +isPathSeparator 47 = True +isPathSeparator 92 = isWindows +isPathSeparator _ = False + + +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > Windows: searchPathSeparator == fromIntegral (ord ';') +-- > Posix: searchPathSeparator == fromIntegral (ord ':') +searchPathSeparator :: Word8 +searchPathSeparator = if isWindows then fromIntegral (ord ';') else fromIntegral (ord ':') + +-- | Is the character a file separator? +-- +-- > isSearchPathSeparator a == (a == searchPathSeparator) +isSearchPathSeparator :: Word8 -> Bool +isSearchPathSeparator = (== searchPathSeparator) + + +-- | File extension character +-- +-- > extSeparator == fromIntegral (ord '.') +extSeparator :: Word8 +extSeparator = fromIntegral (ord '.') + +-- | Is the character an extension character? +-- +-- > isExtSeparator a == (a == extSeparator) +isExtSeparator :: Word8 -> Bool +isExtSeparator = (== extSeparator) + +{- + +--------------------------------------------------------------------- +-- Path methods (environment $PATH) + +-- | Take a string, split it on the 'searchPathSeparator' character. +-- Blank items are ignored on Windows, and converted to @.@ on Posix. +-- On Windows path elements are stripped of quotes. +-- +-- Follows the recommendations in +-- +-- +-- > untested Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] +-- > untested Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] +-- > untested Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] +-- > untested Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] +-- > untested Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"] +splitSearchPath :: String -> [FilePath] +splitSearchPath = f + where + f xs = case break isSearchPathSeparator xs of + (pre, [] ) -> g pre + (pre, _:post) -> g pre ++ f post + + g "" = ["." | isPosix] + g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x] + g x = [x] + + +-- | Get a list of 'FilePath's in the $PATH variable. +getSearchPath :: IO [FilePath] +getSearchPath = fmap splitSearchPath (getEnv "PATH") + +-} + +--------------------------------------------------------------------- +-- Extension methods + +-- | Split on the extension. 'addExtension' is the inverse. +-- +-- > splitExtension "/directory/path.ext" == ("/directory/path",".ext") +-- > uncurry (<>) (splitExtension x) == x +-- > Valid x => uncurry addExtension (splitExtension x) == x +-- > splitExtension "file.txt" == ("file",".txt") +-- > splitExtension "file" == ("file","") +-- > splitExtension "file/file.txt" == ("file/file",".txt") +-- > splitExtension "file.txt/boris" == ("file.txt/boris","") +-- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext") +-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") +-- > splitExtension "file/path.txt/" == ("file/path.txt/","") +splitExtension :: RawFilePath -> (ByteString, ByteString) +splitExtension x = if B.null nameDot + then (x,mempty) + else (dir <> B.init nameDot, extSeparator `B.cons` ext) + where + (dir,file) = splitFileName_ x + (nameDot,ext) = B.breakEnd isExtSeparator file + +-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. +-- +-- > takeExtension "/directory/path.ext" == ".ext" +-- > takeExtension x == snd (splitExtension x) +-- > Valid x => takeExtension (addExtension x "ext") == ".ext" +-- > Valid x => takeExtension (replaceExtension x "ext") == ".ext" +takeExtension :: RawFilePath -> ByteString +takeExtension = snd . splitExtension + +-- | Remove the current extension and add another, equivalent to 'replaceExtension'. +-- +-- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext" +-- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext" +-- > "foo.o" -<.> "c" == "foo.c" +(-<.>) :: RawFilePath -> ByteString -> RawFilePath +(-<.>) = replaceExtension + +-- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'. +-- +-- > replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext" +-- > replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext" +-- > replaceExtension "file.txt" ".bob" == "file.bob" +-- > replaceExtension "file.txt" "bob" == "file.bob" +-- > replaceExtension "file" ".bob" == "file.bob" +-- > replaceExtension "file.txt" "" == "file" +-- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt" +-- > replaceExtension x y == addExtension (dropExtension x) y +replaceExtension :: RawFilePath -> ByteString -> RawFilePath +replaceExtension x y = dropExtension x <.> y + +-- | Add an extension, even if there is already one there, equivalent to 'addExtension'. +-- +-- > "/directory/path" <.> "ext" == "/directory/path.ext" +-- > "/directory/path" <.> ".ext" == "/directory/path.ext" +(<.>) :: RawFilePath -> ByteString -> RawFilePath +(<.>) = addExtension + +-- | Remove last extension, and the \".\" preceding it. +-- +-- > dropExtension "/directory/path.ext" == "/directory/path" +-- > dropExtension x == fst (splitExtension x) +dropExtension :: RawFilePath -> RawFilePath +dropExtension = fst . splitExtension + +-- | Add an extension, even if there is already one there, equivalent to '<.>'. +-- +-- > addExtension "/directory/path" "ext" == "/directory/path.ext" +-- > addExtension "file.txt" "bib" == "file.txt.bib" +-- > addExtension "file." ".bib" == "file..bib" +-- > addExtension "file" ".bib" == "file.bib" +-- > addExtension "/" "x" == "/.x" +-- > addExtension x "" == x +-- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext" +-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt" +addExtension :: RawFilePath -> ByteString -> RawFilePath +addExtension file ext = case B.uncons ext of + Nothing -> file + Just (x,_xs) -> joinDrive a $ + if isExtSeparator x then b <> ext + else b <> (extSeparator `B.cons` ext) + where + (a,b) = splitDrive file + +-- | Does the given filename have an extension? +-- +-- > hasExtension "/directory/path.ext" == True +-- > hasExtension "/directory/path" == False +-- > null (takeExtension x) == not (hasExtension x) +hasExtension :: RawFilePath -> Bool +hasExtension = B.any isExtSeparator . takeFileName + + +-- | Does the given filename have the specified extension? +-- +-- > "png" `isExtensionOf` "/directory/file.png" == True +-- > ".png" `isExtensionOf` "/directory/file.png" == True +-- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True +-- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False +-- > "png" `isExtensionOf` "/directory/file.png.jpg" == False +-- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False +isExtensionOf :: ByteString -> RawFilePath -> Bool +isExtensionOf ext = B.isSuffixOf ext' . takeExtensions + where + ext' = case B.uncons ext of + Just (h, _) | isExtSeparator h -> ext + _ -> extSeparator `B.cons` ext + +-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it. +-- Returns 'Nothing' if the FilePath does not have the given extension, or +-- 'Just' and the part before the extension if it does. +-- +-- This function can be more predictable than 'dropExtensions', especially if the filename +-- might itself contain @.@ characters. +-- +-- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x" +-- > stripExtension "hi.o" "foo.x.hs.o" == Nothing +-- > dropExtension x == fromJust (stripExtension (takeExtension x) x) +-- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x) +-- > stripExtension ".c.d" "a.b.c.d" == Just "a.b" +-- > stripExtension ".c.d" "a.b..c.d" == Just "a.b." +-- > stripExtension "baz" "foo.bar" == Nothing +-- > stripExtension "bar" "foobar" == Nothing +-- > stripExtension "" x == Just x +stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath +stripExtension ext path = case B.uncons ext of + Nothing -> Just path + Just (x, _) -> + let dotExt = if isExtSeparator x + then ext + else extSeparator `B.cons` ext + in B.stripSuffix dotExt path + + +-- | Split on all extensions. +-- +-- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext") +-- > splitExtensions "file.tar.gz" == ("file",".tar.gz") +-- > uncurry (<>) (splitExtensions x) == x +-- > Valid x => uncurry addExtension (splitExtensions x) == x +-- > splitExtensions "file.tar.gz" == ("file",".tar.gz") +splitExtensions :: RawFilePath -> (RawFilePath, ByteString) +splitExtensions x = (a <> c, d) + where + (a,b) = splitFileName_ x + (c,d) = B.break isExtSeparator b + +-- | Drop all extensions. +-- +-- > dropExtensions "/directory/path.ext" == "/directory/path" +-- > dropExtensions "file.tar.gz" == "file" +-- > not $ hasExtension $ dropExtensions x +-- > not $ any isExtSeparator $ takeFileName $ dropExtensions x +dropExtensions :: RawFilePath -> RawFilePath +dropExtensions = fst . splitExtensions + +-- | Get all extensions. +-- +-- > takeExtensions "/directory/path.ext" == ".ext" +-- > takeExtensions "file.tar.gz" == ".tar.gz" +takeExtensions :: RawFilePath -> ByteString +takeExtensions = snd . splitExtensions + + +-- | Replace all extensions of a file with a new extension. Note +-- that 'replaceExtension' and 'addExtension' both work for adding +-- multiple extensions, so only required when you need to drop +-- all extensions first. +-- +-- > replaceExtensions "file.fred.bob" "txt" == "file.txt" +-- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz" +replaceExtensions :: RawFilePath -> ByteString -> RawFilePath +replaceExtensions x y = dropExtensions x <.> y + + + +--------------------------------------------------------------------- +-- Drive methods + +-- | Is the given character a valid drive letter? +-- only a-z and A-Z are letters, not isAlpha which is more unicodey +isLetter :: Word8 -> Bool +isLetter x = isAsciiLower c || isAsciiUpper c + where c = chr (fromIntegral x) + +-- | Split a path into a drive and a path. +-- On Posix, \/ is a Drive. +-- +-- > uncurry (<>) (splitDrive x) == x +-- > Windows: splitDrive "file" == ("","file") +-- > Windows: splitDrive "c:/file" == ("c:/","file") +-- > Windows: splitDrive "c:\\file" == ("c:\\","file") +-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test") +-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","") +-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file") +-- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file") +-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file") +-- > Windows: splitDrive "/d" == ("","/d") +-- > Posix: splitDrive "/test" == ("/","test") +-- > Posix: splitDrive "//test" == ("//","test") +-- > Posix: splitDrive "test/file" == ("","test/file") +-- > Posix: splitDrive "file" == ("","file") +splitDrive :: RawFilePath -> (RawFilePath, RawFilePath) +splitDrive x | isPosix = B.span (== fromIntegral (ord '/')) x +splitDrive x | Just y <- readDriveLetter x = y +splitDrive x | Just y <- readDriveUNC x = y +splitDrive x | Just y <- readDriveShare x = y +splitDrive x = (B.empty,x) + +addSlash :: RawFilePath -> RawFilePath -> (RawFilePath, RawFilePath) +addSlash a xs = (a <> c,d) + where (c,d) = B.span isPathSeparator xs + +-- See [1]. +-- "\\?\D:\" or "\\?\UNC\\" +readDriveUNC :: RawFilePath -> Maybe (RawFilePath, RawFilePath) +readDriveUNC p = do + (s1, p') <- B.uncons p + (s2, p'') <- B.uncons p' + (q, p''') <- B.uncons p'' + (s3, rest) <- B.uncons p''' + if q == fromIntegral (ord '?') && all isPathSeparator [s1,s2,s3] + then case breakunc rest of + Just (unc,r) -> + let (a,b) = readDriveShareName r + in Just (B.pack [s1,s2,q,s3] <> unc <> a, b) + Nothing -> case readDriveLetter rest of + -- Extended-length path. + Just (a,b) -> Just (B.pack [s1,s2,q,s3] <> a, b) + Nothing -> Nothing + else Nothing + where + breakunc b = do + (u, b') <- B.uncons b + (n, b'') <- B.uncons b' + (c, b''') <- B.uncons b'' + (s, rest) <- B.uncons b''' + let isup v ch = toUpper (chr (fromIntegral v)) == ch + if isPathSeparator s && isup u 'U' && isup n 'N' && isup c 'C' + then Just (B.take 4 b, rest) + else Nothing + +{- c:\ -} +readDriveLetter :: RawFilePath -> Maybe (RawFilePath, RawFilePath) +readDriveLetter p = case B.uncons p of + Just (x, t) | isLetter x -> case B.uncons t of + Just (c, t') | c == colon -> case B.uncons t' of + Just (y, _) | isPathSeparator y -> + Just $ addSlash (B.pack [x, colon]) t' + _ -> Just (B.pack [x, colon], t') + _ -> Nothing + _ -> Nothing + where colon = fromIntegral (ord ':') + +{- \\sharename\ -} +readDriveShare :: ByteString -> Maybe (RawFilePath, RawFilePath) +readDriveShare p = do + (s1, p') <- B.uncons p + (s2, p'') <- B.uncons p' + let (a,b) = readDriveShareName p'' + if isPathSeparator s1 && isPathSeparator s2 + then Just (s1 `B.cons` s2 `B.cons` a,b) + else Nothing + +{- assume you have already seen \\ -} +{- share\bob -> "share\", "bob" -} +readDriveShareName :: ByteString -> (RawFilePath, RawFilePath) +readDriveShareName name = addSlash a b + where (a,b) = B.break isPathSeparator name + + +-- | Join a drive and the rest of the path. +-- +-- > Valid x => uncurry joinDrive (splitDrive x) == x +-- > Windows: joinDrive "C:" "foo" == "C:foo" +-- > Windows: joinDrive "C:\\" "bar" == "C:\\bar" +-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo" +-- > Windows: joinDrive "/:" "foo" == "/:\\foo" +joinDrive :: RawFilePath -> RawFilePath -> RawFilePath +joinDrive = combineAlways + +-- | Get the drive from a filepath. +-- +-- > takeDrive x == fst (splitDrive x) +takeDrive :: RawFilePath -> RawFilePath +takeDrive = fst . splitDrive + +-- | Delete the drive, if it exists. +-- +-- > dropDrive x == snd (splitDrive x) +dropDrive :: RawFilePath -> RawFilePath +dropDrive = snd . splitDrive + +-- | Does a path have a drive. +-- +-- > not (hasDrive x) == null (takeDrive x) +-- > Posix: hasDrive "/foo" == True +-- > Windows: hasDrive "C:\\foo" == True +-- > Windows: hasDrive "C:foo" == True +-- > hasDrive "foo" == False +-- > hasDrive "" == False +hasDrive :: RawFilePath -> Bool +hasDrive = not . B.null . takeDrive + +-- | Is an element a drive +-- +-- > Posix: isDrive "/" == True +-- > Posix: isDrive "/foo" == False +-- > Windows: isDrive "C:\\" == True +-- > Windows: isDrive "C:\\foo" == False +-- > isDrive "" == False +isDrive :: RawFilePath -> Bool +isDrive x = not (B.null x) && B.null (dropDrive x) + +--------------------------------------------------------------------- +-- Operations on a filepath, as a list of directories + +-- | Split a filename into directory and file. '' is the inverse. +-- The first component will often end with a trailing slash. +-- +-- > splitFileName "/directory/file.ext" == ("/directory/","file.ext") +-- > Valid x => uncurry () (splitFileName x) == x || fst (splitFileName x) == "./" +-- > Valid x => isValid (fst (splitFileName x)) +-- > splitFileName "file/bob.txt" == ("file/", "bob.txt") +-- > splitFileName "file/" == ("file/", "") +-- > splitFileName "bob" == ("./", "bob") +-- > Posix: splitFileName "/" == ("/","") +-- > Windows: splitFileName "c:" == ("c:","") +splitFileName :: RawFilePath -> (ByteString, ByteString) +splitFileName x = (if B.null dir then "./" else dir, name) + where + (dir, name) = splitFileName_ x + +-- version of splitFileName where, if the FilePath has no directory +-- component, the returned directory is "" rather than "./". This +-- is used in cases where we are going to combine the returned +-- directory to make a valid FilePath, and having a "./" appear would +-- look strange and upset simple equality properties. See +-- e.g. replaceFileName. +splitFileName_ :: RawFilePath -> (ByteString, ByteString) +splitFileName_ x = (drv <> dir, file) + where + (drv,pth) = splitDrive x + (dir,file) = B.breakEnd isPathSeparator pth + +-- | Set the filename. +-- +-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" +-- > Valid x => replaceFileName x (takeFileName x) == x +replaceFileName :: RawFilePath -> ByteString -> RawFilePath +replaceFileName x y = a y where (a,_) = splitFileName_ x + +-- | Drop the filename. Unlike 'takeDirectory', this function will leave +-- a trailing path separator on the directory. +-- +-- > dropFileName "/directory/file.ext" == "/directory/" +-- > dropFileName x == fst (splitFileName x) +dropFileName :: RawFilePath -> RawFilePath +dropFileName = fst . splitFileName + +-- | Get the file name. +-- +-- > takeFileName "/directory/file.ext" == "file.ext" +-- > takeFileName "test/" == "" +-- > takeFileName x `isSuffixOf` x +-- > takeFileName x == snd (splitFileName x) +-- > Valid x => takeFileName (replaceFileName x "fred") == "fred" +-- > Valid x => takeFileName (x "fred") == "fred" +-- > Valid x => isRelative (takeFileName x) +takeFileName :: RawFilePath -> RawFilePath +takeFileName = snd . splitFileName + +-- | Get the base name, without an extension or path. +-- +-- > takeBaseName "/directory/file.ext" == "file" +-- > takeBaseName "file/test.txt" == "test" +-- > takeBaseName "dave.ext" == "dave" +-- > takeBaseName "" == "" +-- > takeBaseName "test" == "test" +-- > takeBaseName (addTrailingPathSeparator x) == "" +-- > takeBaseName "file/file.tar.gz" == "file.tar" +takeBaseName :: RawFilePath -> ByteString +takeBaseName = dropExtension . takeFileName + +-- | Set the base name. +-- +-- > replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext" +-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt" +-- > replaceBaseName "fred" "bill" == "bill" +-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar" +-- > Valid x => replaceBaseName x (takeBaseName x) == x +replaceBaseName :: RawFilePath -> ByteString -> RawFilePath +replaceBaseName pth nam = combineAlways a (nam <.> ext) + where + (a,b) = splitFileName_ pth + ext = takeExtension b + +-- | Is an item either a directory or the last character a path separator? +-- +-- > hasTrailingPathSeparator "test" == False +-- > hasTrailingPathSeparator "test/" == True +hasTrailingPathSeparator :: RawFilePath -> Bool +hasTrailingPathSeparator x = case B.unsnoc x of + Nothing -> False + Just (_i, l) -> isPathSeparator l + + +hasLeadingPathSeparator :: RawFilePath -> Bool +hasLeadingPathSeparator x = case B.uncons x of + Nothing -> False + Just (h,_t) -> isPathSeparator h + +-- | Add a trailing file path separator if one is not already present. +-- +-- > hasTrailingPathSeparator (addTrailingPathSeparator x) +-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x +-- > Posix: addTrailingPathSeparator "test/rest" == "test/rest/" +addTrailingPathSeparator :: RawFilePath -> RawFilePath +addTrailingPathSeparator x + | hasTrailingPathSeparator x = x + | otherwise = B.snoc x pathSeparator + + +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > dropTrailingPathSeparator "/" == "/" +-- > Windows: dropTrailingPathSeparator "\\" == "\\" +-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x +dropTrailingPathSeparator :: RawFilePath -> RawFilePath +dropTrailingPathSeparator x = + if hasTrailingPathSeparator x && not (isDrive x) + then let x' = dropWhileEnd isPathSeparator x + in if B.null x' then B.singleton (B.last x) else x' + else x + + +-- | Get the directory name, move up one level. +-- +-- > takeDirectory "/directory/other.ext" == "/directory" +-- > takeDirectory x `isPrefixOf` x || takeDirectory x == "." +-- > takeDirectory "foo" == "." +-- > takeDirectory "/" == "/" +-- > takeDirectory "/foo" == "/" +-- > takeDirectory "/foo/bar/baz" == "/foo/bar" +-- > takeDirectory "/foo/bar/baz/" == "/foo/bar/baz" +-- > takeDirectory "foo/bar/baz" == "foo/bar" +-- > Windows: takeDirectory "foo\\bar" == "foo" +-- > Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar" +-- > Windows: takeDirectory "C:\\" == "C:\\" +takeDirectory :: RawFilePath -> RawFilePath +takeDirectory = dropTrailingPathSeparator . dropFileName + +-- | Set the directory, keeping the filename the same. +-- +-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" +-- > untested Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x +replaceDirectory :: RawFilePath -> ByteString -> RawFilePath +replaceDirectory x dir = combineAlways dir (takeFileName x) + +-- | An alias for ''. +combine :: RawFilePath -> RawFilePath -> RawFilePath +combine a b | hasLeadingPathSeparator b || hasDrive b = b + | otherwise = combineAlways a b + +-- | Combine two paths, assuming rhs is NOT absolute. +combineAlways :: RawFilePath -> RawFilePath -> RawFilePath +combineAlways a b | B.null a = b + | B.null b = a + | hasTrailingPathSeparator a = a <> b + | isWindows && B.length a == 2 + && B.last a == fromIntegral (ord ':') + && isLetter (B.head a) = a <> b + | otherwise = a <> B.singleton pathSeparator <> b + +-- | Combine two paths with a path separator. +-- If the second path starts with a path separator or a drive letter, then it returns the second. +-- The intention is that @readFile (dir '' file)@ will access the same file as +-- @setCurrentDirectory dir; readFile file@. +-- +-- > Posix: "/directory" "file.ext" == "/directory/file.ext" +-- > Windows: "/directory" "file.ext" == "/directory\\file.ext" +-- > "directory" "/file.ext" == "/file.ext" +-- > untested Valid x => (takeDirectory x takeFileName x) `equalFilePath` x +-- +-- Combined: +-- +-- > Posix: "/" "test" == "/test" +-- > Posix: "home" "bob" == "home/bob" +-- > Posix: "x:" "foo" == "x:/foo" +-- > Windows: "C:\\foo" "bar" == "C:\\foo\\bar" +-- > Windows: "home" "bob" == "home\\bob" +-- +-- Not combined: +-- +-- > Posix: "home" "/bob" == "/bob" +-- > Windows: "home" "C:\\bob" == "C:\\bob" +-- +-- Not combined (tricky): +-- +-- On Windows, if a filepath starts with a single slash, it is relative to the +-- root of the current drive. In [1], this is (confusingly) referred to as an +-- absolute path. +-- The current behavior of '' is to never combine these forms. +-- +-- > Windows: "home" "/bob" == "/bob" +-- > Windows: "home" "\\bob" == "\\bob" +-- > Windows: "C:\\home" "\\bob" == "\\bob" +-- +-- On Windows, from [1]: "If a file name begins with only a disk designator +-- but not the backslash after the colon, it is interpreted as a relative path +-- to the current directory on the drive with the specified letter." +-- The current behavior of '' is to never combine these forms. +-- +-- > Windows: "D:\\foo" "C:bar" == "C:bar" +-- > Windows: "C:\\foo" "C:bar" == "C:bar" +() :: RawFilePath -> RawFilePath -> RawFilePath +() = combine + +-- | Split a path by the directory separator. +-- +-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] +-- > mconcat (splitPath x) == x +-- > splitPath "test//item/" == ["test//","item/"] +-- > splitPath "test/item/file" == ["test/","item/","file"] +-- > splitPath "" == [] +-- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"] +-- > Posix: splitPath "/file/test" == ["/","file/","test"] +splitPath :: RawFilePath -> [RawFilePath] +splitPath x = [drive | not (B.null drive)] ++ f path + where + (drive,path) = splitDrive x + + f y + | B.null y = [] + | otherwise = (a<>c) : f d + where + (a,b) = B.break isPathSeparator y + (c,d) = B.span isPathSeparator b + +-- | Just as 'splitPath', but don't add the trailing slashes to each element. +-- +-- > splitDirectories "/directory/file.ext" == ["/","directory","file.ext"] +-- > splitDirectories "test/file" == ["test","file"] +-- > splitDirectories "/test/file" == ["/","test","file"] +-- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"] +-- > untested Valid x => joinPath (splitDirectories x) `equalFilePath` x +-- > splitDirectories "" == [] +-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] +-- > splitDirectories "/test///file" == ["/","test","file"] +splitDirectories :: RawFilePath -> [RawFilePath] +splitDirectories = map dropTrailingPathSeparator . splitPath + + +-- | Join path elements back together. +-- +-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" +-- > Valid x => joinPath (splitPath x) == x +-- > joinPath [] == "" +-- > Posix: joinPath ["test","file","path"] == "test/file/path" +joinPath :: [RawFilePath] -> RawFilePath +-- Note that this definition on c:\\c:\\, join then split will give c:\\. +joinPath = foldr combine mempty + +{- + + +--------------------------------------------------------------------- +-- File name manipulators + +-- | Equality of two 'FilePath's. +-- If you call @System.Directory.canonicalizePath@ +-- first this has a much better chance of working. +-- Note that this doesn't follow symlinks or DOSNAM~1s. +-- +-- > untested x == y ==> equalFilePath x y +-- > untested normalise x == normalise y ==> equalFilePath x y +-- > untested equalFilePath "foo" "foo/" +-- > untested not (equalFilePath "foo" "/foo") +-- > untested Posix: not (equalFilePath "foo" "FOO") +-- > untested Windows: equalFilePath "foo" "FOO" +-- > untested Windows: not (equalFilePath "C:" "C:/") +equalFilePath :: FilePath -> FilePath -> Bool +equalFilePath a b = f a == f b + where + f x | isWindows = dropTrailingPathSeparator $ 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 +-- . +-- +-- The corresponding @makeAbsolute@ function can be found in +-- @System.Directory@. +-- +-- > untested makeRelative "/directory" "/directory/file.ext" == "file.ext" +-- > untested Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x +-- > untested makeRelative x x == "." +-- > untested Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +-- > untested Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" +-- > untested Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" +-- > untested Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" +-- > untested Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" +-- > untested Windows: makeRelative "/Home" "/home/bob" == "bob" +-- > untested Windows: makeRelative "/" "//" == "//" +-- > untested Posix: makeRelative "/Home" "/home/bob" == "/home/bob" +-- > untested Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" +-- > untested Posix: makeRelative "/fred" "bob" == "bob" +-- > untested Posix: makeRelative "/file/test" "/file/test/fred" == "fred" +-- > untested Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" +-- > untested Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c" +makeRelative :: FilePath -> FilePath -> FilePath +makeRelative root path + | equalFilePath root path = "." + | takeAbs root /= takeAbs path = path + | otherwise = f (dropAbs root) (dropAbs path) + where + f "" y = dropWhile isPathSeparator y + f x y = let (x1,x2) = g x + (y1,y2) = g y + in if equalFilePath x1 y1 then f x2 y2 else path + + g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b) + where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x + + -- on windows, need to drop '/' which is kind of absolute, but not a drive + dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x + dropAbs x = dropDrive x + + 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 +-- +-- * \/ -> 'pathSeparator' +-- +-- * .\/ -> \"\" +-- +-- > 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] + where + (drv,pth) = splitDrive path + result = joinDrive' (normaliseDrive drv) (f pth) + + joinDrive' "" "" = "." + joinDrive' d p = joinDrive d p + + addPathSeparator = isDirPath pth + && not (hasTrailingPathSeparator result) + && not (isRelativeDrive drv) + + isDirPath xs = hasTrailingPathSeparator xs + || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs) + + f = joinPath . dropDots . propSep . splitDirectories + + propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs + | otherwise = x : xs + propSep [] = [] + + dropDots = filter ("." /=) + +normaliseDrive :: FilePath -> FilePath +normaliseDrive "" = "" +normaliseDrive _ | isPosix = [pathSeparator] +normaliseDrive drive = if isJust $ readDriveLetter x2 + then map toUpper x2 + else x2 + where + x2 = map repSlash drive + + repSlash x = if isPathSeparator x then pathSeparator else x + +-} + +-- Information for validity functions on Windows. See [1]. +isBadCharacter :: Word8 -> Bool +isBadCharacter x = x >= 0 && x <= 31 || x `elem` l + where + l = map (fromIntegral . ord) ":*?><|\"" + +badElements :: [FilePath] +badElements = + ["CON","PRN","AUX","NUL","CLOCK$" + ,"COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9" + ,"LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"] + +-- | Is a RawFilePath valid, i.e. could you create a file like it? This function checks for invalid names, +-- and invalid characters, but does not check if length limits are exceeded, as these are typically +-- filesystem dependent. +-- +-- > isValid "" == False +-- > isValid "\0" == False +-- > Posix: isValid "/random_ path:*" == True +-- > Posix: isValid x == (x /= mempty) +-- > Windows: isValid "c:\\test" == True +-- > Windows: isValid "c:\\test:of_test" == False +-- > Windows: isValid "test*" == False +-- > Windows: isValid "c:\\test\\nul" == False +-- > Windows: isValid "c:\\test\\prn.txt" == False +-- > Windows: isValid "c:\\nul\\file" == False +-- > Windows: isValid "\\\\" == False +-- > Windows: isValid "\\\\\\foo" == False +-- > Windows: isValid "\\\\?\\D:file" == False +-- > Windows: isValid "foo\tbar" == False +-- > Windows: isValid "nul .txt" == False +-- > Windows: isValid " nul.txt" == True +isValid :: RawFilePath -> Bool +isValid path + | B.null path = False + | B.elem 0 path = False + | isPosix = True + | otherwise = + not (B.any isBadCharacter x2) && + not (any f $ splitDirectories x2) && + not (isJust (readDriveShare x1) && B.all isPathSeparator x1) && + not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) + where + (x1,x2) = splitDrive path + f x = map toUpper (B8.unpack $ dropWhileEnd (== 32) $ dropExtensions x) `elem` badElements + +{- + +-- | Take a FilePath and make it valid; does not change already valid FilePaths. +-- +-- > untested isValid (makeValid x) +-- > untested isValid x ==> makeValid x == x +-- > untested makeValid "" == "_" +-- > untested makeValid "file\0name" == "file_name" +-- > untested Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" +-- > untested Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" +-- > untested Windows: makeValid "test*" == "test_" +-- > untested Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" +-- > untested Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" +-- > untested Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" +-- > untested Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" +-- > untested Windows: makeValid "\\\\\\foo" == "\\\\drive" +-- > untested Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" +-- > untested Windows: makeValid "nul .txt" == "nul _.txt" +makeValid :: FilePath -> FilePath +makeValid "" = "_" +makeValid path + | isPosix = map (\x -> if x == '\0' then '_' else x) path + | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive" + | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) = + makeValid (drv ++ [pathSeparator] ++ pth) + | otherwise = joinDrive drv $ validElements $ validChars pth + where + (drv,pth) = splitDrive path + + validChars = map f + f x = if isBadCharacter x then '_' else x + + validElements x = joinPath $ map g $ splitPath x + g x = h a ++ b + where (a,b) = break isPathSeparator x + h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x + where (a,b) = splitExtensions x + +-} + +-- | Is a path relative, or is it fixed to the root? +-- +-- > Windows: isRelative "path\\test" == True +-- > Windows: isRelative "c:\\test" == False +-- > Windows: isRelative "c:test" == True +-- > Windows: isRelative "c:\\" == False +-- > Windows: isRelative "c:/" == False +-- > Windows: isRelative "c:" == True +-- > Windows: isRelative "\\\\foo" == False +-- > Windows: isRelative "\\\\?\\foo" == False +-- > Windows: isRelative "\\\\?\\UNC\\foo" == False +-- > Windows: isRelative "/foo" == True +-- > Windows: isRelative "\\foo" == True +-- > Posix: isRelative "test/path" == True +-- > Posix: isRelative "/test" == False +-- > Posix: isRelative "/" == False +-- +-- According to [1]: +-- +-- * "A UNC name of any format [is never relative]." +-- +-- * "You cannot use the "\\?\" prefix with a relative path." +isRelative :: RawFilePath -> Bool +isRelative x = B.null drive || isRelativeDrive drive + where drive = takeDrive x + + +{- c:foo -} +-- From [1]: "If a file name begins with only a disk designator but not the +-- backslash after the colon, it is interpreted as a relative path to the +-- current directory on the drive with the specified letter." +isRelativeDrive :: RawFilePath -> Bool +isRelativeDrive x = + maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x) + +-- | @not . 'isRelative'@ +-- +-- > isAbsolute x == not (isRelative x) +isAbsolute :: RawFilePath -> Bool +isAbsolute = not . isRelative + +----------------------------------------------------------------------------- +-- dropWhileEnd (/= 32) "foo bar" == "foo ") +dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString +dropWhileEnd p = fst . B.spanEnd p + +{- + +-- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4]) +takeWhileEnd :: (a -> Bool) -> [a] -> [a] +takeWhileEnd p = reverse . takeWhile p . reverse + +-- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4]) +spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) +spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs) + +-- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4]) +breakEnd :: (a -> Bool) -> [a] -> ([a], [a]) +breakEnd p = spanEnd (not . p) + +-- | The stripSuffix function drops the given suffix from a list. It returns +-- Nothing if the list did not end with the suffix given, or Just the list +-- before the suffix, if it does. +stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] +stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys) + +-} diff --git a/System/FilePath/Posix/ByteString.hs b/System/FilePath/Posix/ByteString.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/Posix/ByteString.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE CPP #-} +#define MODULE_NAME Posix +#define IS_WINDOWS False +#include "../Internal.hs" diff --git a/System/FilePath/Windows/ByteString.hs b/System/FilePath/Windows/ByteString.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/Windows/ByteString.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE CPP #-} +#define MODULE_NAME Windows +#define IS_WINDOWS True +#include "../Internal.hs" diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,11 @@ +* 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 new file mode 100644 --- /dev/null +++ b/filepath-bytestring.cabal @@ -0,0 +1,75 @@ +cabal-version: >= 1.18 +name: filepath-bytestring +version: 1.4.2.1.0 +-- NOTE: Don't forget to update CHANGELOG and the filepath version below +license: BSD3 +license-file: LICENSE +author: Neil Mitchell +maintainer: Joey Hess +copyright: Neil Mitchell 2005-2019 + Joey Hess 2019 +category: System +build-type: Simple +synopsis: Library for manipulating RawFilePaths in a cross platform way. +description: + This package provides functionality for manipulating @RawFilePath@ + values. It can be used as a drop in replacement for the filepath library + to get the benefits of using ByteStrings. It provides three modules: + . + * "System.FilePath.Posix.ByteString" manipulates POSIX\/Linux style @RawFilePath@ values (with @\/@ as the path separator). + . + * "System.FilePath.Windows.ByteString" manipulates Windows style @RawFilePath@ values (with either @\\@ or @\/@ as the path separator, and deals with drives). + . + * "System.FilePath.ByteString" is an alias for the module appropriate to your platform. + . + All three modules provide the same API, and the same documentation (calling out differences in the different variants). + +extra-source-files: + System/FilePath/Internal.hs +extra-doc-files: + README.md + CHANGELOG + TODO + +source-repository head + type: git + location: git://git.joeyh.name/haskell-filepath-bytestring.git + +library + default-language: Haskell2010 + other-extensions: + CPP + PatternGuards + if impl(GHC >= 7.2) + other-extensions: Safe + + exposed-modules: + System.FilePath.ByteString + System.FilePath.Posix.ByteString + System.FilePath.Windows.ByteString + + build-depends: + base >= 4 && < 4.15, + bytestring + if !os(Windows) + build-depends: unix + + ghc-options: -Wall + +test-suite filepath-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Test.hs + ghc-options: -main-is Test + hs-source-dirs: tests + other-modules: + TestEquiv + TestGen + TestUtil + build-depends: + filepath-bytestring, + base, + bytestring, + QuickCheck >= 2.7 && < 2.14, + -- filepath same version as this library, to test equivilance + filepath == 1.4.2.1 diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,32 @@ + +module Test(main) where + +import System.Environment +import TestGen +import TestEquiv +import Control.Monad +import Data.Maybe +import Test.QuickCheck + + +main :: IO () +main = do + args <- getArgs + let count = case args of i:_ -> read i; _ -> 10000 + putStrLn $ "Testing with " ++ show count ++ " repetitions" + let alltests = equivtests ++ tests + let total = length alltests + let showOutput x = show x{output=""} ++ "\n" ++ output x + bad <- fmap catMaybes $ forM (zip [1..] alltests) $ \(i,(msg,prop)) -> do + putStrLn $ "Test " ++ show i ++ " of " ++ show total ++ ": " ++ msg + res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop + case res of + Success{} -> return Nothing + bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; return $ Just (msg,bad) + if null bad then + putStrLn $ "Success, " ++ show total ++ " tests passed" + else do + putStrLn $ show (length bad) ++ " FAILURES\n" + forM_ (zip [1..] bad) $ \(i,(a,b)) -> + putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n" + fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total ++ " tests" diff --git a/tests/TestEquiv.hs b/tests/TestEquiv.hs new file mode 100644 --- /dev/null +++ b/tests/TestEquiv.hs @@ -0,0 +1,83 @@ +-- GENERATED CODE: See ../Generate.hs +module TestEquiv(equivtests) where +import TestUtil +import System.FilePath.ByteString (RawFilePath) +import qualified System.FilePath.Windows.ByteString as OurWindows +import qualified System.FilePath.Windows as TheirWindows +import qualified System.FilePath.Posix.ByteString as OurPosix +import qualified System.FilePath.Posix as TheirPosix +equivtests :: [(String, Property)] +equivtests = + [("equiv Posix.isPathSeparator", equiv_0 OurPosix.isPathSeparator TheirPosix.isPathSeparator) + ,("equiv Posix.isSearchPathSeparator", equiv_0 OurPosix.isSearchPathSeparator TheirPosix.isSearchPathSeparator) + ,("equiv Posix.isExtSeparator", equiv_0 OurPosix.isExtSeparator TheirPosix.isExtSeparator) + ,("equiv Posix.splitExtension", equiv_1 OurPosix.splitExtension TheirPosix.splitExtension) + ,("equiv Posix.takeExtension", equiv_1 OurPosix.takeExtension TheirPosix.takeExtension) + ,("equiv Posix.replaceExtension", equiv_2 OurPosix.replaceExtension TheirPosix.replaceExtension) + ,("equiv Posix.dropExtension", equiv_1 OurPosix.dropExtension TheirPosix.dropExtension) + ,("equiv Posix.addExtension", equiv_2 OurPosix.addExtension TheirPosix.addExtension) + ,("equiv Posix.hasExtension", equiv_1 OurPosix.hasExtension TheirPosix.hasExtension) + ,("equiv Posix.splitExtensions", equiv_1 OurPosix.splitExtensions TheirPosix.splitExtensions) + ,("equiv Posix.dropExtensions", equiv_1 OurPosix.dropExtensions TheirPosix.dropExtensions) + ,("equiv Posix.takeExtensions", equiv_1 OurPosix.takeExtensions TheirPosix.takeExtensions) + ,("equiv Posix.replaceExtensions", equiv_2 OurPosix.replaceExtensions TheirPosix.replaceExtensions) + ,("equiv Posix.isExtensionOf", equiv_2 OurPosix.isExtensionOf TheirPosix.isExtensionOf) + ,("equiv Posix.stripExtension", equiv_2 OurPosix.stripExtension TheirPosix.stripExtension) + ,("equiv Posix.splitFileName", equiv_1 OurPosix.splitFileName TheirPosix.splitFileName) + ,("equiv Posix.takeFileName", equiv_1 OurPosix.takeFileName TheirPosix.takeFileName) + ,("equiv Posix.replaceFileName", equiv_2 OurPosix.replaceFileName TheirPosix.replaceFileName) + ,("equiv Posix.dropFileName", equiv_1 OurPosix.dropFileName TheirPosix.dropFileName) + ,("equiv Posix.takeBaseName", equiv_1 OurPosix.takeBaseName TheirPosix.takeBaseName) + ,("equiv Posix.replaceBaseName", equiv_2 OurPosix.replaceBaseName TheirPosix.replaceBaseName) + ,("equiv Posix.takeDirectory", equiv_1 OurPosix.takeDirectory TheirPosix.takeDirectory) + ,("equiv Posix.replaceDirectory", equiv_2 OurPosix.replaceDirectory TheirPosix.replaceDirectory) + ,("equiv Posix.combine", equiv_2 OurPosix.combine TheirPosix.combine) + ,("equiv Posix.splitPath", equiv_1 OurPosix.splitPath TheirPosix.splitPath) + ,("equiv Posix.joinPath", equiv_3 OurPosix.joinPath TheirPosix.joinPath) + ,("equiv Posix.splitDirectories", equiv_1 OurPosix.splitDirectories TheirPosix.splitDirectories) + ,("equiv Posix.splitDrive", equiv_1 OurPosix.splitDrive TheirPosix.splitDrive) + ,("equiv Posix.joinDrive", equiv_2 OurPosix.joinDrive TheirPosix.joinDrive) + ,("equiv Posix.takeDrive", equiv_1 OurPosix.takeDrive TheirPosix.takeDrive) + ,("equiv Posix.hasDrive", equiv_1 OurPosix.hasDrive TheirPosix.hasDrive) + ,("equiv Posix.dropDrive", equiv_1 OurPosix.dropDrive TheirPosix.dropDrive) + ,("equiv Posix.isDrive", equiv_1 OurPosix.isDrive TheirPosix.isDrive) + ,("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 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) + ,("equiv Windows.splitExtension", equiv_1 OurWindows.splitExtension TheirWindows.splitExtension) + ,("equiv Windows.takeExtension", equiv_1 OurWindows.takeExtension TheirWindows.takeExtension) + ,("equiv Windows.replaceExtension", equiv_2 OurWindows.replaceExtension TheirWindows.replaceExtension) + ,("equiv Windows.dropExtension", equiv_1 OurWindows.dropExtension TheirWindows.dropExtension) + ,("equiv Windows.addExtension", equiv_2 OurWindows.addExtension TheirWindows.addExtension) + ,("equiv Windows.hasExtension", equiv_1 OurWindows.hasExtension TheirWindows.hasExtension) + ,("equiv Windows.splitExtensions", equiv_1 OurWindows.splitExtensions TheirWindows.splitExtensions) + ,("equiv Windows.dropExtensions", equiv_1 OurWindows.dropExtensions TheirWindows.dropExtensions) + ,("equiv Windows.takeExtensions", equiv_1 OurWindows.takeExtensions TheirWindows.takeExtensions) + ,("equiv Windows.replaceExtensions", equiv_2 OurWindows.replaceExtensions TheirWindows.replaceExtensions) + ,("equiv Windows.isExtensionOf", equiv_2 OurWindows.isExtensionOf TheirWindows.isExtensionOf) + ,("equiv Windows.stripExtension", equiv_2 OurWindows.stripExtension TheirWindows.stripExtension) + ,("equiv Windows.splitFileName", equiv_1 OurWindows.splitFileName TheirWindows.splitFileName) + ,("equiv Windows.takeFileName", equiv_1 OurWindows.takeFileName TheirWindows.takeFileName) + ,("equiv Windows.replaceFileName", equiv_2 OurWindows.replaceFileName TheirWindows.replaceFileName) + ,("equiv Windows.dropFileName", equiv_1 OurWindows.dropFileName TheirWindows.dropFileName) + ,("equiv Windows.takeBaseName", equiv_1 OurWindows.takeBaseName TheirWindows.takeBaseName) + ,("equiv Windows.replaceBaseName", equiv_2 OurWindows.replaceBaseName TheirWindows.replaceBaseName) + ,("equiv Windows.takeDirectory", equiv_1 OurWindows.takeDirectory TheirWindows.takeDirectory) + ,("equiv Windows.replaceDirectory", equiv_2 OurWindows.replaceDirectory TheirWindows.replaceDirectory) + ,("equiv Windows.combine", equiv_2 OurWindows.combine TheirWindows.combine) + ,("equiv Windows.splitPath", equiv_1 OurWindows.splitPath TheirWindows.splitPath) + ,("equiv Windows.joinPath", equiv_3 OurWindows.joinPath TheirWindows.joinPath) + ,("equiv Windows.splitDirectories", equiv_1 OurWindows.splitDirectories TheirWindows.splitDirectories) + ,("equiv Windows.splitDrive", equiv_1 OurWindows.splitDrive TheirWindows.splitDrive) + ,("equiv Windows.joinDrive", equiv_2 OurWindows.joinDrive TheirWindows.joinDrive) + ,("equiv Windows.takeDrive", equiv_1 OurWindows.takeDrive TheirWindows.takeDrive) + ,("equiv Windows.hasDrive", equiv_1 OurWindows.hasDrive TheirWindows.hasDrive) + ,("equiv Windows.dropDrive", equiv_1 OurWindows.dropDrive TheirWindows.dropDrive) + ,("equiv Windows.isDrive", equiv_1 OurWindows.isDrive TheirWindows.isDrive) + ,("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) + ] diff --git a/tests/TestGen.hs b/tests/TestGen.hs new file mode 100644 --- /dev/null +++ b/tests/TestGen.hs @@ -0,0 +1,382 @@ +-- GENERATED CODE: See ../Generate.hs +{-# LANGUAGE OverloadedStrings #-} +module TestGen(tests) where +import TestUtil +import Data.Char +import qualified System.FilePath.Windows.ByteString as W +import qualified System.FilePath.Posix.ByteString as P +import Data.ByteString (isPrefixOf, isSuffixOf, null, any) +import Prelude hiding (isPrefixOf, isSuffixOf, null, any) +tests :: [(String, Property)] +tests = + [("W.pathSeparator == fromIntegral (ord '\\\\')", property $ W.pathSeparator == fromIntegral (ord '\\')) + ,("P.pathSeparator == fromIntegral (ord '/')", property $ P.pathSeparator == fromIntegral (ord '/')) + ,("P.isPathSeparator P.pathSeparator", property $ P.isPathSeparator P.pathSeparator) + ,("W.isPathSeparator W.pathSeparator", property $ W.isPathSeparator W.pathSeparator) + ,("W.pathSeparators == [fromIntegral (ord '\\\\'), fromIntegral (ord '/')]", property $ W.pathSeparators == [fromIntegral (ord '\\'), fromIntegral (ord '/')]) + ,("P.pathSeparators == [fromIntegral (ord '/')]", property $ P.pathSeparators == [fromIntegral (ord '/')]) + ,("P.pathSeparator `elem` P.pathSeparators", property $ P.pathSeparator `elem` P.pathSeparators) + ,("W.pathSeparator `elem` W.pathSeparators", property $ W.pathSeparator `elem` W.pathSeparators) + ,("P.isPathSeparator a == (a `elem` P.pathSeparators)", property $ \a -> P.isPathSeparator a == (a `elem` P.pathSeparators)) + ,("W.isPathSeparator a == (a `elem` W.pathSeparators)", property $ \a -> W.isPathSeparator a == (a `elem` W.pathSeparators)) + ,("W.searchPathSeparator == fromIntegral (ord ';')", property $ W.searchPathSeparator == fromIntegral (ord ';')) + ,("P.searchPathSeparator == fromIntegral (ord ':')", property $ P.searchPathSeparator == fromIntegral (ord ':')) + ,("P.isSearchPathSeparator a == (a == P.searchPathSeparator)", property $ \a -> P.isSearchPathSeparator a == (a == P.searchPathSeparator)) + ,("W.isSearchPathSeparator a == (a == W.searchPathSeparator)", property $ \a -> W.isSearchPathSeparator a == (a == W.searchPathSeparator)) + ,("P.extSeparator == fromIntegral (ord '.')", property $ P.extSeparator == fromIntegral (ord '.')) + ,("W.extSeparator == fromIntegral (ord '.')", property $ W.extSeparator == fromIntegral (ord '.')) + ,("P.isExtSeparator a == (a == P.extSeparator)", property $ \a -> P.isExtSeparator a == (a == P.extSeparator)) + ,("W.isExtSeparator a == (a == W.extSeparator)", property $ \a -> W.isExtSeparator a == (a == W.extSeparator)) + ,("P.splitExtension \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ P.splitExtension "/directory/path.ext" == ("/directory/path", ".ext")) + ,("W.splitExtension \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ W.splitExtension "/directory/path.ext" == ("/directory/path", ".ext")) + ,("uncurry (<>) (P.splitExtension x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in uncurry (<>) (P.splitExtension x) == x) + ,("uncurry (<>) (W.splitExtension x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in uncurry (<>) (W.splitExtension x) == x) + ,("uncurry P.addExtension (P.splitExtension x) == x", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in uncurry P.addExtension (P.splitExtension x) == x) + ,("uncurry W.addExtension (W.splitExtension x) == x", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in uncurry W.addExtension (W.splitExtension x) == x) + ,("P.splitExtension \"file.txt\" == (\"file\", \".txt\")", property $ P.splitExtension "file.txt" == ("file", ".txt")) + ,("W.splitExtension \"file.txt\" == (\"file\", \".txt\")", property $ W.splitExtension "file.txt" == ("file", ".txt")) + ,("P.splitExtension \"file\" == (\"file\", \"\")", property $ P.splitExtension "file" == ("file", "")) + ,("W.splitExtension \"file\" == (\"file\", \"\")", property $ W.splitExtension "file" == ("file", "")) + ,("P.splitExtension \"file/file.txt\" == (\"file/file\", \".txt\")", property $ P.splitExtension "file/file.txt" == ("file/file", ".txt")) + ,("W.splitExtension \"file/file.txt\" == (\"file/file\", \".txt\")", property $ W.splitExtension "file/file.txt" == ("file/file", ".txt")) + ,("P.splitExtension \"file.txt/boris\" == (\"file.txt/boris\", \"\")", property $ P.splitExtension "file.txt/boris" == ("file.txt/boris", "")) + ,("W.splitExtension \"file.txt/boris\" == (\"file.txt/boris\", \"\")", property $ W.splitExtension "file.txt/boris" == ("file.txt/boris", "")) + ,("P.splitExtension \"file.txt/boris.ext\" == (\"file.txt/boris\", \".ext\")", property $ P.splitExtension "file.txt/boris.ext" == ("file.txt/boris", ".ext")) + ,("W.splitExtension \"file.txt/boris.ext\" == (\"file.txt/boris\", \".ext\")", property $ W.splitExtension "file.txt/boris.ext" == ("file.txt/boris", ".ext")) + ,("P.splitExtension \"file/path.txt.bob.fred\" == (\"file/path.txt.bob\", \".fred\")", property $ P.splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob", ".fred")) + ,("W.splitExtension \"file/path.txt.bob.fred\" == (\"file/path.txt.bob\", \".fred\")", property $ W.splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob", ".fred")) + ,("P.splitExtension \"file/path.txt/\" == (\"file/path.txt/\", \"\")", property $ P.splitExtension "file/path.txt/" == ("file/path.txt/", "")) + ,("W.splitExtension \"file/path.txt/\" == (\"file/path.txt/\", \"\")", property $ W.splitExtension "file/path.txt/" == ("file/path.txt/", "")) + ,("P.takeExtension \"/directory/path.ext\" == \".ext\"", property $ P.takeExtension "/directory/path.ext" == ".ext") + ,("W.takeExtension \"/directory/path.ext\" == \".ext\"", property $ W.takeExtension "/directory/path.ext" == ".ext") + ,("P.takeExtension x == snd (P.splitExtension x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.takeExtension x == snd (P.splitExtension x)) + ,("W.takeExtension x == snd (W.splitExtension x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.takeExtension x == snd (W.splitExtension x)) + ,("P.takeExtension (P.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.takeExtension (P.addExtension x "ext") == ".ext") + ,("W.takeExtension (W.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.takeExtension (W.addExtension x "ext") == ".ext") + ,("P.takeExtension (P.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.takeExtension (P.replaceExtension x "ext") == ".ext") + ,("W.takeExtension (W.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.takeExtension (W.replaceExtension x "ext") == ".ext") + ,("\"/directory/path.txt\" P.-<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" P.-<.> "ext" == "/directory/path.ext") + ,("\"/directory/path.txt\" W.-<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" W.-<.> "ext" == "/directory/path.ext") + ,("\"/directory/path.txt\" P.-<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" P.-<.> ".ext" == "/directory/path.ext") + ,("\"/directory/path.txt\" W.-<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" W.-<.> ".ext" == "/directory/path.ext") + ,("\"foo.o\" P.-<.> \"c\" == \"foo.c\"", property $ "foo.o" P.-<.> "c" == "foo.c") + ,("\"foo.o\" W.-<.> \"c\" == \"foo.c\"", property $ "foo.o" W.-<.> "c" == "foo.c") + ,("P.replaceExtension \"/directory/path.txt\" \"ext\" == \"/directory/path.ext\"", property $ P.replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext") + ,("W.replaceExtension \"/directory/path.txt\" \"ext\" == \"/directory/path.ext\"", property $ W.replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext") + ,("P.replaceExtension \"/directory/path.txt\" \".ext\" == \"/directory/path.ext\"", property $ P.replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext") + ,("W.replaceExtension \"/directory/path.txt\" \".ext\" == \"/directory/path.ext\"", property $ W.replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext") + ,("P.replaceExtension \"file.txt\" \".bob\" == \"file.bob\"", property $ P.replaceExtension "file.txt" ".bob" == "file.bob") + ,("W.replaceExtension \"file.txt\" \".bob\" == \"file.bob\"", property $ W.replaceExtension "file.txt" ".bob" == "file.bob") + ,("P.replaceExtension \"file.txt\" \"bob\" == \"file.bob\"", property $ P.replaceExtension "file.txt" "bob" == "file.bob") + ,("W.replaceExtension \"file.txt\" \"bob\" == \"file.bob\"", property $ W.replaceExtension "file.txt" "bob" == "file.bob") + ,("P.replaceExtension \"file\" \".bob\" == \"file.bob\"", property $ P.replaceExtension "file" ".bob" == "file.bob") + ,("W.replaceExtension \"file\" \".bob\" == \"file.bob\"", property $ W.replaceExtension "file" ".bob" == "file.bob") + ,("P.replaceExtension \"file.txt\" \"\" == \"file\"", property $ P.replaceExtension "file.txt" "" == "file") + ,("W.replaceExtension \"file.txt\" \"\" == \"file\"", property $ W.replaceExtension "file.txt" "" == "file") + ,("P.replaceExtension \"file.fred.bob\" \"txt\" == \"file.fred.txt\"", property $ P.replaceExtension "file.fred.bob" "txt" == "file.fred.txt") + ,("W.replaceExtension \"file.fred.bob\" \"txt\" == \"file.fred.txt\"", property $ W.replaceExtension "file.fred.bob" "txt" == "file.fred.txt") + ,("P.replaceExtension x y == P.addExtension (P.dropExtension x) y", property $ \(QFilePath vx) (QFilePath vy) -> let y = toRawFilePath vy in let x = toRawFilePath vx in P.replaceExtension x y == P.addExtension (P.dropExtension x) y) + ,("W.replaceExtension x y == W.addExtension (W.dropExtension x) y", property $ \(QFilePath vx) (QFilePath vy) -> let y = toRawFilePath vy in let x = toRawFilePath vx in W.replaceExtension x y == W.addExtension (W.dropExtension x) y) + ,("\"/directory/path\" P.<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path" P.<.> "ext" == "/directory/path.ext") + ,("\"/directory/path\" W.<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path" W.<.> "ext" == "/directory/path.ext") + ,("\"/directory/path\" P.<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path" P.<.> ".ext" == "/directory/path.ext") + ,("\"/directory/path\" W.<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path" W.<.> ".ext" == "/directory/path.ext") + ,("P.dropExtension \"/directory/path.ext\" == \"/directory/path\"", property $ P.dropExtension "/directory/path.ext" == "/directory/path") + ,("W.dropExtension \"/directory/path.ext\" == \"/directory/path\"", property $ W.dropExtension "/directory/path.ext" == "/directory/path") + ,("P.dropExtension x == fst (P.splitExtension x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.dropExtension x == fst (P.splitExtension x)) + ,("W.dropExtension x == fst (W.splitExtension x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.dropExtension x == fst (W.splitExtension x)) + ,("P.addExtension \"/directory/path\" \"ext\" == \"/directory/path.ext\"", property $ P.addExtension "/directory/path" "ext" == "/directory/path.ext") + ,("W.addExtension \"/directory/path\" \"ext\" == \"/directory/path.ext\"", property $ W.addExtension "/directory/path" "ext" == "/directory/path.ext") + ,("P.addExtension \"file.txt\" \"bib\" == \"file.txt.bib\"", property $ P.addExtension "file.txt" "bib" == "file.txt.bib") + ,("W.addExtension \"file.txt\" \"bib\" == \"file.txt.bib\"", property $ W.addExtension "file.txt" "bib" == "file.txt.bib") + ,("P.addExtension \"file.\" \".bib\" == \"file..bib\"", property $ P.addExtension "file." ".bib" == "file..bib") + ,("W.addExtension \"file.\" \".bib\" == \"file..bib\"", property $ W.addExtension "file." ".bib" == "file..bib") + ,("P.addExtension \"file\" \".bib\" == \"file.bib\"", property $ P.addExtension "file" ".bib" == "file.bib") + ,("W.addExtension \"file\" \".bib\" == \"file.bib\"", property $ W.addExtension "file" ".bib" == "file.bib") + ,("P.addExtension \"/\" \"x\" == \"/.x\"", property $ P.addExtension "/" "x" == "/.x") + ,("W.addExtension \"/\" \"x\" == \"/.x\"", property $ W.addExtension "/" "x" == "/.x") + ,("P.addExtension x \"\" == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.addExtension x "" == x) + ,("W.addExtension x \"\" == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.addExtension x "" == x) + ,("P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) "ext") == ".ext") + ,("W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) "ext") == ".ext") + ,("W.addExtension \"\\\\\\\\share\" \".txt\" == \"\\\\\\\\share\\\\.txt\"", property $ W.addExtension "\\\\share" ".txt" == "\\\\share\\.txt") + ,("P.hasExtension \"/directory/path.ext\" == True", property $ P.hasExtension "/directory/path.ext" == True) + ,("W.hasExtension \"/directory/path.ext\" == True", property $ W.hasExtension "/directory/path.ext" == True) + ,("P.hasExtension \"/directory/path\" == False", property $ P.hasExtension "/directory/path" == False) + ,("W.hasExtension \"/directory/path\" == False", property $ W.hasExtension "/directory/path" == False) + ,("null (P.takeExtension x) == not (P.hasExtension x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in null (P.takeExtension x) == not (P.hasExtension x)) + ,("null (W.takeExtension x) == not (W.hasExtension x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in null (W.takeExtension x) == not (W.hasExtension x)) + ,("\"png\" `P.isExtensionOf` \"/directory/file.png\" == True", property $ "png" `P.isExtensionOf` "/directory/file.png" == True) + ,("\"png\" `W.isExtensionOf` \"/directory/file.png\" == True", property $ "png" `W.isExtensionOf` "/directory/file.png" == True) + ,("\".png\" `P.isExtensionOf` \"/directory/file.png\" == True", property $ ".png" `P.isExtensionOf` "/directory/file.png" == True) + ,("\".png\" `W.isExtensionOf` \"/directory/file.png\" == True", property $ ".png" `W.isExtensionOf` "/directory/file.png" == True) + ,("\".tar.gz\" `P.isExtensionOf` \"bar/foo.tar.gz\" == True", property $ ".tar.gz" `P.isExtensionOf` "bar/foo.tar.gz" == True) + ,("\".tar.gz\" `W.isExtensionOf` \"bar/foo.tar.gz\" == True", property $ ".tar.gz" `W.isExtensionOf` "bar/foo.tar.gz" == True) + ,("\"ar.gz\" `P.isExtensionOf` \"bar/foo.tar.gz\" == False", property $ "ar.gz" `P.isExtensionOf` "bar/foo.tar.gz" == False) + ,("\"ar.gz\" `W.isExtensionOf` \"bar/foo.tar.gz\" == False", property $ "ar.gz" `W.isExtensionOf` "bar/foo.tar.gz" == False) + ,("\"png\" `P.isExtensionOf` \"/directory/file.png.jpg\" == False", property $ "png" `P.isExtensionOf` "/directory/file.png.jpg" == False) + ,("\"png\" `W.isExtensionOf` \"/directory/file.png.jpg\" == False", property $ "png" `W.isExtensionOf` "/directory/file.png.jpg" == False) + ,("\"csv/table.csv\" `P.isExtensionOf` \"/data/csv/table.csv\" == False", property $ "csv/table.csv" `P.isExtensionOf` "/data/csv/table.csv" == False) + ,("\"csv/table.csv\" `W.isExtensionOf` \"/data/csv/table.csv\" == False", property $ "csv/table.csv" `W.isExtensionOf` "/data/csv/table.csv" == False) + ,("P.stripExtension \"hs.o\" \"foo.x.hs.o\" == Just \"foo.x\"", property $ P.stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x") + ,("W.stripExtension \"hs.o\" \"foo.x.hs.o\" == Just \"foo.x\"", property $ W.stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x") + ,("P.stripExtension \"hi.o\" \"foo.x.hs.o\" == Nothing", property $ P.stripExtension "hi.o" "foo.x.hs.o" == Nothing) + ,("W.stripExtension \"hi.o\" \"foo.x.hs.o\" == Nothing", property $ W.stripExtension "hi.o" "foo.x.hs.o" == Nothing) + ,("P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)) + ,("W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)) + ,("P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)) + ,("W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)) + ,("P.stripExtension \".c.d\" \"a.b.c.d\" == Just \"a.b\"", property $ P.stripExtension ".c.d" "a.b.c.d" == Just "a.b") + ,("W.stripExtension \".c.d\" \"a.b.c.d\" == Just \"a.b\"", property $ W.stripExtension ".c.d" "a.b.c.d" == Just "a.b") + ,("P.stripExtension \".c.d\" \"a.b..c.d\" == Just \"a.b.\"", property $ P.stripExtension ".c.d" "a.b..c.d" == Just "a.b.") + ,("W.stripExtension \".c.d\" \"a.b..c.d\" == Just \"a.b.\"", property $ W.stripExtension ".c.d" "a.b..c.d" == Just "a.b.") + ,("P.stripExtension \"baz\" \"foo.bar\" == Nothing", property $ P.stripExtension "baz" "foo.bar" == Nothing) + ,("W.stripExtension \"baz\" \"foo.bar\" == Nothing", property $ W.stripExtension "baz" "foo.bar" == Nothing) + ,("P.stripExtension \"bar\" \"foobar\" == Nothing", property $ P.stripExtension "bar" "foobar" == Nothing) + ,("W.stripExtension \"bar\" \"foobar\" == Nothing", property $ W.stripExtension "bar" "foobar" == Nothing) + ,("P.stripExtension \"\" x == Just x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.stripExtension "" x == Just x) + ,("W.stripExtension \"\" x == Just x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.stripExtension "" x == Just x) + ,("P.splitExtensions \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ P.splitExtensions "/directory/path.ext" == ("/directory/path", ".ext")) + ,("W.splitExtensions \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ W.splitExtensions "/directory/path.ext" == ("/directory/path", ".ext")) + ,("P.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ P.splitExtensions "file.tar.gz" == ("file", ".tar.gz")) + ,("W.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ W.splitExtensions "file.tar.gz" == ("file", ".tar.gz")) + ,("uncurry (<>) (P.splitExtensions x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in uncurry (<>) (P.splitExtensions x) == x) + ,("uncurry (<>) (W.splitExtensions x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in uncurry (<>) (W.splitExtensions x) == x) + ,("uncurry P.addExtension (P.splitExtensions x) == x", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in uncurry P.addExtension (P.splitExtensions x) == x) + ,("uncurry W.addExtension (W.splitExtensions x) == x", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in uncurry W.addExtension (W.splitExtensions x) == x) + ,("P.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ P.splitExtensions "file.tar.gz" == ("file", ".tar.gz")) + ,("W.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ W.splitExtensions "file.tar.gz" == ("file", ".tar.gz")) + ,("P.dropExtensions \"/directory/path.ext\" == \"/directory/path\"", property $ P.dropExtensions "/directory/path.ext" == "/directory/path") + ,("W.dropExtensions \"/directory/path.ext\" == \"/directory/path\"", property $ W.dropExtensions "/directory/path.ext" == "/directory/path") + ,("P.dropExtensions \"file.tar.gz\" == \"file\"", property $ P.dropExtensions "file.tar.gz" == "file") + ,("W.dropExtensions \"file.tar.gz\" == \"file\"", property $ W.dropExtensions "file.tar.gz" == "file") + ,("not $ P.hasExtension $ P.dropExtensions x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not $ P.hasExtension $ P.dropExtensions x) + ,("not $ W.hasExtension $ W.dropExtensions x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not $ W.hasExtension $ W.dropExtensions x) + ,("not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x) + ,("not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x) + ,("P.takeExtensions \"/directory/path.ext\" == \".ext\"", property $ P.takeExtensions "/directory/path.ext" == ".ext") + ,("W.takeExtensions \"/directory/path.ext\" == \".ext\"", property $ W.takeExtensions "/directory/path.ext" == ".ext") + ,("P.takeExtensions \"file.tar.gz\" == \".tar.gz\"", property $ P.takeExtensions "file.tar.gz" == ".tar.gz") + ,("W.takeExtensions \"file.tar.gz\" == \".tar.gz\"", property $ W.takeExtensions "file.tar.gz" == ".tar.gz") + ,("P.replaceExtensions \"file.fred.bob\" \"txt\" == \"file.txt\"", property $ P.replaceExtensions "file.fred.bob" "txt" == "file.txt") + ,("W.replaceExtensions \"file.fred.bob\" \"txt\" == \"file.txt\"", property $ W.replaceExtensions "file.fred.bob" "txt" == "file.txt") + ,("P.replaceExtensions \"file.fred.bob\" \"tar.gz\" == \"file.tar.gz\"", property $ P.replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz") + ,("W.replaceExtensions \"file.fred.bob\" \"tar.gz\" == \"file.tar.gz\"", property $ W.replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz") + ,("uncurry (<>) (P.splitDrive x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in uncurry (<>) (P.splitDrive x) == x) + ,("uncurry (<>) (W.splitDrive x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in uncurry (<>) (W.splitDrive x) == x) + ,("W.splitDrive \"file\" == (\"\", \"file\")", property $ W.splitDrive "file" == ("", "file")) + ,("W.splitDrive \"c:/file\" == (\"c:/\", \"file\")", property $ W.splitDrive "c:/file" == ("c:/", "file")) + ,("W.splitDrive \"c:\\\\file\" == (\"c:\\\\\", \"file\")", property $ W.splitDrive "c:\\file" == ("c:\\", "file")) + ,("W.splitDrive \"\\\\\\\\shared\\\\test\" == (\"\\\\\\\\shared\\\\\", \"test\")", property $ W.splitDrive "\\\\shared\\test" == ("\\\\shared\\", "test")) + ,("W.splitDrive \"\\\\\\\\shared\" == (\"\\\\\\\\shared\", \"\")", property $ W.splitDrive "\\\\shared" == ("\\\\shared", "")) + ,("W.splitDrive \"\\\\\\\\?\\\\UNC\\\\shared\\\\file\" == (\"\\\\\\\\?\\\\UNC\\\\shared\\\\\", \"file\")", property $ W.splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\", "file")) + ,("W.splitDrive \"\\\\\\\\?\\\\UNCshared\\\\file\" == (\"\\\\\\\\?\\\\\", \"UNCshared\\\\file\")", property $ W.splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\", "UNCshared\\file")) + ,("W.splitDrive \"\\\\\\\\?\\\\d:\\\\file\" == (\"\\\\\\\\?\\\\d:\\\\\", \"file\")", property $ W.splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\", "file")) + ,("W.splitDrive \"/d\" == (\"\", \"/d\")", property $ W.splitDrive "/d" == ("", "/d")) + ,("P.splitDrive \"/test\" == (\"/\", \"test\")", property $ P.splitDrive "/test" == ("/", "test")) + ,("P.splitDrive \"//test\" == (\"//\", \"test\")", property $ P.splitDrive "//test" == ("//", "test")) + ,("P.splitDrive \"test/file\" == (\"\", \"test/file\")", property $ P.splitDrive "test/file" == ("", "test/file")) + ,("P.splitDrive \"file\" == (\"\", \"file\")", property $ P.splitDrive "file" == ("", "file")) + ,("uncurry P.joinDrive (P.splitDrive x) == x", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in uncurry P.joinDrive (P.splitDrive x) == x) + ,("uncurry W.joinDrive (W.splitDrive x) == x", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in uncurry W.joinDrive (W.splitDrive x) == x) + ,("W.joinDrive \"C:\" \"foo\" == \"C:foo\"", property $ W.joinDrive "C:" "foo" == "C:foo") + ,("W.joinDrive \"C:\\\\\" \"bar\" == \"C:\\\\bar\"", property $ W.joinDrive "C:\\" "bar" == "C:\\bar") + ,("W.joinDrive \"\\\\\\\\share\" \"foo\" == \"\\\\\\\\share\\\\foo\"", property $ W.joinDrive "\\\\share" "foo" == "\\\\share\\foo") + ,("W.joinDrive \"/:\" \"foo\" == \"/:\\\\foo\"", property $ W.joinDrive "/:" "foo" == "/:\\foo") + ,("P.takeDrive x == fst (P.splitDrive x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.takeDrive x == fst (P.splitDrive x)) + ,("W.takeDrive x == fst (W.splitDrive x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.takeDrive x == fst (W.splitDrive x)) + ,("P.dropDrive x == snd (P.splitDrive x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.dropDrive x == snd (P.splitDrive x)) + ,("W.dropDrive x == snd (W.splitDrive x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.dropDrive x == snd (W.splitDrive x)) + ,("not (P.hasDrive x) == null (P.takeDrive x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not (P.hasDrive x) == null (P.takeDrive x)) + ,("not (W.hasDrive x) == null (W.takeDrive x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not (W.hasDrive x) == null (W.takeDrive x)) + ,("P.hasDrive \"/foo\" == True", property $ P.hasDrive "/foo" == True) + ,("W.hasDrive \"C:\\\\foo\" == True", property $ W.hasDrive "C:\\foo" == True) + ,("W.hasDrive \"C:foo\" == True", property $ W.hasDrive "C:foo" == True) + ,("P.hasDrive \"foo\" == False", property $ P.hasDrive "foo" == False) + ,("W.hasDrive \"foo\" == False", property $ W.hasDrive "foo" == False) + ,("P.hasDrive \"\" == False", property $ P.hasDrive "" == False) + ,("W.hasDrive \"\" == False", property $ W.hasDrive "" == False) + ,("P.isDrive \"/\" == True", property $ P.isDrive "/" == True) + ,("P.isDrive \"/foo\" == False", property $ P.isDrive "/foo" == False) + ,("W.isDrive \"C:\\\\\" == True", property $ W.isDrive "C:\\" == True) + ,("W.isDrive \"C:\\\\foo\" == False", property $ W.isDrive "C:\\foo" == False) + ,("P.isDrive \"\" == False", property $ P.isDrive "" == False) + ,("W.isDrive \"\" == False", property $ W.isDrive "" == False) + ,("P.splitFileName \"/directory/file.ext\" == (\"/directory/\", \"file.ext\")", property $ P.splitFileName "/directory/file.ext" == ("/directory/", "file.ext")) + ,("W.splitFileName \"/directory/file.ext\" == (\"/directory/\", \"file.ext\")", property $ W.splitFileName "/directory/file.ext" == ("/directory/", "file.ext")) + ,("uncurry (P.) (P.splitFileName x) == x || fst (P.splitFileName x) == \"./\"", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in uncurry (P.) (P.splitFileName x) == x || fst (P.splitFileName x) == "./") + ,("uncurry (W.) (W.splitFileName x) == x || fst (W.splitFileName x) == \"./\"", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in uncurry (W.) (W.splitFileName x) == x || fst (W.splitFileName x) == "./") + ,("P.isValid (fst (P.splitFileName x))", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.isValid (fst (P.splitFileName x))) + ,("W.isValid (fst (W.splitFileName x))", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.isValid (fst (W.splitFileName x))) + ,("P.splitFileName \"file/bob.txt\" == (\"file/\", \"bob.txt\")", property $ P.splitFileName "file/bob.txt" == ("file/", "bob.txt")) + ,("W.splitFileName \"file/bob.txt\" == (\"file/\", \"bob.txt\")", property $ W.splitFileName "file/bob.txt" == ("file/", "bob.txt")) + ,("P.splitFileName \"file/\" == (\"file/\", \"\")", property $ P.splitFileName "file/" == ("file/", "")) + ,("W.splitFileName \"file/\" == (\"file/\", \"\")", property $ W.splitFileName "file/" == ("file/", "")) + ,("P.splitFileName \"bob\" == (\"./\", \"bob\")", property $ P.splitFileName "bob" == ("./", "bob")) + ,("W.splitFileName \"bob\" == (\"./\", \"bob\")", property $ W.splitFileName "bob" == ("./", "bob")) + ,("P.splitFileName \"/\" == (\"/\", \"\")", property $ P.splitFileName "/" == ("/", "")) + ,("W.splitFileName \"c:\" == (\"c:\", \"\")", property $ W.splitFileName "c:" == ("c:", "")) + ,("P.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ P.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext") + ,("W.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ W.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext") + ,("P.replaceFileName x (P.takeFileName x) == x", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.replaceFileName x (P.takeFileName x) == x) + ,("W.replaceFileName x (W.takeFileName x) == x", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.replaceFileName x (W.takeFileName x) == x) + ,("P.dropFileName \"/directory/file.ext\" == \"/directory/\"", property $ P.dropFileName "/directory/file.ext" == "/directory/") + ,("W.dropFileName \"/directory/file.ext\" == \"/directory/\"", property $ W.dropFileName "/directory/file.ext" == "/directory/") + ,("P.dropFileName x == fst (P.splitFileName x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.dropFileName x == fst (P.splitFileName x)) + ,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.dropFileName x == fst (W.splitFileName x)) + ,("P.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ P.takeFileName "/directory/file.ext" == "file.ext") + ,("W.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ W.takeFileName "/directory/file.ext" == "file.ext") + ,("P.takeFileName \"test/\" == \"\"", property $ P.takeFileName "test/" == "") + ,("W.takeFileName \"test/\" == \"\"", property $ W.takeFileName "test/" == "") + ,("P.takeFileName x `isSuffixOf` x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.takeFileName x `isSuffixOf` x) + ,("W.takeFileName x `isSuffixOf` x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.takeFileName x `isSuffixOf` x) + ,("P.takeFileName x == snd (P.splitFileName x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.takeFileName x == snd (P.splitFileName x)) + ,("W.takeFileName x == snd (W.splitFileName x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.takeFileName x == snd (W.splitFileName x)) + ,("P.takeFileName (P.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.takeFileName (P.replaceFileName x "fred") == "fred") + ,("W.takeFileName (W.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.takeFileName (W.replaceFileName x "fred") == "fred") + ,("P.takeFileName (x P. \"fred\") == \"fred\"", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.takeFileName (x P. "fred") == "fred") + ,("W.takeFileName (x W. \"fred\") == \"fred\"", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.takeFileName (x W. "fred") == "fred") + ,("P.isRelative (P.takeFileName x)", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.isRelative (P.takeFileName x)) + ,("W.isRelative (W.takeFileName x)", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.isRelative (W.takeFileName x)) + ,("P.takeBaseName \"/directory/file.ext\" == \"file\"", property $ P.takeBaseName "/directory/file.ext" == "file") + ,("W.takeBaseName \"/directory/file.ext\" == \"file\"", property $ W.takeBaseName "/directory/file.ext" == "file") + ,("P.takeBaseName \"file/test.txt\" == \"test\"", property $ P.takeBaseName "file/test.txt" == "test") + ,("W.takeBaseName \"file/test.txt\" == \"test\"", property $ W.takeBaseName "file/test.txt" == "test") + ,("P.takeBaseName \"dave.ext\" == \"dave\"", property $ P.takeBaseName "dave.ext" == "dave") + ,("W.takeBaseName \"dave.ext\" == \"dave\"", property $ W.takeBaseName "dave.ext" == "dave") + ,("P.takeBaseName \"\" == \"\"", property $ P.takeBaseName "" == "") + ,("W.takeBaseName \"\" == \"\"", property $ W.takeBaseName "" == "") + ,("P.takeBaseName \"test\" == \"test\"", property $ P.takeBaseName "test" == "test") + ,("W.takeBaseName \"test\" == \"test\"", property $ W.takeBaseName "test" == "test") + ,("P.takeBaseName (P.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.takeBaseName (P.addTrailingPathSeparator x) == "") + ,("W.takeBaseName (W.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.takeBaseName (W.addTrailingPathSeparator x) == "") + ,("P.takeBaseName \"file/file.tar.gz\" == \"file.tar\"", property $ P.takeBaseName "file/file.tar.gz" == "file.tar") + ,("W.takeBaseName \"file/file.tar.gz\" == \"file.tar\"", property $ W.takeBaseName "file/file.tar.gz" == "file.tar") + ,("P.replaceBaseName \"/directory/other.ext\" \"file\" == \"/directory/file.ext\"", property $ P.replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext") + ,("W.replaceBaseName \"/directory/other.ext\" \"file\" == \"/directory/file.ext\"", property $ W.replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext") + ,("P.replaceBaseName \"file/test.txt\" \"bob\" == \"file/bob.txt\"", property $ P.replaceBaseName "file/test.txt" "bob" == "file/bob.txt") + ,("W.replaceBaseName \"file/test.txt\" \"bob\" == \"file/bob.txt\"", property $ W.replaceBaseName "file/test.txt" "bob" == "file/bob.txt") + ,("P.replaceBaseName \"fred\" \"bill\" == \"bill\"", property $ P.replaceBaseName "fred" "bill" == "bill") + ,("W.replaceBaseName \"fred\" \"bill\" == \"bill\"", property $ W.replaceBaseName "fred" "bill" == "bill") + ,("P.replaceBaseName \"/dave/fred/bob.gz.tar\" \"new\" == \"/dave/fred/new.tar\"", property $ P.replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar") + ,("W.replaceBaseName \"/dave/fred/bob.gz.tar\" \"new\" == \"/dave/fred/new.tar\"", property $ W.replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar") + ,("P.replaceBaseName x (P.takeBaseName x) == x", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.replaceBaseName x (P.takeBaseName x) == x) + ,("W.replaceBaseName x (W.takeBaseName x) == x", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.replaceBaseName x (W.takeBaseName x) == x) + ,("P.hasTrailingPathSeparator \"test\" == False", property $ P.hasTrailingPathSeparator "test" == False) + ,("W.hasTrailingPathSeparator \"test\" == False", property $ W.hasTrailingPathSeparator "test" == False) + ,("P.hasTrailingPathSeparator \"test/\" == True", property $ P.hasTrailingPathSeparator "test/" == True) + ,("W.hasTrailingPathSeparator \"test/\" == True", property $ W.hasTrailingPathSeparator "test/" == True) + ,("P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)) + ,("W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)) + ,("P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x) + ,("W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x) + ,("P.addTrailingPathSeparator \"test/rest\" == \"test/rest/\"", property $ P.addTrailingPathSeparator "test/rest" == "test/rest/") + ,("P.dropTrailingPathSeparator \"file/test/\" == \"file/test\"", property $ P.dropTrailingPathSeparator "file/test/" == "file/test") + ,("W.dropTrailingPathSeparator \"file/test/\" == \"file/test\"", property $ W.dropTrailingPathSeparator "file/test/" == "file/test") + ,("P.dropTrailingPathSeparator \"/\" == \"/\"", property $ P.dropTrailingPathSeparator "/" == "/") + ,("W.dropTrailingPathSeparator \"/\" == \"/\"", property $ W.dropTrailingPathSeparator "/" == "/") + ,("W.dropTrailingPathSeparator \"\\\\\" == \"\\\\\"", property $ W.dropTrailingPathSeparator "\\" == "\\") + ,("not (P.hasTrailingPathSeparator (P.dropTrailingPathSeparator x)) || P.isDrive x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in not (P.hasTrailingPathSeparator (P.dropTrailingPathSeparator x)) || P.isDrive x) + ,("P.takeDirectory \"/directory/other.ext\" == \"/directory\"", property $ P.takeDirectory "/directory/other.ext" == "/directory") + ,("W.takeDirectory \"/directory/other.ext\" == \"/directory\"", property $ W.takeDirectory "/directory/other.ext" == "/directory") + ,("P.takeDirectory x `isPrefixOf` x || P.takeDirectory x == \".\"", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.takeDirectory x `isPrefixOf` x || P.takeDirectory x == ".") + ,("W.takeDirectory x `isPrefixOf` x || W.takeDirectory x == \".\"", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.takeDirectory x `isPrefixOf` x || W.takeDirectory x == ".") + ,("P.takeDirectory \"foo\" == \".\"", property $ P.takeDirectory "foo" == ".") + ,("W.takeDirectory \"foo\" == \".\"", property $ W.takeDirectory "foo" == ".") + ,("P.takeDirectory \"/\" == \"/\"", property $ P.takeDirectory "/" == "/") + ,("W.takeDirectory \"/\" == \"/\"", property $ W.takeDirectory "/" == "/") + ,("P.takeDirectory \"/foo\" == \"/\"", property $ P.takeDirectory "/foo" == "/") + ,("W.takeDirectory \"/foo\" == \"/\"", property $ W.takeDirectory "/foo" == "/") + ,("P.takeDirectory \"/foo/bar/baz\" == \"/foo/bar\"", property $ P.takeDirectory "/foo/bar/baz" == "/foo/bar") + ,("W.takeDirectory \"/foo/bar/baz\" == \"/foo/bar\"", property $ W.takeDirectory "/foo/bar/baz" == "/foo/bar") + ,("P.takeDirectory \"/foo/bar/baz/\" == \"/foo/bar/baz\"", property $ P.takeDirectory "/foo/bar/baz/" == "/foo/bar/baz") + ,("W.takeDirectory \"/foo/bar/baz/\" == \"/foo/bar/baz\"", property $ W.takeDirectory "/foo/bar/baz/" == "/foo/bar/baz") + ,("P.takeDirectory \"foo/bar/baz\" == \"foo/bar\"", property $ P.takeDirectory "foo/bar/baz" == "foo/bar") + ,("W.takeDirectory \"foo/bar/baz\" == \"foo/bar\"", property $ W.takeDirectory "foo/bar/baz" == "foo/bar") + ,("W.takeDirectory \"foo\\\\bar\" == \"foo\"", property $ W.takeDirectory "foo\\bar" == "foo") + ,("W.takeDirectory \"foo\\\\bar\\\\\\\\\" == \"foo\\\\bar\"", property $ W.takeDirectory "foo\\bar\\\\" == "foo\\bar") + ,("W.takeDirectory \"C:\\\\\" == \"C:\\\\\"", property $ W.takeDirectory "C:\\" == "C:\\") + ,("P.replaceDirectory \"root/file.ext\" \"/directory/\" == \"/directory/file.ext\"", property $ P.replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext") + ,("W.replaceDirectory \"root/file.ext\" \"/directory/\" == \"/directory/file.ext\"", property $ W.replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext") + ,("\"/directory\" P. \"file.ext\" == \"/directory/file.ext\"", property $ "/directory" P. "file.ext" == "/directory/file.ext") + ,("\"/directory\" W. \"file.ext\" == \"/directory\\\\file.ext\"", property $ "/directory" W. "file.ext" == "/directory\\file.ext") + ,("\"directory\" P. \"/file.ext\" == \"/file.ext\"", property $ "directory" P. "/file.ext" == "/file.ext") + ,("\"directory\" W. \"/file.ext\" == \"/file.ext\"", property $ "directory" W. "/file.ext" == "/file.ext") + ,("\"/\" P. \"test\" == \"/test\"", property $ "/" P. "test" == "/test") + ,("\"home\" P. \"bob\" == \"home/bob\"", property $ "home" P. "bob" == "home/bob") + ,("\"x:\" P. \"foo\" == \"x:/foo\"", property $ "x:" P. "foo" == "x:/foo") + ,("\"C:\\\\foo\" W. \"bar\" == \"C:\\\\foo\\\\bar\"", property $ "C:\\foo" W. "bar" == "C:\\foo\\bar") + ,("\"home\" W. \"bob\" == \"home\\\\bob\"", property $ "home" W. "bob" == "home\\bob") + ,("\"home\" P. \"/bob\" == \"/bob\"", property $ "home" P. "/bob" == "/bob") + ,("\"home\" W. \"C:\\\\bob\" == \"C:\\\\bob\"", property $ "home" W. "C:\\bob" == "C:\\bob") + ,("\"home\" W. \"/bob\" == \"/bob\"", property $ "home" W. "/bob" == "/bob") + ,("\"home\" W. \"\\\\bob\" == \"\\\\bob\"", property $ "home" W. "\\bob" == "\\bob") + ,("\"C:\\\\home\" W. \"\\\\bob\" == \"\\\\bob\"", property $ "C:\\home" W. "\\bob" == "\\bob") + ,("\"D:\\\\foo\" W. \"C:bar\" == \"C:bar\"", property $ "D:\\foo" W. "C:bar" == "C:bar") + ,("\"C:\\\\foo\" W. \"C:bar\" == \"C:bar\"", property $ "C:\\foo" W. "C:bar" == "C:bar") + ,("P.splitPath \"/directory/file.ext\" == [\"/\", \"directory/\", \"file.ext\"]", property $ P.splitPath "/directory/file.ext" == ["/", "directory/", "file.ext"]) + ,("W.splitPath \"/directory/file.ext\" == [\"/\", \"directory/\", \"file.ext\"]", property $ W.splitPath "/directory/file.ext" == ["/", "directory/", "file.ext"]) + ,("mconcat (P.splitPath x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in mconcat (P.splitPath x) == x) + ,("mconcat (W.splitPath x) == x", property $ \(QFilePath vx) -> let x = toRawFilePath vx in mconcat (W.splitPath x) == x) + ,("P.splitPath \"test//item/\" == [\"test//\", \"item/\"]", property $ P.splitPath "test//item/" == ["test//", "item/"]) + ,("W.splitPath \"test//item/\" == [\"test//\", \"item/\"]", property $ W.splitPath "test//item/" == ["test//", "item/"]) + ,("P.splitPath \"test/item/file\" == [\"test/\", \"item/\", \"file\"]", property $ P.splitPath "test/item/file" == ["test/", "item/", "file"]) + ,("W.splitPath \"test/item/file\" == [\"test/\", \"item/\", \"file\"]", property $ W.splitPath "test/item/file" == ["test/", "item/", "file"]) + ,("P.splitPath \"\" == []", property $ P.splitPath "" == []) + ,("W.splitPath \"\" == []", property $ W.splitPath "" == []) + ,("W.splitPath \"c:\\\\test\\\\path\" == [\"c:\\\\\", \"test\\\\\", \"path\"]", property $ W.splitPath "c:\\test\\path" == ["c:\\", "test\\", "path"]) + ,("P.splitPath \"/file/test\" == [\"/\", \"file/\", \"test\"]", property $ P.splitPath "/file/test" == ["/", "file/", "test"]) + ,("P.splitDirectories \"/directory/file.ext\" == [\"/\", \"directory\", \"file.ext\"]", property $ P.splitDirectories "/directory/file.ext" == ["/", "directory", "file.ext"]) + ,("W.splitDirectories \"/directory/file.ext\" == [\"/\", \"directory\", \"file.ext\"]", property $ W.splitDirectories "/directory/file.ext" == ["/", "directory", "file.ext"]) + ,("P.splitDirectories \"test/file\" == [\"test\", \"file\"]", property $ P.splitDirectories "test/file" == ["test", "file"]) + ,("W.splitDirectories \"test/file\" == [\"test\", \"file\"]", property $ W.splitDirectories "test/file" == ["test", "file"]) + ,("P.splitDirectories \"/test/file\" == [\"/\", \"test\", \"file\"]", property $ P.splitDirectories "/test/file" == ["/", "test", "file"]) + ,("W.splitDirectories \"/test/file\" == [\"/\", \"test\", \"file\"]", property $ W.splitDirectories "/test/file" == ["/", "test", "file"]) + ,("W.splitDirectories \"C:\\\\test\\\\file\" == [\"C:\\\\\", \"test\", \"file\"]", property $ W.splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]) + ,("P.splitDirectories \"\" == []", property $ P.splitDirectories "" == []) + ,("W.splitDirectories \"\" == []", property $ W.splitDirectories "" == []) + ,("W.splitDirectories \"C:\\\\test\\\\\\\\\\\\file\" == [\"C:\\\\\", \"test\", \"file\"]", property $ W.splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]) + ,("P.splitDirectories \"/test///file\" == [\"/\", \"test\", \"file\"]", property $ P.splitDirectories "/test///file" == ["/", "test", "file"]) + ,("W.splitDirectories \"/test///file\" == [\"/\", \"test\", \"file\"]", property $ W.splitDirectories "/test///file" == ["/", "test", "file"]) + ,("P.joinPath [\"/\", \"directory/\", \"file.ext\"] == \"/directory/file.ext\"", property $ P.joinPath ["/", "directory/", "file.ext"] == "/directory/file.ext") + ,("W.joinPath [\"/\", \"directory/\", \"file.ext\"] == \"/directory/file.ext\"", property $ W.joinPath ["/", "directory/", "file.ext"] == "/directory/file.ext") + ,("P.joinPath (P.splitPath x) == x", property $ \(QFilePathValidP vx) -> let x = toRawFilePath vx in P.joinPath (P.splitPath x) == x) + ,("W.joinPath (W.splitPath x) == x", property $ \(QFilePathValidW vx) -> let x = toRawFilePath vx in W.joinPath (W.splitPath x) == x) + ,("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.isValid \"\" == False", property $ P.isValid "" == False) + ,("W.isValid \"\" == False", property $ W.isValid "" == False) + ,("P.isValid \"\\0\" == False", property $ P.isValid "\0" == False) + ,("W.isValid \"\\0\" == False", property $ W.isValid "\0" == False) + ,("P.isValid \"/random_ path:*\" == True", property $ P.isValid "/random_ path:*" == True) + ,("P.isValid x == (x /= mempty)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.isValid x == (x /= mempty)) + ,("W.isValid \"c:\\\\test\" == True", property $ W.isValid "c:\\test" == True) + ,("W.isValid \"c:\\\\test:of_test\" == False", property $ W.isValid "c:\\test:of_test" == False) + ,("W.isValid \"test*\" == False", property $ W.isValid "test*" == False) + ,("W.isValid \"c:\\\\test\\\\nul\" == False", property $ W.isValid "c:\\test\\nul" == False) + ,("W.isValid \"c:\\\\test\\\\prn.txt\" == False", property $ W.isValid "c:\\test\\prn.txt" == False) + ,("W.isValid \"c:\\\\nul\\\\file\" == False", property $ W.isValid "c:\\nul\\file" == False) + ,("W.isValid \"\\\\\\\\\" == False", property $ W.isValid "\\\\" == False) + ,("W.isValid \"\\\\\\\\\\\\foo\" == False", property $ W.isValid "\\\\\\foo" == False) + ,("W.isValid \"\\\\\\\\?\\\\D:file\" == False", property $ W.isValid "\\\\?\\D:file" == False) + ,("W.isValid \"foo\\tbar\" == False", property $ W.isValid "foo\tbar" == False) + ,("W.isValid \"nul .txt\" == False", property $ W.isValid "nul .txt" == False) + ,("W.isValid \" nul.txt\" == True", property $ W.isValid " nul.txt" == True) + ,("W.isRelative \"path\\\\test\" == True", property $ W.isRelative "path\\test" == True) + ,("W.isRelative \"c:\\\\test\" == False", property $ W.isRelative "c:\\test" == False) + ,("W.isRelative \"c:test\" == True", property $ W.isRelative "c:test" == True) + ,("W.isRelative \"c:\\\\\" == False", property $ W.isRelative "c:\\" == False) + ,("W.isRelative \"c:/\" == False", property $ W.isRelative "c:/" == False) + ,("W.isRelative \"c:\" == True", property $ W.isRelative "c:" == True) + ,("W.isRelative \"\\\\\\\\foo\" == False", property $ W.isRelative "\\\\foo" == False) + ,("W.isRelative \"\\\\\\\\?\\\\foo\" == False", property $ W.isRelative "\\\\?\\foo" == False) + ,("W.isRelative \"\\\\\\\\?\\\\UNC\\\\foo\" == False", property $ W.isRelative "\\\\?\\UNC\\foo" == False) + ,("W.isRelative \"/foo\" == True", property $ W.isRelative "/foo" == True) + ,("W.isRelative \"\\\\foo\" == True", property $ W.isRelative "\\foo" == True) + ,("P.isRelative \"test/path\" == True", property $ P.isRelative "test/path" == True) + ,("P.isRelative \"/test\" == False", property $ P.isRelative "/test" == False) + ,("P.isRelative \"/\" == False", property $ P.isRelative "/" == False) + ,("P.isAbsolute x == not (P.isRelative x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in P.isAbsolute x == not (P.isRelative x)) + ,("W.isAbsolute x == not (W.isRelative x)", property $ \(QFilePath vx) -> let x = toRawFilePath vx in W.isAbsolute x == not (W.isRelative x)) + ] diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs new file mode 100644 --- /dev/null +++ b/tests/TestUtil.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-} + +module TestUtil( + (==>), QFilePath(..), QFilePathValidW(..), QFilePathValidP(..), + toRawFilePath, + equiv_0, equiv_1, equiv_2, equiv_3, + module Test.QuickCheck, + module Data.Maybe + ) where + +import Test.QuickCheck hiding ((==>)) +import Data.List +import Data.Maybe +import Data.Word +import Data.Char +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 + +infixr 0 ==> +a ==> b = not a || b + +class ToRawFilePath t where + 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) + +newtype QFilePathValidW = QFilePathValidW FilePath deriving Show + +instance ToRawFilePath QFilePathValidW where + toRawFilePath (QFilePathValidW p) = toRawFilePath p + +instance Arbitrary QFilePathValidW where + arbitrary = fmap (QFilePathValidW . W.makeValid) arbitraryFilePath + shrink (QFilePathValidW x) = shrinkValid QFilePathValidW W.makeValid x + +newtype QFilePathValidP = QFilePathValidP FilePath deriving Show + +instance ToRawFilePath QFilePathValidP where + toRawFilePath (QFilePathValidP p) = toRawFilePath p + +instance Arbitrary QFilePathValidP where + arbitrary = fmap (QFilePathValidP . P.makeValid) arbitraryFilePath + shrink (QFilePathValidP x) = shrinkValid QFilePathValidP P.makeValid x + +newtype QFilePath = QFilePath FilePath deriving Show + +instance ToRawFilePath QFilePath where + toRawFilePath (QFilePath p) = toRawFilePath p + +instance Arbitrary QFilePath where + arbitrary = fmap QFilePath arbitraryFilePath + shrink (QFilePath x) = shrinkValid QFilePath id x + + +-- | Generate an arbitrary FilePath use a few special (interesting) characters. +arbitraryFilePath :: Gen FilePath +arbitraryFilePath = sized $ \n -> do + k <- choose (0,n) + replicateM k $ elements "?./:\\a ;_" + +-- | Shrink, but also apply a validity function. Try and make shorter, or use more +-- @a@ (since @a@ is pretty dull), but make sure you terminate even after valid. +shrinkValid :: (FilePath -> a) -> (FilePath -> FilePath) -> FilePath -> [a] +shrinkValid wrap valid o = + [ wrap y + | y <- map valid $ shrinkList (\x -> ['a' | x /= 'a']) o + , length y < length o || (length y == length o && countA y > countA o)] + where countA = length . filter (== 'a') + +class EquivResult t1 t2 where + equivresult :: t1 -> t2 -> Bool + +instance Eq t => EquivResult t t where + equivresult a b = a == b + +instance (EquivResult a c, EquivResult b d) => EquivResult (a, b) (c, d) where + equivresult (a, b) (c, d) = equivresult a c && equivresult b d + +instance (EquivResult a b) => EquivResult (Maybe a) (Maybe b) where + equivresult Nothing Nothing = True + equivresult (Just a) (Just b) = equivresult a b + +instance (EquivResult a b) => EquivResult [a] [b] where + equivresult a b = and (map (uncurry equivresult) (zip a b)) + +instance EquivResult FilePath RawFilePath where + equivresult a b = toRawFilePath a == b + +instance EquivResult RawFilePath FilePath where + equivresult a b = toRawFilePath b == a + +equiv_0 + :: EquivResult a b + => (Word8 -> a) + -> (Char -> b) + -> Property +equiv_0 our their = property $ \w -> + our w `equivresult` their (chr (fromIntegral w)) + +equiv_1 + :: EquivResult a b + => (RawFilePath -> a) + -> (FilePath -> b) + -> Property +equiv_1 our their = property $ \(QFilePath f) -> + our (toRawFilePath f) `equivresult` their f + +equiv_2 + :: EquivResult a b + => (RawFilePath -> RawFilePath -> a) + -> (FilePath -> FilePath -> b) + -> Property +equiv_2 our their = property $ \(QFilePath a) (QFilePath b) -> + our (toRawFilePath a) (toRawFilePath b) `equivresult` their a b + +equiv_3 + :: EquivResult a b + => ([RawFilePath] -> a) + -> ([FilePath] -> b) + -> Property +equiv_3 our their = property $ \l -> + our (map (\(QFilePath f) -> toRawFilePath f) l) + `equivresult` + their (map (\(QFilePath f) -> f) l) +