diff --git a/Generate.hs b/Generate.hs new file mode 100644 --- /dev/null +++ b/Generate.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE CPP, RecordWildCards, ViewPatterns #-} + +module Generate(main) where + +import Control.Exception +import Control.Monad +import Data.Semigroup +import Data.Char +import Data.List +import System.Directory +import System.IO + + +main :: IO () +main = do + src <- readFile "System/FilePath/Internal.hs" + let tests = map renderTest $ concatMap parseTest $ lines src + writeFileBinaryChanged "tests/filepath-tests/TestGen.hs" $ unlines $ + ["-- GENERATED CODE: See ../Generate.hs" +#ifndef GHC_MAKE + , "{-# LANGUAGE OverloadedStrings #-}" + , "{-# LANGUAGE ViewPatterns #-}" +#endif + , "{-# LANGUAGE CPP #-}" + , "{-# OPTIONS_GHC -Wno-name-shadowing #-}" + , "{-# OPTIONS_GHC -Wno-orphans #-}" + ,"module TestGen(tests) where" + ,"import TestUtil" + ,"#if !MIN_VERSION_base(4,11,0)" + ,"import Data.Semigroup" + ,"#endif" + ,"import Prelude as P" + ,"import Data.String" + ,"import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )" + ,"import GHC.IO.Encoding.UTF16 ( mkUTF16le )" + ,"import GHC.IO.Encoding.UTF8 ( mkUTF8 )" + ,"import System.OsString.Internal.Types" + ,"import System.OsString.Encoding.Internal" + ,"import qualified Data.Char as C" + ,"import qualified System.OsString.Data.ByteString.Short as SBS" + ,"import qualified System.OsString.Data.ByteString.Short.Word16 as SBS16" + ,"import qualified System.FilePath.Windows as W" + ,"import qualified System.FilePath.Posix as P" +#ifdef GHC_MAKE + ,"import qualified System.OsPath.Windows.Internal as AFP_W" + ,"import qualified System.OsPath.Posix.Internal as AFP_P" +#else + ,"import qualified System.OsPath.Windows as AFP_W" + ,"import qualified System.OsPath.Posix as AFP_P" +#endif + ,"instance IsString WindowsString where fromString = WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)" + ,"instance IsString PosixString where fromString = PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)" + ,"#if defined(mingw32_HOST_OS) || defined(__MINGW32__)" + ,"instance IsString OsString where fromString = OsString . WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)" + ,"#else" + ,"instance IsString OsString where fromString = OsString . PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)" + ,"#endif" + ,"tests :: [(String, Property)]" + ,"tests ="] ++ + [" " ++ c ++ "(" ++ show t1 ++ ", " ++ t2 ++ ")" | (c,(t1,t2)) <- zip ("[":repeat ",") tests] ++ + [" ]"] + + + +data PW = P -- legacy posix + | W -- legacy windows + | AFP_P -- abstract-filepath posix + | AFP_W -- abstract-filepath windows + deriving Show + +data Test = Test + {testPlatform :: PW + ,testVars :: [(String,String)] -- generator constructor, variable + ,testBody :: [String] + } + + +parseTest :: String -> [Test] +parseTest (stripPrefix "-- > " -> Just x) = platform $ toLexemes x + where + platform ("Windows":":":x) = [valid W x, valid AFP_W x] + platform ("Posix" :":":x) = [valid P x, valid AFP_P x] + platform x = [valid P x, valid W x, valid AFP_P x, valid AFP_W x] + + valid p ("Valid":x) = free p a $ drop 1 b + where (a,b) = break (== "=>") x + valid p x = free p [] x + + free p val x = Test p [(ctor v, v) | v <- vars] x + where vars = nub $ sort [v | v@[c] <- x, isAlpha c] + ctor v | v < "x" = "" + | v `elem` val = "QFilePathValid" ++ show p + | otherwise = case p of + AFP_P -> if v == "z" then "QFilePathsAFP_P" else "QFilePathAFP_P" + AFP_W -> if v == "z" then "QFilePathsAFP_W" else "QFilePathAFP_W" + _ -> if v == "z" then "" else "QFilePath" +parseTest _ = [] + + +toLexemes :: String -> [String] +toLexemes x = case lex x of + [("","")] -> [] + [(x,y)] -> x : toLexemes y + y -> error $ "Generate.toLexemes, " ++ show x ++ " -> " ++ show y + + +fromLexemes :: [String] -> String +fromLexemes = unwords . f + where + f ("`":x:"`":xs) = ("`" ++ x ++ "`") : f xs + f (x:y:xs) | x `elem` ["[","("] || y `elem` [",",")","]"] = f $ (x ++ y) : xs + f (x:xs) = x : f xs + f [] = [] + + +renderTest :: Test -> (String, String) +renderTest Test{..} = (body, code) + where + code = "property $ " ++ if null testVars then body else "\\" ++ unwords vars ++ " -> " ++ body + vars = [if null ctor then v else "(" ++ ctor ++ " " ++ v ++ ")" | (ctor,v) <- testVars] + + body = fromLexemes $ map (qualify testPlatform) testBody + + + +qualify :: PW -> String -> String +qualify pw str + | str `elem` fpops || (all isAlpha str && length str > 1 && str `notElem` prelude) + = if str `elem` bs then qualifyBS str else show pw ++ "." ++ str + | otherwise = encode str + where + bs = ["null", "concat", "isPrefixOf", "isSuffixOf", "any"] + prelude = ["elem","uncurry","snd","fst","not","if","then","else" + ,"True","False","Just","Nothing","fromJust","foldr"] + fpops = ["","<.>","-<.>"] +#ifdef GHC_MAKE + encode v + | isString' v = case pw of + AFP_P -> "(encodeUtf8 " <> v <> ")" + AFP_W -> "(encodeUtf16LE " <> v <> ")" + _ -> v + | isChar' v = case pw of + AFP_P -> "(fromIntegral . C.ord $ " <> v <> ")" + AFP_W -> "(fromIntegral . C.ord $ " <> v <> ")" + _ -> v + | otherwise = v + isString' xs@('"':_:_) = last xs == '"' + isString' _ = False + isChar' xs@('\'':_:_) = last xs == '\'' + isChar' _ = False + qualifyBS v = case pw of + AFP_P -> "SBS." <> v + AFP_W -> "SBS16." <> v + _ -> v +#else + encode v + | isString' v = case pw of + AFP_P -> "(" <> v <> ")" + AFP_W -> "(" <> v <> ")" + _ -> v + | isChar' v = case pw of + AFP_P -> "(PW . fromIntegral . C.ord $ " <> v <> ")" + AFP_W -> "(WW . fromIntegral . C.ord $ " <> v <> ")" + _ -> v + | otherwise = v + isString' xs@('"':_:_) = last xs == '"' + isString' _ = False + isChar' xs@('\'':_:_) = last xs == '\'' + isChar' _ = False + qualifyBS v = case pw of + AFP_P + | v == "concat" -> "(PS . SBS." <> v <> " . fmap getPosixString)" + | v == "any" -> "(\\f (getPosixString -> x) -> SBS." <> v <> " (f . PW) x)" + | v == "isPrefixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)" + | v == "isSuffixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)" + | otherwise -> "(SBS." <> v <> " . getPosixString)" + AFP_W + | v == "concat" -> "(WS . SBS16." <> v <> " . fmap getWindowsString)" + | v == "any" -> "(\\f (getWindowsString -> x) -> SBS16." <> v <> " (f . WW) x)" + | v == "isPrefixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)" + | v == "isSuffixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)" + | otherwise -> "(SBS16." <> v <> " . getWindowsString)" + _ -> v +#endif + + + +--------------------------------------------------------------------- +-- UTILITIES + +writeFileBinary :: FilePath -> String -> IO () +writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x + +readFileBinary' :: FilePath -> IO String +readFileBinary' file = withBinaryFile file ReadMode $ \h -> do + s <- hGetContents h + evaluate $ length s + pure s + +writeFileBinaryChanged :: FilePath -> String -> IO () +writeFileBinaryChanged file x = do + b <- doesFileExist file + old <- if b then fmap Just $ readFileBinary' file else pure Nothing + when (Just x /= old) $ + writeFileBinary file x diff --git a/HACKING.md b/HACKING.md --- a/HACKING.md +++ b/HACKING.md @@ -13,9 +13,7 @@ * 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. -The tests can be generated by `make gen` in the root of the repo, and will be placed in `tests/TestGen.hs`. +The tests can be generated by `make gen` in the root of the repo, and will be placed in `tests/filepath-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/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,10 +1,7 @@ -all: cpp gen - -cpp: - cpphs --noline -DIS_WINDOWS=False -DMODULE_NAME=Posix -OSystem/FilePath/Posix.hs System/FilePath/Internal.hs - cpphs --noline -DIS_WINDOWS=True -DMODULE_NAME=Windows -OSystem/FilePath/Windows.hs System/FilePath/Internal.hs +all: gen gen: runhaskell Generate.hs -.PHONY: all cpp gen + +.PHONY: all gen diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,32 +1,41 @@ # FilePath [![Hackage version](https://img.shields.io/hackage/v/filepath.svg?label=Hackage)](https://hackage.haskell.org/package/filepath) The `filepath` package provides functionality for manipulating `FilePath` values, and is shipped with [GHC](https://www.haskell.org/ghc/). -It provides three modules: +It provides two variants for filepaths: -* [`System.FilePath.Posix`](http://hackage.haskell.org/package/filepath/docs/System-FilePath-Posix.html) - manipulates POSIX/Linux style `FilePath` values (with `/` as the path separator). -* [`System.FilePath.Windows`](http://hackage.haskell.org/package/filepath/docs/System-FilePath-Windows.html) - manipulates Windows style `FilePath` values (with either `\` or `/` as the path separator, and deals with drives). -* [`System.FilePath`](http://hackage.haskell.org/package/filepath/docs/System-FilePath.html) - is an alias for the module appropriate to your platform. +1. legacy filepaths: `type FilePath = String` +2. operating system abstracted filepaths (`OsPath`): internally unpinned `ShortByteString` (platform-dependent encoding) +It is recommended to use `OsPath` when possible, because it is more correct. + +For each variant there are three main modules: + +* `System.FilePath.Posix` / `System.OsPath.Posix` manipulates POSIX\/Linux style `FilePath` values (with `/` as the path separator). +* `System.FilePath.Windows` / `System.OsPath.Windows` manipulates Windows style `FilePath` values (with either `\` or `/` as the path separator, and deals with drives). +* `System.FilePath` / `System.OsPath` for dealing with current platform-specific filepaths + All three modules provide the same API, and the same documentation (calling out differences in the different variants). +`System.OsString` is like `System.OsPath`, but more general purpose. Refer to the documentation of +those modules for more information. + ### What is a `FilePath`? -In Haskell, the definition is `type FilePath = String` as of now. A Haskell `String` is a list of Unicode code points. +In Haskell, the legacy definition (used in `base` and Prelude) is `type FilePath = String`, +where a Haskell `String` is a list of Unicode code points. +The new definition is (simplified) `newtype OsPath = AFP ShortByteString`, where +`ShortByteString` is an unpinned byte array and follows syscall conventions, preserving the encoding. + On unix, filenames don't have a predefined encoding as per the [POSIX specification](https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_170) and are passed as `char[]` to syscalls. -On windows (at least the API used by `Win32`) filepaths are UTF-16 strings. +On windows (at least the API used by `Win32`) filepaths are UTF-16LE strings. -This means that Haskell filepaths have to be converted to C-strings on unix -(utilizing the current filesystem encoding) and to UTF-16 strings -on windows. +You are encouraged to use `OsPath` whenever possible, because it is more correct. -Further, this is a low-level library and it makes no attempt at providing a more +Also note that this is a low-level library and it makes no attempt at providing a more type safe variant for filepaths (e.g. by distinguishing between absolute and relative paths) and ensures no invariants (such as filepath validity). diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -1,7 +1,6 @@ -#if __GLASGOW_HASKELL__ >= 704 -{-# LANGUAGE Safe #-} -#endif {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MultiWayIf #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows @@ -61,16 +60,25 @@ -- -- References: -- [1] (Microsoft MSDN) +#ifndef OS_PATH module System.FilePath.MODULE_NAME +#else +module System.OsPath.MODULE_NAME.Internal +#endif ( -- * Separator predicates +#ifndef OS_PATH FilePath, +#endif pathSeparator, pathSeparators, isPathSeparator, searchPathSeparator, isSearchPathSeparator, extSeparator, isExtSeparator, -- * @$PATH@ methods - splitSearchPath, getSearchPath, + splitSearchPath, +#ifndef OS_PATH + getSearchPath, +#endif -- * Extension functions splitExtension, @@ -103,11 +111,50 @@ ) where -import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) -import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) +{- HLINT ignore "Use fewer imports" -} +import Prelude (Char, Bool(..), Maybe(..), (.), (&&), (<=), not, fst, maybe, (||), (==), ($), otherwise, fmap, mempty, (>=), (/=), (++), snd) +import Data.Bifunctor (first) +import Data.Semigroup ((<>)) +import qualified Prelude as P +import Data.Maybe(fromMaybe, isJust) +import qualified Data.List as L +#ifndef OS_PATH +import Data.String (fromString) import System.Environment(getEnv) +import Prelude (String, map, FilePath, Eq, IO, id, last, init, reverse, dropWhile, null, break, take, all, elem, any, span) +import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) +import Data.List(stripPrefix, isSuffixOf, uncons, dropWhileEnd) +#define CHAR Char +#define STRING String +#define FILEPATH FilePath +#else +import Prelude (fromIntegral, return, IO, Either(..)) +import Control.Exception ( catch, displayException, evaluate, fromException, toException, throwIO, Exception, SomeAsyncException(..), SomeException ) +import Control.DeepSeq (force) +import System.IO.Unsafe (unsafePerformIO) +import qualified Data.Char as C +#ifdef WINDOWS +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import qualified GHC.Foreign as GHC +import Data.Word ( Word16 ) +import System.OsString.Data.ByteString.Short.Word16 +import System.OsString.Data.ByteString.Short ( packCStringLen ) +#define CHAR Word16 +#define STRING ShortByteString +#define FILEPATH ShortByteString +#else +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import qualified GHC.Foreign as GHC +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import Data.Word ( Word8 ) +import System.OsString.Data.ByteString.Short +#define CHAR Word8 +#define STRING ShortByteString +#define FILEPATH ShortByteString +#endif +#endif infixr 7 <.>, -<.> @@ -138,51 +185,52 @@ -- > Windows: pathSeparator == '\\' -- > Posix: pathSeparator == '/' -- > isPathSeparator pathSeparator -pathSeparator :: Char -pathSeparator = if isWindows then '\\' else '/' +pathSeparator :: CHAR +pathSeparator = if isWindows then _backslash else _slash -- | The list of all possible separators. -- -- > Windows: pathSeparators == ['\\', '/'] -- > Posix: pathSeparators == ['/'] -- > pathSeparator `elem` pathSeparators -pathSeparators :: [Char] -pathSeparators = if isWindows then "\\/" else "/" +pathSeparators :: [CHAR] +pathSeparators = if isWindows then [_backslash, _slash] else [_slash] -- | Rather than using @(== 'pathSeparator')@, use this. Test if something -- is a path separator. -- -- > isPathSeparator a == (a `elem` pathSeparators) -isPathSeparator :: Char -> Bool -isPathSeparator '/' = True -isPathSeparator '\\' = isWindows -isPathSeparator _ = False +isPathSeparator :: CHAR -> Bool +isPathSeparator c + | c == _slash = True + | c == _backslash = isWindows + | otherwise = False -- | The character that is used to separate the entries in the $PATH environment variable. -- -- > Windows: searchPathSeparator == ';' -- > Posix: searchPathSeparator == ':' -searchPathSeparator :: Char -searchPathSeparator = if isWindows then ';' else ':' +searchPathSeparator :: CHAR +searchPathSeparator = if isWindows then _semicolon else _colon -- | Is the character a file separator? -- -- > isSearchPathSeparator a == (a == searchPathSeparator) -isSearchPathSeparator :: Char -> Bool +isSearchPathSeparator :: CHAR -> Bool isSearchPathSeparator = (== searchPathSeparator) -- | File extension character -- -- > extSeparator == '.' -extSeparator :: Char -extSeparator = '.' +extSeparator :: CHAR +extSeparator = _period -- | Is the character an extension character? -- -- > isExtSeparator a == (a == extSeparator) -isExtSeparator :: Char -> Bool +isExtSeparator :: CHAR -> Bool isExtSeparator = (== extSeparator) @@ -201,21 +249,31 @@ -- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] -- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] -- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"] -splitSearchPath :: String -> [FilePath] +splitSearchPath :: STRING -> [FILEPATH] splitSearchPath = f where - f xs = case break isSearchPathSeparator xs of - (pre, [] ) -> g pre - (pre, _:post) -> g pre ++ f post + f xs = let (pre, post) = break isSearchPathSeparator xs + in case uncons post of + Nothing -> g pre + Just (_, t) -> g pre ++ f t - g "" = ["." | isPosix] - g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x] - g x = [x] + g x = case uncons x of + Nothing -> [singleton _period | isPosix] + Just (h, t) + | h == _quotedbl + , (Just _) <- uncons t -- >= 2 + , isWindows + , (Just (i, l)) <- unsnoc t + , l == _quotedbl -> [i] + | otherwise -> [x] --- | Get a list of 'FilePath's in the $PATH variable. -getSearchPath :: IO [FilePath] +-- TODO for AFPP +#ifndef OS_PATH +-- | Get a list of 'FILEPATH's in the $PATH variable. +getSearchPath :: IO [FILEPATH] getSearchPath = fmap splitSearchPath (getEnv "PATH") +#endif --------------------------------------------------------------------- @@ -224,7 +282,7 @@ -- | Split on the extension. 'addExtension' is the inverse. -- -- > splitExtension "/directory/path.ext" == ("/directory/path",".ext") --- > uncurry (++) (splitExtension x) == x +-- > uncurry (<>) (splitExtension x) == x -- > Valid x => uncurry addExtension (splitExtension x) == x -- > splitExtension "file.txt" == ("file",".txt") -- > splitExtension "file" == ("file","") @@ -233,21 +291,32 @@ -- > 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 :: FilePath -> (String, String) -splitExtension x = case nameDot of - "" -> (x,"") - _ -> (dir ++ init nameDot, extSeparator : ext) - where - (dir,file) = splitFileName_ x - (nameDot,ext) = breakEnd isExtSeparator file +-- A naive implementation would be to use @splitFileName_@ first, +-- then break filename into basename and extension, then recombine dir and basename. +-- This is way too expensive, see @splitFileName_@ comment for discussion. +-- +-- Instead we speculatively split on the extension separator first, then check +-- whether results are well-formed. +splitExtension :: FILEPATH -> (STRING, STRING) +splitExtension x + -- Imagine x = "no-dots", then nameDot = "" + | null nameDot = (x, mempty) + -- Imagine x = "\\shared.with.dots\no-dots" + | isWindows && null (dropDrive nameDot) = (x, mempty) + -- Imagine x = "dir.with.dots/no-dots" + | any isPathSeparator ext = (x, mempty) + | otherwise = (init nameDot, extSeparator `cons` ext) + where + (nameDot, ext) = breakEnd isExtSeparator x + -- | 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 :: FilePath -> String +takeExtension :: FILEPATH -> STRING takeExtension = snd . splitExtension -- | Remove the current extension and add another, equivalent to 'replaceExtension'. @@ -255,7 +324,7 @@ -- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext" -- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext" -- > "foo.o" -<.> "c" == "foo.c" -(-<.>) :: FilePath -> String -> FilePath +(-<.>) :: FILEPATH -> STRING -> FILEPATH (-<.>) = replaceExtension -- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'. @@ -268,21 +337,21 @@ -- > replaceExtension "file.txt" "" == "file" -- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt" -- > replaceExtension x y == addExtension (dropExtension x) y -replaceExtension :: FilePath -> String -> FilePath +replaceExtension :: FILEPATH -> STRING -> FILEPATH 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" -(<.>) :: FilePath -> String -> FilePath +(<.>) :: FILEPATH -> STRING -> FILEPATH (<.>) = addExtension -- | Remove last extension, and the \".\" preceding it. -- -- > dropExtension "/directory/path.ext" == "/directory/path" -- > dropExtension x == fst (splitExtension x) -dropExtension :: FilePath -> FilePath +dropExtension :: FILEPATH -> FILEPATH dropExtension = fst . splitExtension -- | Add an extension, even if there is already one there, equivalent to '<.>'. @@ -295,12 +364,13 @@ -- > addExtension x "" == x -- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext" -- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt" -addExtension :: FilePath -> String -> FilePath -addExtension file "" = file -addExtension file xs@(x:_) = joinDrive a res +addExtension :: FILEPATH -> STRING -> FILEPATH +addExtension file xs = case uncons xs of + Nothing -> file + Just (x, _) -> joinDrive a res where - res = if isExtSeparator x then b ++ xs - else b ++ [extSeparator] ++ xs + res = if isExtSeparator x then b <> xs + else b <> (extSeparator `cons` xs) (a,b) = splitDrive file @@ -309,7 +379,7 @@ -- > hasExtension "/directory/path.ext" == True -- > hasExtension "/directory/path" == False -- > null (takeExtension x) == not (hasExtension x) -hasExtension :: FilePath -> Bool +hasExtension :: FILEPATH -> Bool hasExtension = any isExtSeparator . takeFileName @@ -321,12 +391,14 @@ -- > "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 :: String -> FilePath -> Bool -isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions -isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions +isExtensionOf :: STRING -> FILEPATH -> Bool +isExtensionOf ext = \fp -> case uncons ext of + Just (x, _) + | x == _period -> isSuffixOf ext . takeExtensions $ fp + _ -> isSuffixOf (_period `cons` ext) . takeExtensions $ fp --- | Drop the given extension from a FilePath, and the @\".\"@ preceding it. --- Returns 'Nothing' if the FilePath does not have the given extension, or +-- | 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 @@ -341,21 +413,21 @@ -- > stripExtension "baz" "foo.bar" == Nothing -- > stripExtension "bar" "foobar" == Nothing -- > stripExtension "" x == Just x -stripExtension :: String -> FilePath -> Maybe FilePath -stripExtension [] path = Just path -stripExtension ext@(x:_) path = stripSuffix dotExt path - where dotExt = if isExtSeparator x then ext else '.':ext +stripExtension :: STRING -> FILEPATH -> Maybe FILEPATH +stripExtension ext path = case uncons ext of + Just (x, _) -> let dotExt = if isExtSeparator x then ext else _period `cons` ext + in stripSuffix dotExt path + Nothing -> Just path -- | Split on all extensions. -- -- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext") -- > splitExtensions "file.tar.gz" == ("file",".tar.gz") --- > uncurry (++) (splitExtensions x) == x +-- > uncurry (<>) (splitExtensions x) == x -- > Valid x => uncurry addExtension (splitExtensions x) == x --- > splitExtensions "file.tar.gz" == ("file",".tar.gz") -splitExtensions :: FilePath -> (FilePath, String) -splitExtensions x = (a ++ c, d) +splitExtensions :: FILEPATH -> (FILEPATH, STRING) +splitExtensions x = (a <> c, d) where (a,b) = splitFileName_ x (c,d) = break isExtSeparator b @@ -366,14 +438,14 @@ -- > dropExtensions "file.tar.gz" == "file" -- > not $ hasExtension $ dropExtensions x -- > not $ any isExtSeparator $ takeFileName $ dropExtensions x -dropExtensions :: FilePath -> FilePath +dropExtensions :: FILEPATH -> FILEPATH dropExtensions = fst . splitExtensions -- | Get all extensions. -- -- > takeExtensions "/directory/path.ext" == ".ext" -- > takeExtensions "file.tar.gz" == ".tar.gz" -takeExtensions :: FilePath -> String +takeExtensions :: FILEPATH -> STRING takeExtensions = snd . splitExtensions @@ -384,7 +456,7 @@ -- -- > replaceExtensions "file.fred.bob" "txt" == "file.txt" -- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz" -replaceExtensions :: FilePath -> String -> FilePath +replaceExtensions :: FILEPATH -> STRING -> FILEPATH replaceExtensions x y = dropExtensions x <.> y @@ -394,14 +466,14 @@ -- | Is the given character a valid drive letter? -- only a-z and A-Z are letters, not isAlpha which is more unicodey -isLetter :: Char -> Bool +isLetter :: CHAR -> Bool isLetter x = isAsciiLower x || isAsciiUpper x -- | Split a path into a drive and a path. -- On Posix, \/ is a Drive. -- --- > uncurry (++) (splitDrive x) == x +-- > uncurry (<>) (splitDrive x) == x -- > Windows: splitDrive "file" == ("","file") -- > Windows: splitDrive "c:/file" == ("c:/","file") -- > Windows: splitDrive "c:\\file" == ("c:\\","file") @@ -415,47 +487,56 @@ -- > Posix: splitDrive "//test" == ("//","test") -- > Posix: splitDrive "test/file" == ("","test/file") -- > Posix: splitDrive "file" == ("","file") -splitDrive :: FilePath -> (FilePath, FilePath) -splitDrive x | isPosix = span (== '/') x +splitDrive :: FILEPATH -> (FILEPATH, FILEPATH) +splitDrive x | isPosix = span (== _slash) x splitDrive x | Just y <- readDriveLetter x = y splitDrive x | Just y <- readDriveUNC x = y splitDrive x | Just y <- readDriveShare x = y -splitDrive x = ("",x) +splitDrive x = (mempty, x) -addSlash :: FilePath -> FilePath -> (FilePath, FilePath) -addSlash a xs = (a++c,d) - where (c,d) = span isPathSeparator xs +addSlash :: FILEPATH -> FILEPATH -> (FILEPATH, FILEPATH) +addSlash a xs = (a <> c, d) + where (c, d) = span isPathSeparator xs -- See [1]. -- "\\?\D:\" or "\\?\UNC\\" -readDriveUNC :: FilePath -> Maybe (FilePath, FilePath) -readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] = - case map toUpper xs of - ('U':'N':'C':s4:_) | isPathSeparator s4 -> - let (a,b) = readDriveShareName (drop 4 xs) - in Just (s1:s2:'?':s3:take 4 xs ++ a, b) - _ -> case readDriveLetter xs of - -- Extended-length path. - Just (a,b) -> Just (s1:s2:'?':s3:a,b) - Nothing -> Nothing -readDriveUNC _ = Nothing +readDriveUNC :: FILEPATH -> Maybe (FILEPATH, FILEPATH) +readDriveUNC bs = case unpack bs of + (s1:s2:q:s3:xs) + | q == _question && L.all isPathSeparator [s1,s2,s3] -> + case L.map toUpper xs of + (u:n:c:s4:_) + | u == _U && n == _N && c == _C && isPathSeparator s4 -> + let (a,b) = readDriveShareName (pack (L.drop 4 xs)) + in Just (pack (s1:s2:_question:s3:L.take 4 xs) <> a, b) + _ -> case readDriveLetter (pack xs) of + -- Extended-length path. + Just (a,b) -> Just (pack [s1,s2,_question,s3] <> a, b) + Nothing -> Nothing + _ -> Nothing {- c:\ -} -readDriveLetter :: String -> Maybe (FilePath, FilePath) -readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs) -readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs) -readDriveLetter _ = Nothing +readDriveLetter :: STRING -> Maybe (FILEPATH, FILEPATH) +readDriveLetter bs = case uncons2 bs of + Nothing -> Nothing + Just (x, c, ys) + | isLetter x, c == _colon -> Just $ case uncons ys of + Just (y, _) + | isPathSeparator y -> addSlash (pack [x,_colon]) ys + _ -> (pack [x,_colon], ys) + | otherwise -> Nothing {- \\sharename\ -} -readDriveShare :: String -> Maybe (FilePath, FilePath) -readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 = - Just (s1:s2:a,b) - where (a,b) = readDriveShareName xs -readDriveShare _ = Nothing +readDriveShare :: STRING -> Maybe (FILEPATH, FILEPATH) +readDriveShare bs = case unpack bs of + (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 -> + let (a, b) = readDriveShareName (pack xs) + in Just (s1 `cons` (s2 `cons` a), b) + _ -> Nothing {- assume you have already seen \\ -} {- share\bob -> "share\", "bob" -} -readDriveShareName :: String -> (FilePath, FilePath) +readDriveShareName :: STRING -> (FILEPATH, FILEPATH) readDriveShareName name = addSlash a b where (a,b) = break isPathSeparator name @@ -468,19 +549,19 @@ -- > Windows: joinDrive "C:\\" "bar" == "C:\\bar" -- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo" -- > Windows: joinDrive "/:" "foo" == "/:\\foo" -joinDrive :: FilePath -> FilePath -> FilePath +joinDrive :: FILEPATH -> FILEPATH -> FILEPATH joinDrive = combineAlways -- | Get the drive from a filepath. -- -- > takeDrive x == fst (splitDrive x) -takeDrive :: FilePath -> FilePath +takeDrive :: FILEPATH -> FILEPATH takeDrive = fst . splitDrive -- | Delete the drive, if it exists. -- -- > dropDrive x == snd (splitDrive x) -dropDrive :: FilePath -> FilePath +dropDrive :: FILEPATH -> FILEPATH dropDrive = snd . splitDrive -- | Does a path have a drive. @@ -491,7 +572,7 @@ -- > Windows: hasDrive "C:foo" == True -- > hasDrive "foo" == False -- > hasDrive "" == False -hasDrive :: FilePath -> Bool +hasDrive :: FILEPATH -> Bool hasDrive = not . null . takeDrive @@ -502,7 +583,7 @@ -- > Windows: isDrive "C:\\" == True -- > Windows: isDrive "C:\\foo" == False -- > isDrive "" == False -isDrive :: FilePath -> Bool +isDrive :: FILEPATH -> Bool isDrive x = not (null x) && null (dropDrive x) @@ -520,28 +601,93 @@ -- > splitFileName "bob" == ("./", "bob") -- > Posix: splitFileName "/" == ("/","") -- > Windows: splitFileName "c:" == ("c:","") -splitFileName :: FilePath -> (String, String) -splitFileName x = (if null dir then "./" else dir, name) - where - (dir, name) = splitFileName_ x +-- > Windows: splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\","fred") +-- > Windows: splitFileName "\\\\?\\A:" == ("\\\\?\\A:","") +splitFileName :: FILEPATH -> (STRING, STRING) +splitFileName x = if null path + then (dotSlash, file) + else (path, file) + where + (path, file) = splitFileName_ x + dotSlash = _period `cons` singleton _slash --- version of splitFileName where, if the FilePath has no directory +-- 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 +-- directory to make a valid FILEPATH, and having a "./" appear would -- look strange and upset simple equality properties. See -- e.g. replaceFileName. -splitFileName_ :: FilePath -> (String, String) -splitFileName_ x = (drv ++ dir, file) - where - (drv,pth) = splitDrive x - (dir,file) = breakEnd isPathSeparator pth +-- +-- A naive implementation is +-- +-- splitFileName_ fp = (drv <> dir, file) +-- where +-- (drv, pth) = splitDrive fp +-- (dir, file) = breakEnd isPathSeparator pth +-- +-- but it is undesirable for two reasons: +-- * splitDrive is very slow on Windows, +-- * we unconditionally allocate 5 FilePath objects where only 2 would normally suffice. +-- +-- In the implementation below we first speculatively split the input by the last path +-- separator. In the vast majority of cases this is already the answer, except +-- two exceptional cases explained below. +-- +splitFileName_ :: FILEPATH -> (STRING, STRING) +splitFileName_ fp + -- If dirSlash is empty, @fp@ is either a genuine filename without any dir, + -- or just a Windows drive name without slash like "c:". + -- Run readDriveLetter to figure out. + | isWindows + , null dirSlash + = fromMaybe (mempty, fp) (readDriveLetter fp) + -- Another Windows quirk is that @fp@ could have been a shared drive "\\share" + -- or UNC location "\\?\UNC\foo", where path separator is a part of the drive name. + -- We can test this by trying dropDrive and falling back to splitDrive. + | isWindows + = case uncons2 dirSlash of + Just (s1, s2, bs') + | isPathSeparator s1 + -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator, + -- so we are in the middle of shared drive. + -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path. + , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash) + -> (fp, mempty) + -- This handles inputs like "//?/A:" and "//?/A:foo" + | isPathSeparator s1 + , isPathSeparator s2 + , Just (s3, s4, bs'') <- uncons2 bs' + , s3 == _question + , isPathSeparator s4 + , null bs'' + , Just (drive, rest) <- readDriveLetter file + -> (dirSlash <> drive, rest) + _ -> (dirSlash, file) + | otherwise + = (dirSlash, file) + where + (dirSlash, file) = breakEnd isPathSeparator fp + dropExcessTrailingPathSeparators x + | hasTrailingPathSeparator x + , let x' = dropWhileEnd isPathSeparator x + , otherwise = if | null x' -> singleton (last x) + | otherwise -> addTrailingPathSeparator x' + | otherwise = x + -- an "incomplete" UNC is one without a path (but potentially a drive) + isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref) + + -- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@ + hasPenultimateColon pref + | hasTrailingPathSeparator pref + = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref + | otherwise = False + -- | Set the filename. -- -- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" -- > Valid x => replaceFileName x (takeFileName x) == x -replaceFileName :: FilePath -> String -> FilePath +replaceFileName :: FILEPATH -> STRING -> FILEPATH replaceFileName x y = a y where (a,_) = splitFileName_ x -- | Drop the filename. Unlike 'takeDirectory', this function will leave @@ -549,7 +695,8 @@ -- -- > dropFileName "/directory/file.ext" == "/directory/" -- > dropFileName x == fst (splitFileName x) -dropFileName :: FilePath -> FilePath +-- > isPrefixOf (takeDrive x) (dropFileName x) +dropFileName :: FILEPATH -> FILEPATH dropFileName = fst . splitFileName @@ -557,12 +704,12 @@ -- -- > takeFileName "/directory/file.ext" == "file.ext" -- > takeFileName "test/" == "" --- > takeFileName x `isSuffixOf` x +-- > isSuffixOf (takeFileName x) 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 :: FilePath -> FilePath +takeFileName :: FILEPATH -> FILEPATH takeFileName = snd . splitFileName -- | Get the base name, without an extension or path. @@ -574,7 +721,7 @@ -- > takeBaseName "test" == "test" -- > takeBaseName (addTrailingPathSeparator x) == "" -- > takeBaseName "file/file.tar.gz" == "file.tar" -takeBaseName :: FilePath -> String +takeBaseName :: FILEPATH -> STRING takeBaseName = dropExtension . takeFileName -- | Set the base name. @@ -584,7 +731,7 @@ -- > replaceBaseName "fred" "bill" == "bill" -- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar" -- > Valid x => replaceBaseName x (takeBaseName x) == x -replaceBaseName :: FilePath -> String -> FilePath +replaceBaseName :: FILEPATH -> STRING -> FILEPATH replaceBaseName pth nam = combineAlways a (nam <.> ext) where (a,b) = splitFileName_ pth @@ -594,14 +741,14 @@ -- -- > hasTrailingPathSeparator "test" == False -- > hasTrailingPathSeparator "test/" == True -hasTrailingPathSeparator :: FilePath -> Bool -hasTrailingPathSeparator "" = False -hasTrailingPathSeparator x = isPathSeparator (last x) +hasTrailingPathSeparator :: FILEPATH -> Bool +hasTrailingPathSeparator x + | null x = False + | otherwise = isPathSeparator $ last x -hasLeadingPathSeparator :: FilePath -> Bool -hasLeadingPathSeparator "" = False -hasLeadingPathSeparator x = isPathSeparator (head x) +hasLeadingPathSeparator :: FILEPATH -> Bool +hasLeadingPathSeparator = maybe False (isPathSeparator . fst) . uncons -- | Add a trailing file path separator if one is not already present. @@ -609,8 +756,8 @@ -- > hasTrailingPathSeparator (addTrailingPathSeparator x) -- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x -- > Posix: addTrailingPathSeparator "test/rest" == "test/rest/" -addTrailingPathSeparator :: FilePath -> FilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator] +addTrailingPathSeparator :: FILEPATH -> FILEPATH +addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x <> singleton pathSeparator -- | Remove any trailing path separators @@ -619,18 +766,18 @@ -- > dropTrailingPathSeparator "/" == "/" -- > Windows: dropTrailingPathSeparator "\\" == "\\" -- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x -dropTrailingPathSeparator :: FilePath -> FilePath +dropTrailingPathSeparator :: FILEPATH -> FILEPATH dropTrailingPathSeparator x = if hasTrailingPathSeparator x && not (isDrive x) then let x' = dropWhileEnd isPathSeparator x - in if null x' then [last x] else x' + in if null x' then singleton (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 == "." +-- > isPrefixOf (takeDirectory x) x || takeDirectory x == "." -- > takeDirectory "foo" == "." -- > takeDirectory "/" == "/" -- > takeDirectory "/foo" == "/" @@ -640,30 +787,32 @@ -- > Windows: takeDirectory "foo\\bar" == "foo" -- > Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar" -- > Windows: takeDirectory "C:\\" == "C:\\" -takeDirectory :: FilePath -> FilePath +takeDirectory :: FILEPATH -> FILEPATH takeDirectory = dropTrailingPathSeparator . dropFileName -- | Set the directory, keeping the filename the same. -- -- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" -- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x -replaceDirectory :: FilePath -> String -> FilePath +replaceDirectory :: FILEPATH -> STRING -> FILEPATH replaceDirectory x dir = combineAlways dir (takeFileName x) -- | An alias for ''. -combine :: FilePath -> FilePath -> FilePath +combine :: FILEPATH -> FILEPATH -> FILEPATH combine a b | hasLeadingPathSeparator b || hasDrive b = b | otherwise = combineAlways a b -- | Combine two paths, assuming rhs is NOT absolute. -combineAlways :: FilePath -> FilePath -> FilePath +combineAlways :: FILEPATH -> FILEPATH -> FILEPATH combineAlways a b | null a = b | null b = a - | hasTrailingPathSeparator a = a ++ b - | otherwise = case a of - [a1,':'] | isWindows && isLetter a1 -> a ++ b - _ -> a ++ [pathSeparator] ++ b + | hasTrailingPathSeparator a = a <> b + | otherwise = case unpack a of + [a1, a2] | isWindows + , isLetter a1 + , a2 == _colon -> a <> b + _ -> a <> (pathSeparator `cons` b) -- | Combine two paths with a path separator. @@ -707,7 +856,7 @@ -- -- > Windows: "D:\\foo" "C:bar" == "C:bar" -- > Windows: "C:\\foo" "C:bar" == "C:bar" -() :: FilePath -> FilePath -> FilePath +() :: FILEPATH -> FILEPATH -> FILEPATH () = combine @@ -720,13 +869,14 @@ -- > splitPath "" == [] -- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"] -- > Posix: splitPath "/file/test" == ["/","file/","test"] -splitPath :: FilePath -> [FilePath] -splitPath x = [drive | drive /= ""] ++ f path +splitPath :: FILEPATH -> [FILEPATH] +splitPath x = [drive | not (null drive)] ++ f path where - (drive,path) = splitDrive x + (drive, path) = splitDrive x - f "" = [] - f y = (a++c) : f d + f y + | null y = [] + | otherwise = (a <> c) : f d where (a,b) = break isPathSeparator y (c,d) = span isPathSeparator b @@ -741,20 +891,20 @@ -- > splitDirectories "" == [] -- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] -- > splitDirectories "/test///file" == ["/","test","file"] -splitDirectories :: FilePath -> [FilePath] -splitDirectories = map dropTrailingPathSeparator . splitPath +splitDirectories :: FILEPATH -> [FILEPATH] +splitDirectories = L.map dropTrailingPathSeparator . splitPath -- | Join path elements back together. -- --- > joinPath a == foldr () "" a +-- > joinPath z == foldr () "" z -- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" -- > Valid x => joinPath (splitPath x) == x -- > joinPath [] == "" -- > Posix: joinPath ["test","file","path"] == "test/file/path" -joinPath :: [FilePath] -> FilePath +joinPath :: [FILEPATH] -> FILEPATH -- Note that this definition on c:\\c:\\, join then split will give c:\\. -joinPath = foldr combine "" +joinPath = P.foldr combine mempty @@ -764,7 +914,7 @@ --------------------------------------------------------------------- -- File name manipulators --- | Equality of two 'FilePath's. +-- | 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. @@ -779,7 +929,7 @@ -- > Posix: not (equalFilePath "foo" "FOO") -- > Windows: equalFilePath "foo" "FOO" -- > Windows: not (equalFilePath "C:" "C:/") -equalFilePath :: FilePath -> FilePath -> Bool +equalFilePath :: FILEPATH -> FILEPATH -> Bool equalFilePath a b = f a == f b where f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x @@ -810,26 +960,36 @@ -- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" -- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" -- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c" -makeRelative :: FilePath -> FilePath -> FilePath +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 + | equalFilePath root path = singleton _period + | takeAbs root /= takeAbs path = path + | otherwise = f (dropAbs root) (dropAbs path) + where + f x y + | null x = dropWhile isPathSeparator y + | otherwise = 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 + -- on windows, need to drop '/' which is kind of absolute, but not a drive + dropAbs x + | Just (hd, tl) <- uncons x + , isPathSeparator hd + , not (hasDrive x) + = tl + | otherwise + = dropDrive x - takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator] - takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x + takeAbs x + | Just (hd, _) <- uncons x + , isPathSeparator hd + , not (hasDrive x) + = singleton pathSeparator + | otherwise + = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x -- | Normalise a file -- @@ -849,6 +1009,7 @@ -- > Posix: normalise "./bob/fred/" == "bob/fred/" -- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" -- > Windows: normalise "c:\\" == "C:\\" +-- > Windows: normalise "c:\\\\\\\\" == "C:\\" -- > Windows: normalise "C:.\\" == "C:" -- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" -- > Windows: normalise "//server/test" == "\\\\server\\test" @@ -863,53 +1024,74 @@ -- > Posix: normalise "/" == "/" -- > Posix: normalise "bob/fred/." == "bob/fred/" -- > Posix: normalise "//home" == "/home" -normalise :: FilePath -> FilePath -normalise path = result ++ [pathSeparator | addPathSeparator] - where - (drv,pth) = splitDrive path - result = joinDrive' (normaliseDrive drv) (f pth) +normalise :: FILEPATH -> FILEPATH +normalise filepath = + result <> + (if addPathSeparator + then singleton pathSeparator + else mempty) + where + (drv,pth) = splitDrive filepath - joinDrive' "" "" = "." - joinDrive' d p = joinDrive d p + result = joinDrive' (normaliseDrive drv) (f pth) - addPathSeparator = isDirPath pth - && not (hasTrailingPathSeparator result) - && not (isRelativeDrive drv) + joinDrive' d p + = if null d && null p + then singleton _period + else joinDrive d p - isDirPath xs = hasTrailingPathSeparator xs - || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs) + addPathSeparator = isDirPath pth + && not (hasTrailingPathSeparator result) + && not (isRelativeDrive drv) - f = joinPath . dropDots . propSep . splitDirectories + isDirPath xs = hasTrailingPathSeparator xs + || not (null xs) && last xs == _period + && hasTrailingPathSeparator (init xs) - propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs - | otherwise = x : xs - propSep [] = [] + f = joinPath . dropDots . propSep . splitDirectories - dropDots = filter ("." /=) + propSep (x:xs) + | all isPathSeparator x = singleton pathSeparator : xs + | otherwise = x : xs + propSep [] = [] -normaliseDrive :: FilePath -> FilePath -normaliseDrive "" = "" -normaliseDrive _ | isPosix = [pathSeparator] -normaliseDrive drive = if isJust $ readDriveLetter x2 - then map toUpper x2 - else x2 - where - x2 = map repSlash drive + dropDots = L.filter (singleton _period /=) +normaliseDrive :: FILEPATH -> FILEPATH +normaliseDrive bs + | null bs = mempty + | isPosix = pack [pathSeparator] + | Just (drv, _) <- readDriveLetter x2 + = case unpack drv of + (x:_:[]) -> pack [toUpper x, _colon] + (x:_) -> pack [toUpper x, _colon, pathSeparator] + _ -> P.error "impossible" + | otherwise = x2 + where + x2 = map repSlash bs repSlash x = if isPathSeparator x then pathSeparator else x -- Information for validity functions on Windows. See [1]. -isBadCharacter :: Char -> Bool -isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\"" +isBadCHARacter :: CHAR -> Bool +isBadCHARacter x = x >= _nul && x <= _US + || x `L.elem` + [ _less + , _greater + , _colon + , _quotedbl + , _bar + , _question + , _asterisk + ] -badElements :: [FilePath] -badElements = +badElements :: [FILEPATH] +badElements = fmap fromString ["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 FilePath valid, i.e. could you create a file like it? This function checks for invalid names, +-- | Is a FILEPATH 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. -- @@ -929,21 +1111,22 @@ -- > Windows: isValid "foo\tbar" == False -- > Windows: isValid "nul .txt" == False -- > Windows: isValid " nul.txt" == True -isValid :: FilePath -> Bool -isValid "" = False -isValid x | '\0' `elem` x = False -isValid _ | isPosix = True -isValid path = - not (any isBadCharacter x2) && - not (any f $ splitDirectories x2) && - not (isJust (readDriveShare x1) && all isPathSeparator x1) && - not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) +isValid :: FILEPATH -> Bool +isValid path + | null path = False + | _nul `elem` path = False + | isPosix = True + | otherwise = + not (any isBadCHARacter x2) && + not (L.any f $ splitDirectories x2) && + not (isJust (readDriveShare x1) && all isPathSeparator x1) && + not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) where - (x1,x2) = splitDrive path - f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements + (x1,x2) = splitDrive path + f x = map toUpper (dropWhileEnd (== _space) $ dropExtensions x) `L.elem` badElements --- | Take a FilePath and make it valid; does not change already valid FilePaths. +-- | Take a FILEPATH and make it valid; does not change already valid FILEPATHs. -- -- > isValid (makeValid x) -- > isValid x ==> makeValid x == x @@ -959,27 +1142,28 @@ -- > Windows: makeValid "\\\\\\foo" == "\\\\drive" -- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" -- > Windows: makeValid "nul .txt" == "nul _.txt" -makeValid :: FilePath -> FilePath -makeValid "" = "_" +makeValid :: FILEPATH -> FILEPATH 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 + | null path = singleton _underscore + | isPosix = map (\x -> if x == _nul then _underscore else x) path + | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv <> fromString "drive" + | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) = + makeValid (drv <> (pathSeparator `cons` pth)) + | otherwise = joinDrive drv $ validElements $ validCHARs pth - validChars = map f - f x = if isBadCharacter x then '_' else x + where + (drv,pth) = splitDrive path - 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 + validCHARs = map f + f x = if isBadCHARacter x then _underscore else x + validElements = joinPath . fmap g . splitPath + g x = h a <> b + where (a,b) = break isPathSeparator x + h x = if map toUpper (dropWhileEnd (== _space) a) `L.elem` badElements then snoc a _underscore <.> b else x + where (a,b) = splitExtensions x + -- | Is a path relative, or is it fixed to the root? -- -- > Windows: isRelative "path\\test" == True @@ -1002,7 +1186,7 @@ -- * "A UNC name of any format [is never relative]." -- -- * "You cannot use the "\\?\" prefix with a relative path." -isRelative :: FilePath -> Bool +isRelative :: FILEPATH -> Bool isRelative x = null drive || isRelativeDrive drive where drive = takeDrive x @@ -1011,7 +1195,7 @@ -- 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 :: String -> Bool +isRelativeDrive :: STRING -> Bool isRelativeDrive x = maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x) @@ -1019,23 +1203,15 @@ -- | @not . 'isRelative'@ -- -- > isAbsolute x == not (isRelative x) -isAbsolute :: FilePath -> Bool +isAbsolute :: FILEPATH -> Bool isAbsolute = not . isRelative +#ifndef OS_PATH ----------------------------------------------------------------------------- --- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2]) --- Note that Data.List.dropWhileEnd is only available in base >= 4.5. -dropWhileEnd :: (a -> Bool) -> [a] -> [a] -dropWhileEnd p = reverse . dropWhile p . reverse - --- 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) +spanEnd p = L.foldr (\x (pref, suff) -> if null pref && p x then (pref, x : suff) else (x : pref, suff)) ([], []) -- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4]) breakEnd :: (a -> Bool) -> [a] -> ([a], [a]) @@ -1045,4 +1221,130 @@ -- 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) +stripSuffix xs ys = reverse P.<$> stripPrefix (reverse xs) (reverse ys) + +cons :: a -> [a] -> [a] +cons = (:) + +unsnoc :: [a] -> Maybe ([a], a) +unsnoc = L.foldr (\x -> Just . maybe ([], x) (first (x :))) Nothing + +uncons2 :: [a] -> Maybe (a, a, [a]) +uncons2 [] = Nothing +uncons2 [_] = Nothing +uncons2 (x : y : zs) = Just (x, y, zs) + +_period, _quotedbl, _backslash, _slash, _question, _U, _N, _C, _colon, _semicolon, _US, _less, _greater, _bar, _asterisk, _nul, _space, _underscore :: Char +_period = '.' +_quotedbl = '"' +_slash = '/' +_backslash = '\\' +_question = '?' +_colon = ':' +_semicolon = ';' +_U = 'U' +_N = 'N' +_C = 'C' +_US = '\US' +_less = '<' +_greater = '>' +_bar = '|' +_asterisk = '*' +_nul = '\NUL' +_space = ' ' +_underscore = '_' + +singleton :: Char -> String +singleton c = [c] + +pack :: String -> String +pack = id + + +unpack :: String -> String +unpack = id + + +snoc :: String -> Char -> String +{- HLINT ignore "Redundant lambda" -} +snoc str = \c -> str <> [c] + +#else +-- | Like 'try', but rethrows async exceptions. +trySafe :: Exception e => IO a -> IO (Either e a) +trySafe ioA = catch action eHandler + where + action = do + v <- ioA + return (Right v) + eHandler e + | isAsyncException e = throwIO e + | otherwise = return (Left e) + +isAsyncException :: Exception e => e -> Bool +isAsyncException e = + case fromException (toException e) of + Just (SomeAsyncException _) -> True + Nothing -> False +#ifdef WINDOWS +fromString :: P.String -> STRING +fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do + r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr + evaluate $ force $ first displayException r +#else +fromString :: P.String -> STRING +fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do + r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr + evaluate $ force $ first displayException r +#endif + +_a, _z, _A, _Z, _period, _quotedbl, _backslash, _slash, _question, _U, _N, _C, _colon, _semicolon, _US, _less, _greater, _bar, _asterisk, _nul, _space, _underscore :: CHAR +_a = 0x61 +_z = 0x7a +_A = 0x41 +_Z = 0x5a +_period = 0x2e +_quotedbl = 0x22 +_slash = 0x2f +_backslash = 0x5c +_question = 0x3f +_colon = 0x3a +_semicolon = 0x3b +_U = 0x55 +_N = 0x4e +_C = 0x43 +_US = 0x1f +_less = 0x3c +_greater = 0x3e +_bar = 0x7c +_asterisk = 0x2a +_nul = 0x00 +_space = 0x20 +_underscore = 0x5f + +isAsciiUpper :: CHAR -> Bool +isAsciiUpper w = _A <= w && w <= _Z + +isAsciiLower :: CHAR -> Bool +isAsciiLower w = _a <= w && w <= _z + +---------------------------------------------------------------- + +toUpper :: CHAR -> CHAR +-- charToWord16 should be safe here, since C.toUpper doesn't go beyond Word16 maxbound +toUpper = charToWord . C.toUpper . wordToChar + +toLower :: CHAR -> CHAR +-- charToWord16 should be safe here, since C.toLower doesn't go beyond Word16 maxbound +toLower = charToWord . C.toLower . wordToChar + + +-- | Total conversion to char. +wordToChar :: CHAR -> Char +wordToChar = C.chr . fromIntegral + +-- | This is unsafe and clamps at Word16 maxbound. +charToWord :: Char -> CHAR +charToWord = fromIntegral . C.ord + +#endif diff --git a/System/FilePath/Posix.hs b/System/FilePath/Posix.hs --- a/System/FilePath/Posix.hs +++ b/System/FilePath/Posix.hs @@ -1,1048 +1,7 @@ - - - -{-# LANGUAGE PatternGuards #-} - --- This template expects CPP definitions for: --- MODULE_NAME = Posix | Windows --- IS_WINDOWS = False | True - --- | --- Module : System.FilePath.MODULE_NAME --- Copyright : (c) Neil Mitchell 2005-2014 --- License : BSD3 --- --- Maintainer : ndmitchell@gmail.com --- Stability : stable --- Portability : portable --- --- A library for 'FilePath' manipulations, using MODULE_NAME style paths on --- all platforms. Importing "System.FilePath" is usually better. --- --- Given the example 'FilePath': @\/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:/ Download a file from @url@ and save it to disk: --- --- @do let file = 'makeValid' url --- System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@ --- --- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@: --- --- @'takeDirectory' file '' \"interface\" '' ('takeFileName' file '-<.>' \"hi\")@ --- --- References: --- [1] (Microsoft MSDN) -module System.FilePath.Posix - ( - -- * Separator predicates - FilePath, - 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.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) -import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) - -import System.Environment(getEnv) - - -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 = False - - ---------------------------------------------------------------------- --- 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 == '\\' --- > Posix: pathSeparator == '/' --- > isPathSeparator pathSeparator -pathSeparator :: Char -pathSeparator = if isWindows then '\\' else '/' - --- | The list of all possible separators. --- --- > Windows: pathSeparators == ['\\', '/'] --- > Posix: pathSeparators == ['/'] --- > pathSeparator `elem` pathSeparators -pathSeparators :: [Char] -pathSeparators = if isWindows then "\\/" else "/" - --- | Rather than using @(== 'pathSeparator')@, use this. Test if something --- is a path separator. --- --- > isPathSeparator a == (a `elem` pathSeparators) -isPathSeparator :: Char -> Bool -isPathSeparator '/' = True -isPathSeparator '\\' = isWindows -isPathSeparator _ = False - - --- | The character that is used to separate the entries in the $PATH environment variable. --- --- > Windows: searchPathSeparator == ';' --- > Posix: searchPathSeparator == ':' -searchPathSeparator :: Char -searchPathSeparator = if isWindows then ';' else ':' - --- | Is the character a file separator? --- --- > isSearchPathSeparator a == (a == searchPathSeparator) -isSearchPathSeparator :: Char -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - --- | File extension character --- --- > extSeparator == '.' -extSeparator :: Char -extSeparator = '.' - --- | Is the character an extension character? --- --- > isExtSeparator a == (a == extSeparator) -isExtSeparator :: Char -> 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 --- --- --- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] --- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] --- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] --- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] --- > 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 :: FilePath -> (String, String) -splitExtension x = case nameDot of - "" -> (x,"") - _ -> (dir ++ init nameDot, extSeparator : ext) - where - (dir,file) = splitFileName_ x - (nameDot,ext) = 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 :: FilePath -> String -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" -(-<.>) :: FilePath -> String -> FilePath -(-<.>) = 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 :: FilePath -> String -> FilePath -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" -(<.>) :: FilePath -> String -> FilePath -(<.>) = addExtension - --- | Remove last extension, and the \".\" preceding it. --- --- > dropExtension "/directory/path.ext" == "/directory/path" --- > dropExtension x == fst (splitExtension x) -dropExtension :: FilePath -> FilePath -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 :: FilePath -> String -> FilePath -addExtension file "" = file -addExtension file xs@(x:_) = joinDrive a res - where - res = if isExtSeparator x then b ++ xs - else b ++ [extSeparator] ++ xs - - (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 :: FilePath -> Bool -hasExtension = 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 :: String -> FilePath -> Bool -isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions -isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions - --- | 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 :: String -> FilePath -> Maybe FilePath -stripExtension [] path = Just path -stripExtension ext@(x:_) path = stripSuffix dotExt path - where dotExt = if isExtSeparator x then ext else '.':ext - - --- | 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 :: FilePath -> (FilePath, String) -splitExtensions x = (a ++ c, d) - where - (a,b) = splitFileName_ x - (c,d) = 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 :: FilePath -> FilePath -dropExtensions = fst . splitExtensions - --- | Get all extensions. --- --- > takeExtensions "/directory/path.ext" == ".ext" --- > takeExtensions "file.tar.gz" == ".tar.gz" -takeExtensions :: FilePath -> String -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 :: FilePath -> String -> FilePath -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 :: Char -> Bool -isLetter x = isAsciiLower x || isAsciiUpper 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 :: FilePath -> (FilePath, FilePath) -splitDrive x | isPosix = span (== '/') x -splitDrive x | Just y <- readDriveLetter x = y -splitDrive x | Just y <- readDriveUNC x = y -splitDrive x | Just y <- readDriveShare x = y -splitDrive x = ("",x) - -addSlash :: FilePath -> FilePath -> (FilePath, FilePath) -addSlash a xs = (a++c,d) - where (c,d) = span isPathSeparator xs - --- See [1]. --- "\\?\D:\" or "\\?\UNC\\" -readDriveUNC :: FilePath -> Maybe (FilePath, FilePath) -readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] = - case map toUpper xs of - ('U':'N':'C':s4:_) | isPathSeparator s4 -> - let (a,b) = readDriveShareName (drop 4 xs) - in Just (s1:s2:'?':s3:take 4 xs ++ a, b) - _ -> case readDriveLetter xs of - -- Extended-length path. - Just (a,b) -> Just (s1:s2:'?':s3:a,b) - Nothing -> Nothing -readDriveUNC _ = Nothing - -{- c:\ -} -readDriveLetter :: String -> Maybe (FilePath, FilePath) -readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs) -readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs) -readDriveLetter _ = Nothing - -{- \\sharename\ -} -readDriveShare :: String -> Maybe (FilePath, FilePath) -readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 = - Just (s1:s2:a,b) - where (a,b) = readDriveShareName xs -readDriveShare _ = Nothing - -{- assume you have already seen \\ -} -{- share\bob -> "share\", "bob" -} -readDriveShareName :: String -> (FilePath, FilePath) -readDriveShareName name = addSlash a b - where (a,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 :: FilePath -> FilePath -> FilePath -joinDrive = combineAlways - --- | Get the drive from a filepath. --- --- > takeDrive x == fst (splitDrive x) -takeDrive :: FilePath -> FilePath -takeDrive = fst . splitDrive - --- | Delete the drive, if it exists. --- --- > dropDrive x == snd (splitDrive x) -dropDrive :: FilePath -> FilePath -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 :: FilePath -> Bool -hasDrive = not . 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 :: FilePath -> Bool -isDrive x = not (null x) && 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 :: FilePath -> (String, String) -splitFileName x = (if 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_ :: FilePath -> (String, String) -splitFileName_ x = (drv ++ dir, file) - where - (drv,pth) = splitDrive x - (dir,file) = breakEnd isPathSeparator pth - --- | Set the filename. --- --- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" --- > Valid x => replaceFileName x (takeFileName x) == x -replaceFileName :: FilePath -> String -> FilePath -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 :: FilePath -> FilePath -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 :: FilePath -> FilePath -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 :: FilePath -> String -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 :: FilePath -> String -> FilePath -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 :: FilePath -> Bool -hasTrailingPathSeparator "" = False -hasTrailingPathSeparator x = isPathSeparator (last x) - - -hasLeadingPathSeparator :: FilePath -> Bool -hasLeadingPathSeparator "" = False -hasLeadingPathSeparator x = isPathSeparator (head x) - - --- | 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 :: FilePath -> FilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator] - - --- | Remove any trailing path separators --- --- > dropTrailingPathSeparator "file/test/" == "file/test" --- > dropTrailingPathSeparator "/" == "/" --- > Windows: dropTrailingPathSeparator "\\" == "\\" --- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x -dropTrailingPathSeparator :: FilePath -> FilePath -dropTrailingPathSeparator x = - if hasTrailingPathSeparator x && not (isDrive x) - then let x' = dropWhileEnd isPathSeparator x - in if null x' then [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 :: FilePath -> FilePath -takeDirectory = dropTrailingPathSeparator . dropFileName - --- | Set the directory, keeping the filename the same. --- --- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" --- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x -replaceDirectory :: FilePath -> String -> FilePath -replaceDirectory x dir = combineAlways dir (takeFileName x) - - --- | An alias for ''. -combine :: FilePath -> FilePath -> FilePath -combine a b | hasLeadingPathSeparator b || hasDrive b = b - | otherwise = combineAlways a b - --- | Combine two paths, assuming rhs is NOT absolute. -combineAlways :: FilePath -> FilePath -> FilePath -combineAlways a b | null a = b - | null b = a - | hasTrailingPathSeparator a = a ++ b - | otherwise = case a of - [a1,':'] | isWindows && isLetter a1 -> a ++ b - _ -> a ++ [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" --- > 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" -() :: FilePath -> FilePath -> FilePath -() = combine - - --- | Split a path by the directory separator. --- --- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] --- > concat (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 :: FilePath -> [FilePath] -splitPath x = [drive | drive /= ""] ++ f path - where - (drive,path) = splitDrive x - - f "" = [] - f y = (a++c) : f d - where - (a,b) = break isPathSeparator y - (c,d) = 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"] --- > Valid x => joinPath (splitDirectories x) `equalFilePath` x --- > splitDirectories "" == [] --- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] --- > splitDirectories "/test///file" == ["/","test","file"] -splitDirectories :: FilePath -> [FilePath] -splitDirectories = map dropTrailingPathSeparator . splitPath - - --- | Join path elements back together. --- --- > joinPath a == foldr () "" a --- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" --- > Valid x => joinPath (splitPath x) == x --- > joinPath [] == "" --- > Posix: joinPath ["test","file","path"] == "test/file/path" -joinPath :: [FilePath] -> FilePath --- Note that this definition on c:\\c:\\, join then split will give c:\\. -joinPath = foldr combine "" - - - - - - ---------------------------------------------------------------------- --- 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. --- --- Similar to 'normalise', this does not expand @".."@, because of symlinks. --- --- > x == y ==> equalFilePath x y --- > normalise x == normalise y ==> equalFilePath x y --- > equalFilePath "foo" "foo/" --- > not (equalFilePath "/a/../c" "/c") --- > not (equalFilePath "foo" "/foo") --- > Posix: not (equalFilePath "foo" "FOO") --- > Windows: equalFilePath "foo" "FOO" --- > 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@. --- --- > makeRelative "/directory" "/directory/file.ext" == "file.ext" --- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x --- > makeRelative x x == "." --- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x --- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" --- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" --- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" --- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" --- > Windows: makeRelative "/Home" "/home/bob" == "bob" --- > Windows: makeRelative "/" "//" == "//" --- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob" --- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" --- > Posix: makeRelative "/fred" "bob" == "bob" --- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" --- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" --- > 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' --- --- * .\/ -> \"\" --- --- Does not remove @".."@, because of symlinks. --- --- > Posix: normalise "/file/\\test////" == "/file/\\test/" --- > Posix: normalise "/file/./test" == "/file/test" --- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" --- > Posix: normalise "../bob/fred/" == "../bob/fred/" --- > Posix: normalise "/a/../c" == "/a/../c" --- > Posix: normalise "./bob/fred/" == "bob/fred/" --- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" --- > Windows: normalise "c:\\" == "C:\\" --- > Windows: normalise "C:.\\" == "C:" --- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" --- > Windows: normalise "//server/test" == "\\\\server\\test" --- > Windows: normalise "c:/file" == "C:\\file" --- > Windows: normalise "/file" == "\\file" --- > Windows: normalise "\\" == "\\" --- > Windows: normalise "/./" == "\\" --- > normalise "." == "." --- > Posix: normalise "./" == "./" --- > Posix: normalise "./." == "./" --- > Posix: normalise "/./" == "/" --- > Posix: normalise "/" == "/" --- > Posix: normalise "bob/fred/." == "bob/fred/" --- > Posix: normalise "//home" == "/home" -normalise :: 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 :: Char -> Bool -isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\"" - -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 FilePath 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 == not (null x) --- > 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 :: FilePath -> Bool -isValid "" = False -isValid x | '\0' `elem` x = False -isValid _ | isPosix = True -isValid path = - not (any isBadCharacter x2) && - not (any f $ splitDirectories x2) && - not (isJust (readDriveShare x1) && all isPathSeparator x1) && - not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) - where - (x1,x2) = splitDrive path - f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements - - --- | Take a FilePath and make it valid; does not change already valid FilePaths. --- --- > isValid (makeValid x) --- > isValid x ==> makeValid x == x --- > makeValid "" == "_" --- > makeValid "file\0name" == "file_name" --- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" --- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" --- > Windows: makeValid "test*" == "test_" --- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" --- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" --- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" --- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" --- > Windows: makeValid "\\\\\\foo" == "\\\\drive" --- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" --- > 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 :: FilePath -> Bool -isRelative x = 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 :: String -> Bool -isRelativeDrive x = - maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x) - - --- | @not . 'isRelative'@ --- --- > isAbsolute x == not (isRelative x) -isAbsolute :: FilePath -> Bool -isAbsolute = not . isRelative - - ------------------------------------------------------------------------------ --- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2]) --- Note that Data.List.dropWhileEnd is only available in base >= 4.5. -dropWhileEnd :: (a -> Bool) -> [a] -> [a] -dropWhileEnd p = reverse . dropWhile p . reverse - --- 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) +{-# LANGUAGE CPP #-} + +#undef WINDOWS +#define IS_WINDOWS False +#define MODULE_NAME Posix + +#include "Internal.hs" diff --git a/System/FilePath/Windows.hs b/System/FilePath/Windows.hs --- a/System/FilePath/Windows.hs +++ b/System/FilePath/Windows.hs @@ -1,1048 +1,8 @@ - - - -{-# LANGUAGE PatternGuards #-} - --- This template expects CPP definitions for: --- MODULE_NAME = Posix | Windows --- IS_WINDOWS = False | True - --- | --- Module : System.FilePath.MODULE_NAME --- Copyright : (c) Neil Mitchell 2005-2014 --- License : BSD3 --- --- Maintainer : ndmitchell@gmail.com --- Stability : stable --- Portability : portable --- --- A library for 'FilePath' manipulations, using MODULE_NAME style paths on --- all platforms. Importing "System.FilePath" is usually better. --- --- Given the example 'FilePath': @\/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:/ Download a file from @url@ and save it to disk: --- --- @do let file = 'makeValid' url --- System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@ --- --- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@: --- --- @'takeDirectory' file '' \"interface\" '' ('takeFileName' file '-<.>' \"hi\")@ --- --- References: --- [1] (Microsoft MSDN) -module System.FilePath.Windows - ( - -- * Separator predicates - FilePath, - 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.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) -import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) - -import System.Environment(getEnv) - - -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 = True - - ---------------------------------------------------------------------- --- 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 == '\\' --- > Posix: pathSeparator == '/' --- > isPathSeparator pathSeparator -pathSeparator :: Char -pathSeparator = if isWindows then '\\' else '/' - --- | The list of all possible separators. --- --- > Windows: pathSeparators == ['\\', '/'] --- > Posix: pathSeparators == ['/'] --- > pathSeparator `elem` pathSeparators -pathSeparators :: [Char] -pathSeparators = if isWindows then "\\/" else "/" - --- | Rather than using @(== 'pathSeparator')@, use this. Test if something --- is a path separator. --- --- > isPathSeparator a == (a `elem` pathSeparators) -isPathSeparator :: Char -> Bool -isPathSeparator '/' = True -isPathSeparator '\\' = isWindows -isPathSeparator _ = False - - --- | The character that is used to separate the entries in the $PATH environment variable. --- --- > Windows: searchPathSeparator == ';' --- > Posix: searchPathSeparator == ':' -searchPathSeparator :: Char -searchPathSeparator = if isWindows then ';' else ':' - --- | Is the character a file separator? --- --- > isSearchPathSeparator a == (a == searchPathSeparator) -isSearchPathSeparator :: Char -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - --- | File extension character --- --- > extSeparator == '.' -extSeparator :: Char -extSeparator = '.' - --- | Is the character an extension character? --- --- > isExtSeparator a == (a == extSeparator) -isExtSeparator :: Char -> 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 --- --- --- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] --- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] --- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] --- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] --- > 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 :: FilePath -> (String, String) -splitExtension x = case nameDot of - "" -> (x,"") - _ -> (dir ++ init nameDot, extSeparator : ext) - where - (dir,file) = splitFileName_ x - (nameDot,ext) = 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 :: FilePath -> String -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" -(-<.>) :: FilePath -> String -> FilePath -(-<.>) = 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 :: FilePath -> String -> FilePath -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" -(<.>) :: FilePath -> String -> FilePath -(<.>) = addExtension - --- | Remove last extension, and the \".\" preceding it. --- --- > dropExtension "/directory/path.ext" == "/directory/path" --- > dropExtension x == fst (splitExtension x) -dropExtension :: FilePath -> FilePath -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 :: FilePath -> String -> FilePath -addExtension file "" = file -addExtension file xs@(x:_) = joinDrive a res - where - res = if isExtSeparator x then b ++ xs - else b ++ [extSeparator] ++ xs - - (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 :: FilePath -> Bool -hasExtension = 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 :: String -> FilePath -> Bool -isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions -isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions - --- | 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 :: String -> FilePath -> Maybe FilePath -stripExtension [] path = Just path -stripExtension ext@(x:_) path = stripSuffix dotExt path - where dotExt = if isExtSeparator x then ext else '.':ext - - --- | 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 :: FilePath -> (FilePath, String) -splitExtensions x = (a ++ c, d) - where - (a,b) = splitFileName_ x - (c,d) = 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 :: FilePath -> FilePath -dropExtensions = fst . splitExtensions - --- | Get all extensions. --- --- > takeExtensions "/directory/path.ext" == ".ext" --- > takeExtensions "file.tar.gz" == ".tar.gz" -takeExtensions :: FilePath -> String -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 :: FilePath -> String -> FilePath -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 :: Char -> Bool -isLetter x = isAsciiLower x || isAsciiUpper 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 :: FilePath -> (FilePath, FilePath) -splitDrive x | isPosix = span (== '/') x -splitDrive x | Just y <- readDriveLetter x = y -splitDrive x | Just y <- readDriveUNC x = y -splitDrive x | Just y <- readDriveShare x = y -splitDrive x = ("",x) - -addSlash :: FilePath -> FilePath -> (FilePath, FilePath) -addSlash a xs = (a++c,d) - where (c,d) = span isPathSeparator xs - --- See [1]. --- "\\?\D:\" or "\\?\UNC\\" -readDriveUNC :: FilePath -> Maybe (FilePath, FilePath) -readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] = - case map toUpper xs of - ('U':'N':'C':s4:_) | isPathSeparator s4 -> - let (a,b) = readDriveShareName (drop 4 xs) - in Just (s1:s2:'?':s3:take 4 xs ++ a, b) - _ -> case readDriveLetter xs of - -- Extended-length path. - Just (a,b) -> Just (s1:s2:'?':s3:a,b) - Nothing -> Nothing -readDriveUNC _ = Nothing - -{- c:\ -} -readDriveLetter :: String -> Maybe (FilePath, FilePath) -readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs) -readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs) -readDriveLetter _ = Nothing - -{- \\sharename\ -} -readDriveShare :: String -> Maybe (FilePath, FilePath) -readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 = - Just (s1:s2:a,b) - where (a,b) = readDriveShareName xs -readDriveShare _ = Nothing - -{- assume you have already seen \\ -} -{- share\bob -> "share\", "bob" -} -readDriveShareName :: String -> (FilePath, FilePath) -readDriveShareName name = addSlash a b - where (a,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 :: FilePath -> FilePath -> FilePath -joinDrive = combineAlways - --- | Get the drive from a filepath. --- --- > takeDrive x == fst (splitDrive x) -takeDrive :: FilePath -> FilePath -takeDrive = fst . splitDrive - --- | Delete the drive, if it exists. --- --- > dropDrive x == snd (splitDrive x) -dropDrive :: FilePath -> FilePath -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 :: FilePath -> Bool -hasDrive = not . 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 :: FilePath -> Bool -isDrive x = not (null x) && 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 :: FilePath -> (String, String) -splitFileName x = (if 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_ :: FilePath -> (String, String) -splitFileName_ x = (drv ++ dir, file) - where - (drv,pth) = splitDrive x - (dir,file) = breakEnd isPathSeparator pth - --- | Set the filename. --- --- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" --- > Valid x => replaceFileName x (takeFileName x) == x -replaceFileName :: FilePath -> String -> FilePath -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 :: FilePath -> FilePath -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 :: FilePath -> FilePath -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 :: FilePath -> String -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 :: FilePath -> String -> FilePath -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 :: FilePath -> Bool -hasTrailingPathSeparator "" = False -hasTrailingPathSeparator x = isPathSeparator (last x) - - -hasLeadingPathSeparator :: FilePath -> Bool -hasLeadingPathSeparator "" = False -hasLeadingPathSeparator x = isPathSeparator (head x) - - --- | 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 :: FilePath -> FilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator] - - --- | Remove any trailing path separators --- --- > dropTrailingPathSeparator "file/test/" == "file/test" --- > dropTrailingPathSeparator "/" == "/" --- > Windows: dropTrailingPathSeparator "\\" == "\\" --- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x -dropTrailingPathSeparator :: FilePath -> FilePath -dropTrailingPathSeparator x = - if hasTrailingPathSeparator x && not (isDrive x) - then let x' = dropWhileEnd isPathSeparator x - in if null x' then [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 :: FilePath -> FilePath -takeDirectory = dropTrailingPathSeparator . dropFileName - --- | Set the directory, keeping the filename the same. --- --- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" --- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x -replaceDirectory :: FilePath -> String -> FilePath -replaceDirectory x dir = combineAlways dir (takeFileName x) - - --- | An alias for ''. -combine :: FilePath -> FilePath -> FilePath -combine a b | hasLeadingPathSeparator b || hasDrive b = b - | otherwise = combineAlways a b - --- | Combine two paths, assuming rhs is NOT absolute. -combineAlways :: FilePath -> FilePath -> FilePath -combineAlways a b | null a = b - | null b = a - | hasTrailingPathSeparator a = a ++ b - | otherwise = case a of - [a1,':'] | isWindows && isLetter a1 -> a ++ b - _ -> a ++ [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" --- > 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" -() :: FilePath -> FilePath -> FilePath -() = combine - - --- | Split a path by the directory separator. --- --- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] --- > concat (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 :: FilePath -> [FilePath] -splitPath x = [drive | drive /= ""] ++ f path - where - (drive,path) = splitDrive x - - f "" = [] - f y = (a++c) : f d - where - (a,b) = break isPathSeparator y - (c,d) = 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"] --- > Valid x => joinPath (splitDirectories x) `equalFilePath` x --- > splitDirectories "" == [] --- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] --- > splitDirectories "/test///file" == ["/","test","file"] -splitDirectories :: FilePath -> [FilePath] -splitDirectories = map dropTrailingPathSeparator . splitPath - - --- | Join path elements back together. --- --- > joinPath a == foldr () "" a --- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" --- > Valid x => joinPath (splitPath x) == x --- > joinPath [] == "" --- > Posix: joinPath ["test","file","path"] == "test/file/path" -joinPath :: [FilePath] -> FilePath --- Note that this definition on c:\\c:\\, join then split will give c:\\. -joinPath = foldr combine "" - - - - - - ---------------------------------------------------------------------- --- 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. --- --- Similar to 'normalise', this does not expand @".."@, because of symlinks. --- --- > x == y ==> equalFilePath x y --- > normalise x == normalise y ==> equalFilePath x y --- > equalFilePath "foo" "foo/" --- > not (equalFilePath "/a/../c" "/c") --- > not (equalFilePath "foo" "/foo") --- > Posix: not (equalFilePath "foo" "FOO") --- > Windows: equalFilePath "foo" "FOO" --- > 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@. --- --- > makeRelative "/directory" "/directory/file.ext" == "file.ext" --- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x --- > makeRelative x x == "." --- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x --- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" --- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" --- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" --- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" --- > Windows: makeRelative "/Home" "/home/bob" == "bob" --- > Windows: makeRelative "/" "//" == "//" --- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob" --- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" --- > Posix: makeRelative "/fred" "bob" == "bob" --- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" --- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" --- > 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' --- --- * .\/ -> \"\" --- --- Does not remove @".."@, because of symlinks. --- --- > Posix: normalise "/file/\\test////" == "/file/\\test/" --- > Posix: normalise "/file/./test" == "/file/test" --- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" --- > Posix: normalise "../bob/fred/" == "../bob/fred/" --- > Posix: normalise "/a/../c" == "/a/../c" --- > Posix: normalise "./bob/fred/" == "bob/fred/" --- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" --- > Windows: normalise "c:\\" == "C:\\" --- > Windows: normalise "C:.\\" == "C:" --- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" --- > Windows: normalise "//server/test" == "\\\\server\\test" --- > Windows: normalise "c:/file" == "C:\\file" --- > Windows: normalise "/file" == "\\file" --- > Windows: normalise "\\" == "\\" --- > Windows: normalise "/./" == "\\" --- > normalise "." == "." --- > Posix: normalise "./" == "./" --- > Posix: normalise "./." == "./" --- > Posix: normalise "/./" == "/" --- > Posix: normalise "/" == "/" --- > Posix: normalise "bob/fred/." == "bob/fred/" --- > Posix: normalise "//home" == "/home" -normalise :: 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 :: Char -> Bool -isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\"" - -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 FilePath 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 == not (null x) --- > 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 :: FilePath -> Bool -isValid "" = False -isValid x | '\0' `elem` x = False -isValid _ | isPosix = True -isValid path = - not (any isBadCharacter x2) && - not (any f $ splitDirectories x2) && - not (isJust (readDriveShare x1) && all isPathSeparator x1) && - not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) - where - (x1,x2) = splitDrive path - f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements - - --- | Take a FilePath and make it valid; does not change already valid FilePaths. --- --- > isValid (makeValid x) --- > isValid x ==> makeValid x == x --- > makeValid "" == "_" --- > makeValid "file\0name" == "file_name" --- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" --- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" --- > Windows: makeValid "test*" == "test_" --- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" --- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" --- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" --- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" --- > Windows: makeValid "\\\\\\foo" == "\\\\drive" --- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" --- > 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 :: FilePath -> Bool -isRelative x = 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 :: String -> Bool -isRelativeDrive x = - maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x) - - --- | @not . 'isRelative'@ --- --- > isAbsolute x == not (isRelative x) -isAbsolute :: FilePath -> Bool -isAbsolute = not . isRelative - - ------------------------------------------------------------------------------ --- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2]) --- Note that Data.List.dropWhileEnd is only available in base >= 4.5. -dropWhileEnd :: (a -> Bool) -> [a] -> [a] -dropWhileEnd p = reverse . dropWhile p . reverse - --- 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) +{-# LANGUAGE CPP #-} + +#undef POSIX +#define WINDOWS +#define IS_WINDOWS True +#define MODULE_NAME Windows + +#include "Internal.hs" diff --git a/System/OsPath.hs b/System/OsPath.hs new file mode 100644 --- /dev/null +++ b/System/OsPath.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE CPP #-} + +#define FILEPATH_NAME OsPath +#define OSSTRING_NAME OsString +#define WORD_NAME OsChar + +-- | +-- Module : System.OsPath +-- Copyright : © 2021 Julian Ospald +-- License : MIT +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- An implementation of the , +-- which aims to supersede @type FilePath = String@ for various reasons: +-- +-- 1. it is more efficient and avoids memory fragmentation (uses unpinned 'ShortByteString' under the hood) +-- 2. it is more type-safe (newtype over 'ShortByteString') +-- 3. avoids round-tripping issues by not converting to String (which is not total and loses the encoding) +-- 4. abstracts over unix and windows while keeping the original bytes +-- +-- It is important to know that filenames\/filepaths have different representations across platforms: +-- +-- - On /Windows/, filepaths are expected to be encoded as UTF16-LE , but +-- may also include invalid surrogate pairs, in which case UCS-2 can be used. They are passed as @wchar_t*@ to syscalls. +-- 'OsPath' only maintains the wide character invariant. +-- - On /Unix/, filepaths don't have a predefined encoding (although they +-- are often interpreted as UTF8) as per the +-- +-- and are passed as @char[]@ to syscalls. 'OsPath' maintains no invariant +-- here. +-- +-- Apart from encoding, filepaths have additional restrictions per platform: +-- +-- - On /Windows/ the may apply +-- - On /Unix/, only @NUL@ bytes are disallowed as per the +-- +-- Use 'isValid' to check for these restrictions ('OsPath' doesn't +-- maintain this invariant). +-- +-- Also note that these restrictions are +-- not exhaustive and further filesystem specific restrictions may apply on +-- all platforms. This library makes no attempt at satisfying these. +-- Library users may need to account for that, depending +-- on what filesystems they want to support. +-- +-- It is advised to follow these principles when dealing with filepaths\/filenames: +-- +-- 1. Avoid interpreting filenames that the OS returns, unless absolutely necessary. +-- For example, the filepath separator is usually a predefined 'Word8'/'Word16', regardless of encoding. +-- So even if we need to split filepaths, it might still not be necessary to understand the encoding +-- of the filename. +-- 2. When interpreting OS returned filenames consider that these might not be UTF8 on /unix/ +-- or at worst don't have an ASCII compatible encoding. The are 3 available strategies fer decoding/encoding: +-- a) pick the best UTF (UTF-8 on unix, UTF-16LE on windows), b) decode with an explicitly defined 'TextEncoding', +-- c) mimic the behavior of the @base@ library (permissive UTF16 on windows, current filesystem encoding on unix). +-- 3. Avoid comparing @String@ based filepaths, because filenames of different encodings +-- may have the same @String@ representation, although they're not the same byte-wise. + + +#include "OsPath/Common.hs" diff --git a/System/OsPath.hs-boot b/System/OsPath.hs-boot new file mode 100644 --- /dev/null +++ b/System/OsPath.hs-boot @@ -0,0 +1,6 @@ +module System.OsPath where + +import System.OsPath.Types + ( OsPath ) + +isValid :: OsPath -> Bool diff --git a/System/OsPath/Common.hs b/System/OsPath/Common.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Common.hs @@ -0,0 +1,1483 @@ +{-# LANGUAGE TypeApplications #-} +-- This template expects CPP definitions for: +-- +-- WINDOWS defined? = no | yes | no +-- POSIX defined? = yes | no | no +-- +-- FILEPATH_NAME = PosixPath | WindowsPath | OsPath +-- OSSTRING_NAME = PosixString | WindowsString | OsString +-- WORD_NAME = PosixChar | WindowsChar | OsChar + +-- For (native) abstract file paths we document both platforms, so people can +-- understand how their code is compiled no matter what. But for the +-- platform-specific types we only want to document the behavior on that +-- platform. +#if defined(WINDOWS) +#define WINDOWS_DOC +#elif defined(POSIX) +#define POSIX_DOC +#endif + +#ifdef WINDOWS +module System.OsPath.Windows +#elif defined(POSIX) +module System.OsPath.Posix +#else +module System.OsPath +#endif + ( + -- * Types +#ifdef WINDOWS + WindowsString + , WindowsChar + , WindowsPath +#elif defined(POSIX) + PosixString + , PosixChar + , PosixPath +#else + OsPath + , OsString + , OsChar +#endif + -- * Filepath construction + , PS.encodeUtf + , PS.unsafeEncodeUtf + , PS.encodeWith + , encodeFS +#if defined(WINDOWS) || defined(POSIX) + , pstr +#else + , osp +#endif + , PS.pack + + -- * Filepath deconstruction + , PS.decodeUtf + , PS.decodeWith + , decodeFS + , PS.unpack + + -- * Word construction + , unsafeFromChar + + -- * Word deconstruction + , toChar + + -- * Separator predicates + , pathSeparator + , pathSeparators + , isPathSeparator + , searchPathSeparator + , isSearchPathSeparator + , extSeparator + , isExtSeparator + + -- * $PATH methods + , splitSearchPath, + + -- * 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 + + +#ifdef WINDOWS +import System.OsPath.Types +import System.OsString.Windows as PS + ( unsafeFromChar + , toChar + , decodeUtf + , decodeWith + , pack + , encodeUtf + , unsafeEncodeUtf + , encodeWith + , unpack + ) +import Data.Bifunctor ( bimap ) +import qualified System.OsPath.Windows.Internal as C +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +#if __GLASGOW_HASKELL__ >= 914 +import Language.Haskell.TH.Lift + ( Lift(..), lift ) +import Language.Haskell.TH.QuasiQuoter + ( QuasiQuoter (..) ) +#else +import Language.Haskell.TH.Syntax + ( Lift(..), lift ) +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +#endif +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import Control.Monad ( when ) + +#elif defined(POSIX) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import Control.Monad ( when ) +#if __GLASGOW_HASKELL__ >= 914 +import Language.Haskell.TH.Lift + ( Lift(..), lift ) +import Language.Haskell.TH.QuasiQuoter + ( QuasiQuoter (..) ) +#else +import Language.Haskell.TH.Syntax + ( Lift(..), lift ) +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +#endif + +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import System.OsPath.Types +import System.OsString.Posix as PS + ( unsafeFromChar + , toChar + , decodeUtf + , decodeWith + , pack + , encodeUtf + , unsafeEncodeUtf + , encodeWith + , unpack + ) +import Data.Bifunctor ( bimap ) +import qualified System.OsPath.Posix.Internal as C + +#else + +import System.OsPath.Internal as PS + ( osp + , decodeUtf + , decodeWith + , pack + , encodeUtf + , unsafeEncodeUtf + , encodeWith + , unpack + ) +import System.OsPath.Types + ( OsPath ) +import System.OsString ( unsafeFromChar, toChar ) + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +import qualified System.OsPath.Windows as C +#else +import qualified System.OsPath.Posix as C +#endif + +import Data.Bifunctor + ( bimap ) +#endif +import System.OsString.Internal.Types +import System.OsString.Encoding.Internal + + +------------------------ +-- Separator predicates + + +#ifdef WINDOWS_DOC +-- | The character that separates directories. In the case where more than +-- one character is possible, 'pathSeparator' is the \'ideal\' one. +-- +-- > pathSeparator == '\\'S +#elif defined(POSIX_DOC) +-- | The character that separates directories. In the case where more than +-- one character is possible, 'pathSeparator' is the \'ideal\' one. +-- +-- > pathSeparator == '/' +#else +-- | The character that separates directories. In the case where more than +-- one character is possible, 'pathSeparator' is the \'ideal\' one. +-- +-- > Windows: pathSeparator == '\\'S +-- > Posix: pathSeparator == '/' +#endif +pathSeparator :: WORD_NAME +pathSeparator = WORD_NAME C.pathSeparator + +#ifdef WINDOWS_DOC +-- | The list of all possible separators. +-- +-- > pathSeparators == ['\\', '/'] +-- > pathSeparator `elem` pathSeparators +#elif defined(POSIX_DOC) +-- | The list of all possible separators. +-- +-- > pathSeparators == ['/'] +-- > pathSeparator `elem` pathSeparators +#else +-- | The list of all possible separators. +-- +-- > Windows: pathSeparators == ['\\', '/'] +-- > Posix: pathSeparators == ['/'] +-- > pathSeparator `elem` pathSeparators +#endif +pathSeparators :: [WORD_NAME] +pathSeparators = WORD_NAME <$> C.pathSeparators + +-- | Rather than using @(== 'pathSeparator')@, use this. Test if something +-- is a path separator. +-- +-- > isPathSeparator a == (a `elem` pathSeparators) +isPathSeparator :: WORD_NAME -> Bool +isPathSeparator (WORD_NAME w) = C.isPathSeparator w + +#ifdef WINDOWS_DOC +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > searchPathSeparator == ';' +#elif defined(POSIX_DOC) +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > searchPathSeparator == ':' +#else +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > Posix: searchPathSeparator == ':' +-- > Windows: searchPathSeparator == ';' +#endif +searchPathSeparator :: WORD_NAME +searchPathSeparator = WORD_NAME C.searchPathSeparator + +-- | Is the character a file separator? +-- +-- > isSearchPathSeparator a == (a == searchPathSeparator) +isSearchPathSeparator :: WORD_NAME -> Bool +isSearchPathSeparator (WORD_NAME w) = C.isSearchPathSeparator w + + +-- | File extension character +-- +-- > extSeparator == '.' +extSeparator :: WORD_NAME +extSeparator = WORD_NAME C.extSeparator + + +-- | Is the character an extension character? +-- +-- > isExtSeparator a == (a == extSeparator) +isExtSeparator :: WORD_NAME -> Bool +isExtSeparator (WORD_NAME w) = C.isExtSeparator w + + +--------------------------------------------------------------------- +-- Path methods (environment $PATH) + +#ifdef WINDOWS_DOC +-- | Take a string, split it on the 'searchPathSeparator' character. +-- +-- Blank items are ignored and path elements are stripped of quotes. +-- +-- > splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] +-- > splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] +-- > splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"] +#elif defined(POSIX_DOC) +-- | Take a string, split it on the 'searchPathSeparator' character. +-- +-- Blank items are converted to @.@ on , and quotes are not +-- treated specially. +-- +-- Follows the recommendations in +-- +-- +-- > splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] +-- > splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] +#else +-- | Take a string, split it on the 'searchPathSeparator' character. +-- +-- On Windows, blank items are ignored on Windows, and path elements are +-- stripped of quotes. +-- +-- On Posix, blank items are converted to @.@ on Posix, and quotes are not +-- treated specially. +-- +-- Follows the recommendations in +-- +-- +-- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] +-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] +-- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"] +-- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] +-- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] +#endif +splitSearchPath :: OSSTRING_NAME -> [FILEPATH_NAME] +splitSearchPath (OSSTRING_NAME x) = fmap OSSTRING_NAME . C.splitSearchPath $ x + + + +------------------------ +-- Extension functions + +-- | 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 :: FILEPATH_NAME -> (FILEPATH_NAME, OSSTRING_NAME) +splitExtension (OSSTRING_NAME x) = bimap OSSTRING_NAME OSSTRING_NAME $ C.splitExtension x + + +-- | 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 :: FILEPATH_NAME -> OSSTRING_NAME +takeExtension (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeExtension x + + +-- | 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" +(-<.>) :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +(-<.>) = 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 :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +replaceExtension (OSSTRING_NAME path) (OSSTRING_NAME ext) = OSSTRING_NAME (C.replaceExtension path ext) + + +-- | 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" +(<.>) :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +(<.>) = addExtension + +-- | Remove last extension, and the \".\" preceding it. +-- +-- > dropExtension "/directory/path.ext" == "/directory/path" +-- > dropExtension x == fst (splitExtension x) +dropExtension :: FILEPATH_NAME -> FILEPATH_NAME +dropExtension (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropExtension x + + +-- | 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" + +#ifdef WINDOWS_DOC +-- | 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" +-- > addExtension "\\\\share" ".txt" == "\\\\share\\.txt" +#elif defined(POSIX_DOC) +-- | 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" +#else +-- | 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" +#endif +addExtension :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +addExtension (OSSTRING_NAME bs) (OSSTRING_NAME ext) = OSSTRING_NAME $ C.addExtension bs ext + + +-- | Does the given filename have an extension? +-- +-- > hasExtension "/directory/path.ext" == True +-- > hasExtension "/directory/path" == False +-- > null (takeExtension x) == not (hasExtension x) +hasExtension :: FILEPATH_NAME -> Bool +hasExtension (OSSTRING_NAME x) = C.hasExtension x + +-- | 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 :: OSSTRING_NAME -> FILEPATH_NAME -> Bool +isExtensionOf (OSSTRING_NAME x) (OSSTRING_NAME y) = C.isExtensionOf x y + +-- | 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 :: OSSTRING_NAME -> FILEPATH_NAME -> Maybe FILEPATH_NAME +stripExtension (OSSTRING_NAME bs) (OSSTRING_NAME x) = OSSTRING_NAME <$> C.stripExtension bs x + +-- | 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 :: FILEPATH_NAME -> (FILEPATH_NAME, OSSTRING_NAME) +splitExtensions (OSSTRING_NAME x) = bimap OSSTRING_NAME OSSTRING_NAME $ C.splitExtensions x + + +-- | 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 :: FILEPATH_NAME -> FILEPATH_NAME +dropExtensions (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropExtensions x + + +-- | Get all extensions. +-- +-- > takeExtensions "/directory/path.ext" == ".ext" +-- > takeExtensions "file.tar.gz" == ".tar.gz" +takeExtensions :: FILEPATH_NAME -> OSSTRING_NAME +takeExtensions (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeExtensions x + +-- | 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 :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +replaceExtensions (OSSTRING_NAME x) (OSSTRING_NAME y) = OSSTRING_NAME $ C.replaceExtensions x y + + +------------------------ +-- Drive functions + + +#ifdef WINDOWS_DOC +-- | Split a path into a drive and a path. +-- +-- > uncurry (<>) (splitDrive x) == x +-- > splitDrive "file" == ("","file") +-- > splitDrive "c:/file" == ("c:/","file") +-- > splitDrive "c:\\file" == ("c:\\","file") +-- > splitDrive "\\\\shared\\test" == ("\\\\shared\\","test") +-- > splitDrive "\\\\shared" == ("\\\\shared","") +-- > splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file") +-- > splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file") +-- > splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file") +-- > splitDrive "/d" == ("","/d") +#elif defined(POSIX_DOC) +-- | Split a path into a drive and a path. +-- \/ is a Drive. +-- +-- > uncurry (<>) (splitDrive x) == x +-- > splitDrive "/test" == ("/","test") +-- > splitDrive "//test" == ("//","test") +-- > splitDrive "test/file" == ("","test/file") +-- > splitDrive "file" == ("","file") +#else +-- | 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") +#endif +splitDrive :: FILEPATH_NAME -> (FILEPATH_NAME, FILEPATH_NAME) +splitDrive (OSSTRING_NAME p) = bimap OSSTRING_NAME OSSTRING_NAME $ C.splitDrive p + + +-- | 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" + +#ifdef WINDOWS_DOC +-- | Join a drive and the rest of the path. +-- +-- > Valid x => uncurry joinDrive (splitDrive x) == x +-- > joinDrive "C:" "foo" == "C:foo" +-- > joinDrive "C:\\" "bar" == "C:\\bar" +-- > joinDrive "\\\\share" "foo" == "\\\\share\\foo" +-- > joinDrive "/:" "foo" == "/:\\foo" +#elif defined(POSIX_DOC) +-- | Join a drive and the rest of the path. +-- +-- > Valid x => uncurry joinDrive (splitDrive x) == x +#else +-- | 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" +#endif +joinDrive :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME +joinDrive (OSSTRING_NAME a) (OSSTRING_NAME b) = OSSTRING_NAME $ C.joinDrive a b + + +-- | Get the drive from a filepath. +-- +-- > takeDrive x == fst (splitDrive x) +takeDrive :: FILEPATH_NAME -> FILEPATH_NAME +takeDrive (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeDrive x + + +-- | Delete the drive, if it exists. +-- +-- > dropDrive x == snd (splitDrive x) +dropDrive :: FILEPATH_NAME -> FILEPATH_NAME +dropDrive (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropDrive x + + +#ifdef WINDOWS_DOC +-- | Does a path have a drive. +-- +-- > not (hasDrive x) == null (takeDrive x) +-- > hasDrive "C:\\foo" == True +-- > hasDrive "C:foo" == True +-- > hasDrive "foo" == False +-- > hasDrive "" == False +-- +#elif defined(POSIX_DOC) +-- | Does a path have a drive. +-- +-- > not (hasDrive x) == null (takeDrive x) +-- > hasDrive "/foo" == True +-- > hasDrive "foo" == False +-- > hasDrive "" == False +-- +#else +-- | 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 +-- +#endif +hasDrive :: FILEPATH_NAME -> Bool +hasDrive (OSSTRING_NAME x) = C.hasDrive x + + +#ifdef WINDOWS_DOC +-- | Is an element a drive +-- +-- > isDrive "C:\\" == True +-- > isDrive "C:\\foo" == False +-- > isDrive "" == False +#elif defined(POSIX_DOC) +-- | Is an element a drive +-- +-- > isDrive "/" == True +-- > isDrive "/foo" == False +-- > isDrive "" == False +#else +-- | Is an element a drive +-- +-- > Posix: isDrive "/" == True +-- > Posix: isDrive "/foo" == False +-- > Windows: isDrive "C:\\" == True +-- > Windows: isDrive "C:\\foo" == False +-- > isDrive "" == False +#endif +isDrive :: FILEPATH_NAME -> Bool +isDrive (OSSTRING_NAME x) = C.isDrive x + + +--------------------------------------------------------------------- +-- Operations on a filepath, as a list of directories + +#ifdef WINDOWS_DOC +-- | 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") +-- > splitFileName "c:" == ("c:","") +#elif defined(POSIX_DOC) +-- | 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") +-- > splitFileName "/" == ("/","") +#else +-- | 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:","") +#endif +splitFileName :: FILEPATH_NAME -> (FILEPATH_NAME, FILEPATH_NAME) +splitFileName (OSSTRING_NAME x) = bimap OSSTRING_NAME OSSTRING_NAME $ C.splitFileName x + + +-- | Set the filename. +-- +-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" +-- > Valid x => replaceFileName x (takeFileName x) == x +replaceFileName :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +replaceFileName (OSSTRING_NAME x) (OSSTRING_NAME y) = OSSTRING_NAME $ C.replaceFileName x y + + +-- | 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 :: FILEPATH_NAME -> FILEPATH_NAME +dropFileName (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropFileName x + + +-- | 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 :: FILEPATH_NAME -> FILEPATH_NAME +takeFileName (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeFileName x + + +-- | 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 :: FILEPATH_NAME -> FILEPATH_NAME +takeBaseName (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeBaseName x + + +-- | 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 :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME +replaceBaseName (OSSTRING_NAME path) (OSSTRING_NAME name) = OSSTRING_NAME $ C.replaceBaseName path name + + +-- | Is an item either a directory or the last character a path separator? +-- +-- > hasTrailingPathSeparator "test" == False +-- > hasTrailingPathSeparator "test/" == True +hasTrailingPathSeparator :: FILEPATH_NAME -> Bool +hasTrailingPathSeparator (OSSTRING_NAME x) = C.hasTrailingPathSeparator x + + +#ifdef WINDOWS_DOC +-- | Add a trailing file path separator if one is not already present. +-- +-- > hasTrailingPathSeparator (addTrailingPathSeparator x) +-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x +#elif defined(POSIX_DOC) +-- | Add a trailing file path separator if one is not already present. +-- +-- > hasTrailingPathSeparator (addTrailingPathSeparator x) +-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x +-- > addTrailingPathSeparator "test/rest" == "test/rest/" +#else +-- | 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/" +#endif +addTrailingPathSeparator :: FILEPATH_NAME -> FILEPATH_NAME +addTrailingPathSeparator (OSSTRING_NAME bs) = OSSTRING_NAME $ C.addTrailingPathSeparator bs + + +#ifdef WINDOWS_DOC +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > dropTrailingPathSeparator "/" == "/" +-- > dropTrailingPathSeparator "\\" == "\\" +#elif defined(POSIX_DOC) +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > dropTrailingPathSeparator "/" == "/" +-- > not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x +#else +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > dropTrailingPathSeparator "/" == "/" +-- > Windows: dropTrailingPathSeparator "\\" == "\\" +-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x +#endif +dropTrailingPathSeparator :: FILEPATH_NAME -> FILEPATH_NAME +dropTrailingPathSeparator (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropTrailingPathSeparator x + + +#ifdef WINDOWS_DOC +-- | 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" +-- > takeDirectory "foo\\bar" == "foo" +-- > takeDirectory "foo\\bar\\\\" == "foo\\bar" +-- > takeDirectory "C:\\" == "C:\\" +#elif defined(POSIX_DOC) +-- | 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" +#else +-- | 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:\\" +#endif +takeDirectory :: FILEPATH_NAME -> FILEPATH_NAME +takeDirectory (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeDirectory x + + +-- | Set the directory, keeping the filename the same. +-- +-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" +-- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x +replaceDirectory :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME +replaceDirectory (OSSTRING_NAME file) (OSSTRING_NAME dir) = OSSTRING_NAME $ C.replaceDirectory file dir + + +-- | An alias for ''. +combine :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME +combine (OSSTRING_NAME a) (OSSTRING_NAME b) = OSSTRING_NAME $ C.combine a b + +#ifdef WINDOWS_DOC +-- | 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@. +-- +-- > "/directory" "file.ext" == "/directory\\file.ext" +-- > "directory" "/file.ext" == "/file.ext" +-- > Valid x => (takeDirectory x takeFileName x) `equalFilePath` x +-- +-- Combined: +-- +-- > "C:\\foo" "bar" == "C:\\foo\\bar" +-- > "home" "bob" == "home\\bob" +-- +-- Not combined: +-- +-- > "home" "C:\\bob" == "C:\\bob" +-- +-- Not combined (tricky): +-- +-- 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. +-- +-- > "home" "/bob" == "/bob" +-- > "home" "\\bob" == "\\bob" +-- > "C:\\home" "\\bob" == "\\bob" +-- +-- 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. +-- +-- > "D:\\foo" "C:bar" == "C:bar" +-- > "C:\\foo" "C:bar" == "C:bar" +#elif defined(POSIX_DOC) +-- | 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@. +-- +-- > "/directory" "file.ext" == "/directory/file.ext" +-- > Valid x => (takeDirectory x takeFileName x) `equalFilePath` x +-- +-- Combined: +-- +-- > "/" "test" == "/test" +-- > "home" "bob" == "home/bob" +-- > "x:" "foo" == "x:/foo" +-- +-- Not combined: +-- +-- > "home" "/bob" == "/bob" +#else +-- | 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" +-- > 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" +#endif +() :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME +() = combine + + +#ifdef WINDOWS_DOC +-- | Split a path by the directory separator. +-- +-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] +-- > concat (splitPath x) == x +-- > splitPath "test//item/" == ["test//","item/"] +-- > splitPath "test/item/file" == ["test/","item/","file"] +-- > splitPath "" == [] +-- > splitPath "c:\\test\\path" == ["c:\\","test\\","path"] +#elif defined(POSIX_DOC) +-- | Split a path by the directory separator. +-- +-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] +-- > concat (splitPath x) == x +-- > splitPath "test//item/" == ["test//","item/"] +-- > splitPath "test/item/file" == ["test/","item/","file"] +-- > splitPath "" == [] +-- > splitPath "/file/test" == ["/","file/","test"] +#else +-- | Split a path by the directory separator. +-- +-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] +-- > concat (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"] +#endif +splitPath :: FILEPATH_NAME -> [FILEPATH_NAME] +splitPath (OSSTRING_NAME bs) = OSSTRING_NAME <$> C.splitPath bs + +#ifdef WINDOWS_DOC +-- | 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"] +-- > splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"] +-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x +-- > splitDirectories "" == [] +-- > splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] +-- > splitDirectories "/test///file" == ["/","test","file"] +#elif defined(POSIX_DOC) +-- | 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"] +-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x +-- > splitDirectories "" == [] +-- > splitDirectories "/test///file" == ["/","test","file"] +#else +-- | 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"] +-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x +-- > splitDirectories "" == [] +-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] +-- > splitDirectories "/test///file" == ["/","test","file"] +#endif +splitDirectories :: FILEPATH_NAME -> [FILEPATH_NAME] +splitDirectories (OSSTRING_NAME x) = OSSTRING_NAME <$> C.splitDirectories x + +#ifdef WINDOWS_DOC +-- | Join path elements back together. +-- +-- > joinPath z == foldr () "" z +-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" +-- > Valid x => joinPath (splitPath x) == x +-- > joinPath [] == "" +#elif defined(POSIX_DOC) +-- | Join path elements back together. +-- +-- > joinPath z == foldr () "" z +-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" +-- > Valid x => joinPath (splitPath x) == x +-- > joinPath [] == "" +-- > joinPath ["test","file","path"] == "test/file/path" +#else +-- | Join path elements back together. +-- +-- > joinPath z == foldr () "" z +-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" +-- > Valid x => joinPath (splitPath x) == x +-- > joinPath [] == "" +-- > Posix: joinPath ["test","file","path"] == "test/file/path" +#endif +joinPath :: [FILEPATH_NAME] -> FILEPATH_NAME +joinPath = foldr () (OSSTRING_NAME mempty) + + + + + + + + + +------------------------ +-- File name manipulations + + +#ifdef WINDOWS_DOC +-- | Equality of two filepaths. +-- 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. +-- +-- Similar to 'normalise', this does not expand @".."@, because of symlinks. +-- +-- > x == y ==> equalFilePath x y +-- > normalise x == normalise y ==> equalFilePath x y +-- > equalFilePath "foo" "foo/" +-- > not (equalFilePath "/a/../c" "/c") +-- > not (equalFilePath "foo" "/foo") +-- > equalFilePath "foo" "FOO" +-- > not (equalFilePath "C:" "C:/") +#elif defined(POSIX_DOC) +-- | Equality of two filepaths. +-- 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. +-- +-- Similar to 'normalise', this does not expand @".."@, because of symlinks. +-- +-- > x == y ==> equalFilePath x y +-- > normalise x == normalise y ==> equalFilePath x y +-- > equalFilePath "foo" "foo/" +-- > not (equalFilePath "/a/../c" "/c") +-- > not (equalFilePath "foo" "/foo") +-- > not (equalFilePath "foo" "FOO") +#else +-- | Equality of two filepaths. +-- 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. +-- +-- Similar to 'normalise', this does not expand @".."@, because of symlinks. +-- +-- > x == y ==> equalFilePath x y +-- > normalise x == normalise y ==> equalFilePath x y +-- > equalFilePath "foo" "foo/" +-- > not (equalFilePath "/a/../c" "/c") +-- > not (equalFilePath "foo" "/foo") +-- > Posix: not (equalFilePath "foo" "FOO") +-- > Windows: equalFilePath "foo" "FOO" +-- > Windows: not (equalFilePath "C:" "C:/") +#endif +equalFilePath :: FILEPATH_NAME -> FILEPATH_NAME -> Bool +equalFilePath (OSSTRING_NAME p1) (OSSTRING_NAME p2) = C.equalFilePath p1 p2 + +#ifdef WINDOWS_DOC +-- | 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@. +-- +-- > makeRelative "/directory" "/directory/file.ext" == "file.ext" +-- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x +-- > makeRelative x x == "." +-- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +-- > makeRelative "C:\\Home" "c:\\home\\bob" == "bob" +-- > makeRelative "C:\\Home" "c:/home/bob" == "bob" +-- > makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" +-- > makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" +-- > makeRelative "/Home" "/home/bob" == "bob" +-- > makeRelative "/" "//" == "//" +#elif defined(POSIX_DOC) +-- | 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@. +-- +-- > makeRelative "/directory" "/directory/file.ext" == "file.ext" +-- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x +-- > makeRelative x x == "." +-- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +-- > makeRelative "/Home" "/home/bob" == "/home/bob" +-- > makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" +-- > makeRelative "/fred" "bob" == "bob" +-- > makeRelative "/file/test" "/file/test/fred" == "fred" +-- > makeRelative "/file/test" "/file/test/fred/" == "fred/" +-- > makeRelative "some/path" "some/path/a/b/c" == "a/b/c" +#else +-- | 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@. +-- +-- > makeRelative "/directory" "/directory/file.ext" == "file.ext" +-- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x +-- > makeRelative x x == "." +-- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" +-- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" +-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" +-- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" +-- > Windows: makeRelative "/Home" "/home/bob" == "bob" +-- > Windows: makeRelative "/" "//" == "//" +-- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob" +-- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" +-- > Posix: makeRelative "/fred" "bob" == "bob" +-- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" +-- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" +-- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c" +#endif +makeRelative :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME +makeRelative (OSSTRING_NAME root) (OSSTRING_NAME path) = OSSTRING_NAME $ C.makeRelative root path + +#ifdef WINDOWS_DOC +-- | Normalise a file +-- +-- * \/\/ outside of the drive can be made blank +-- +-- * \/ -> 'pathSeparator' +-- +-- * .\/ -> \"\" +-- +-- Does not remove @".."@, because of symlinks. +-- +-- > normalise "c:\\file/bob\\" == "C:\\file\\bob\\" +-- > normalise "c:\\" == "C:\\" +-- > normalise "C:.\\" == "C:" +-- > normalise "\\\\server\\test" == "\\\\server\\test" +-- > normalise "//server/test" == "\\\\server\\test" +-- > normalise "c:/file" == "C:\\file" +-- > normalise "/file" == "\\file" +-- > normalise "\\" == "\\" +-- > normalise "/./" == "\\" +-- > normalise "." == "." +#elif defined(POSIX_DOC) +-- | Normalise a file +-- +-- * \/\/ outside of the drive can be made blank +-- +-- * \/ -> 'pathSeparator' +-- +-- * .\/ -> \"\" +-- +-- Does not remove @".."@, because of symlinks. +-- +-- > normalise "/file/\\test////" == "/file/\\test/" +-- > normalise "/file/./test" == "/file/test" +-- > normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" +-- > normalise "../bob/fred/" == "../bob/fred/" +-- > normalise "/a/../c" == "/a/../c" +-- > normalise "./bob/fred/" == "bob/fred/" +-- > normalise "." == "." +-- > normalise "./" == "./" +-- > normalise "./." == "./" +-- > normalise "/./" == "/" +-- > normalise "/" == "/" +-- > normalise "bob/fred/." == "bob/fred/" +-- > normalise "//home" == "/home" +#else +-- | Normalise a file +-- +-- * \/\/ outside of the drive can be made blank +-- +-- * \/ -> 'pathSeparator' +-- +-- * .\/ -> \"\" +-- +-- Does not remove @".."@, because of symlinks. +-- +-- > Posix: normalise "/file/\\test////" == "/file/\\test/" +-- > Posix: normalise "/file/./test" == "/file/test" +-- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" +-- > Posix: normalise "../bob/fred/" == "../bob/fred/" +-- > Posix: normalise "/a/../c" == "/a/../c" +-- > Posix: normalise "./bob/fred/" == "bob/fred/" +-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" +-- > Windows: normalise "c:\\" == "C:\\" +-- > Windows: normalise "C:.\\" == "C:" +-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" +-- > Windows: normalise "//server/test" == "\\\\server\\test" +-- > Windows: normalise "c:/file" == "C:\\file" +-- > Windows: normalise "/file" == "\\file" +-- > Windows: normalise "\\" == "\\" +-- > Windows: normalise "/./" == "\\" +-- > normalise "." == "." +-- > Posix: normalise "./" == "./" +-- > Posix: normalise "./." == "./" +-- > Posix: normalise "/./" == "/" +-- > Posix: normalise "/" == "/" +-- > Posix: normalise "bob/fred/." == "bob/fred/" +-- > Posix: normalise "//home" == "/home" +#endif +normalise :: FILEPATH_NAME -> FILEPATH_NAME +normalise (OSSTRING_NAME filepath) = OSSTRING_NAME $ C.normalise filepath + + +#ifdef WINDOWS_DOC +-- | Is a filepath 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 +-- > isValid "c:\\test" == True +-- > isValid "c:\\test:of_test" == False +-- > isValid "test*" == False +-- > isValid "c:\\test\\nul" == False +-- > isValid "c:\\test\\prn.txt" == False +-- > isValid "c:\\nul\\file" == False +-- > isValid "\\\\" == False +-- > isValid "\\\\\\foo" == False +-- > isValid "\\\\?\\D:file" == False +-- > isValid "foo\tbar" == False +-- > isValid "nul .txt" == False +-- > isValid " nul.txt" == True +#elif defined(POSIX_DOC) +-- | Is a filepath 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 +-- > isValid "/random_ path:*" == True +-- > isValid x == not (null x) +#else +-- | Is a filepath 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 == not (null x) +-- > 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 +#endif +isValid :: FILEPATH_NAME -> Bool +isValid (OSSTRING_NAME filepath) = C.isValid filepath + + +#ifdef WINDOWS_DOC +-- | Take a filepath and make it valid; does not change already valid filepaths. +-- +-- > isValid (makeValid x) +-- > isValid x ==> makeValid x == x +-- > makeValid "" == "_" +-- > makeValid "file\0name" == "file_name" +-- > makeValid "c:\\already\\/valid" == "c:\\already\\/valid" +-- > makeValid "c:\\test:of_test" == "c:\\test_of_test" +-- > makeValid "test*" == "test_" +-- > makeValid "c:\\test\\nul" == "c:\\test\\nul_" +-- > makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" +-- > makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" +-- > makeValid "c:\\nul\\file" == "c:\\nul_\\file" +-- > makeValid "\\\\\\foo" == "\\\\drive" +-- > makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" +-- > makeValid "nul .txt" == "nul _.txt" +#elif defined(POSIX_DOC) +-- | Take a filepath and make it valid; does not change already valid filepaths. +-- +-- > isValid (makeValid x) +-- > isValid x ==> makeValid x == x +-- > makeValid "" == "_" +-- > makeValid "file\0name" == "file_name" +#else +-- | Take a filepath and make it valid; does not change already valid filepaths. +-- +-- > isValid (makeValid x) +-- > isValid x ==> makeValid x == x +-- > makeValid "" == "_" +-- > makeValid "file\0name" == "file_name" +-- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" +-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" +-- > Windows: makeValid "test*" == "test_" +-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" +-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" +-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" +-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" +-- > Windows: makeValid "\\\\\\foo" == "\\\\drive" +-- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" +-- > Windows: makeValid "nul .txt" == "nul _.txt" +#endif +makeValid :: FILEPATH_NAME -> FILEPATH_NAME +makeValid (OSSTRING_NAME path) = OSSTRING_NAME $ C.makeValid path + + +#ifdef WINDOWS_DOC +-- | Is a path relative, or is it fixed to the root? +-- +-- > isRelative "path\\test" == True +-- > isRelative "c:\\test" == False +-- > isRelative "c:test" == True +-- > isRelative "c:\\" == False +-- > isRelative "c:/" == False +-- > isRelative "c:" == True +-- > isRelative "\\\\foo" == False +-- > isRelative "\\\\?\\foo" == False +-- > isRelative "\\\\?\\UNC\\foo" == False +-- > isRelative "/foo" == True +-- > isRelative "\\foo" == True +-- +-- According to [1]: +-- +-- * "A UNC name of any format [is never relative]." +-- +-- * "You cannot use the "\\?\" prefix with a relative path." +#elif defined(POSIX_DOC) +-- | Is a path relative, or is it fixed to the root? +-- +-- > isRelative "test/path" == True +-- > isRelative "/test" == False +-- > isRelative "/" == False +#else +-- | 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." +#endif +isRelative :: FILEPATH_NAME -> Bool +isRelative (OSSTRING_NAME x) = C.isRelative x + + +-- | @not . 'isRelative'@ +-- +-- > isAbsolute x == not (isRelative x) +isAbsolute :: FILEPATH_NAME -> Bool +isAbsolute (OSSTRING_NAME x) = C.isAbsolute x + + +-- things not defined in os-string + +#ifdef WINDOWS +encodeFS :: String -> IO WindowsPath +encodeFS = fmap WindowsString . encodeWithBaseWindows + +decodeFS :: WindowsPath -> IO String +decodeFS (WindowsString x) = decodeWithBaseWindows x +#elif defined(POSIX) +encodeFS :: String -> IO PosixPath +encodeFS = fmap PosixString . encodeWithBasePosix + +decodeFS :: PosixPath -> IO String +decodeFS (PosixString x) = decodeWithBasePosix x +#else +encodeFS :: String -> IO OsPath +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +encodeFS = fmap (OsString . WindowsString) . encodeWithBaseWindows +#else +encodeFS = fmap (OsString . PosixString) . encodeWithBasePosix +#endif + +decodeFS :: OsPath -> IO String +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +decodeFS (OsString (WindowsString x)) = decodeWithBaseWindows x +#else +decodeFS (OsString (PosixString x)) = decodeWithBasePosix x +#endif + +#endif + diff --git a/System/OsPath/Encoding.hs b/System/OsPath/Encoding.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Encoding.hs @@ -0,0 +1,31 @@ +module System.OsPath.Encoding + ( + -- * Types + EncodingException(..) + , showEncodingException + + -- * UCS-2 + , ucs2le + , mkUcs2le + , ucs2le_DF + , ucs2le_EF + , ucs2le_decode + , ucs2le_encode + + -- * UTF-16LE_b + , utf16le_b + , mkUTF16le_b + , utf16le_b_DF + , utf16le_b_EF + , utf16le_b_decode + , utf16le_b_encode + + -- * base encoding + , encodeWithBasePosix + , decodeWithBasePosix + , encodeWithBaseWindows + , decodeWithBaseWindows + ) + where + +import System.OsString.Encoding.Internal diff --git a/System/OsPath/Internal.hs b/System/OsPath/Internal.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Internal.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE ViewPatterns #-} -- needed to quote a view pattern + +module System.OsPath.Internal where + +import {-# SOURCE #-} System.OsPath + ( isValid ) +import System.OsPath.Types +import qualified System.OsString.Internal as OS + +import Control.Monad.Catch + ( MonadThrow ) +import Data.ByteString + ( ByteString ) +#if __GLASGOW_HASKELL__ >= 914 +import Language.Haskell.TH.Lift + ( Lift(..), lift ) +import Language.Haskell.TH.QuasiQuoter + ( QuasiQuoter (..) ) +#else +import Language.Haskell.TH.Syntax + ( Lift(..), lift ) +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +#endif +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) + +import System.OsString.Internal.Types +import System.OsPath.Encoding +import Control.Monad (when) +#if !defined(__MHS__) +import System.IO + ( TextEncoding ) +#else +import GHC.IO.Encoding.Types ( TextEncoding ) +#endif + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +import qualified System.OsPath.Windows as PF +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +#else +import qualified System.OsPath.Posix as PF +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +#endif +import GHC.Stack (HasCallStack) + + + +-- | Partial unicode friendly encoding. +-- +-- On windows this encodes as UTF16-LE (strictly), which is a pretty good guess. +-- On unix this encodes as UTF8 (strictly), which is a good guess. +-- +-- Throws an 'EncodingException' if encoding fails. If the input does not +-- contain surrogate chars, you can use 'unsafeEncodeUtf'. +encodeUtf :: MonadThrow m => FilePath -> m OsPath +encodeUtf = OS.encodeUtf + +-- | Unsafe unicode friendly encoding. +-- +-- Like 'encodeUtf', except it crashes when the input contains +-- surrogate chars. For sanitized input, this can be useful. +unsafeEncodeUtf :: HasCallStack => String -> OsString +unsafeEncodeUtf = OS.unsafeEncodeUtf + +-- | Encode a 'FilePath' with the specified encoding. +-- +-- Note: on windows, we expect a "wide char" encoding (e.g. UCS-2 or UTF-16). Anything +-- that works with @Word16@ boundaries. Picking an incompatible encoding may crash +-- filepath operations. +encodeWith :: TextEncoding -- ^ unix text encoding + -> TextEncoding -- ^ windows text encoding (wide char) + -> FilePath + -> Either EncodingException OsPath +encodeWith = OS.encodeWith + +-- | Like 'encodeUtf', except this mimics the behavior of the base library when doing filesystem +-- operations, which is: +-- +-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale, +-- but PEP 383 only works properly on UTF-8 encodings, so good luck) +-- 2. on windows does permissive UTF-16 encoding, where coding errors generate +-- Chars in the surrogate range +-- +-- Looking up the locale requires IO. If you're not worried about calls +-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure +-- to deeply evaluate the result to catch exceptions). +encodeFS :: FilePath -> IO OsPath +encodeFS = OS.encodeFS + + +-- | Partial unicode friendly decoding. +-- +-- On windows this decodes as UTF16-LE (strictly), which is a pretty good guess. +-- On unix this decodes as UTF8 (strictly), which is a good guess. +-- +-- Throws a 'EncodingException' if decoding fails. +decodeUtf :: MonadThrow m => OsPath -> m FilePath +decodeUtf = OS.decodeUtf + +-- | Decode an 'OsPath' with the specified encoding. +decodeWith :: TextEncoding -- ^ unix text encoding + -> TextEncoding -- ^ windows text encoding + -> OsPath + -> Either EncodingException FilePath +decodeWith = OS.decodeWith + +-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem +-- operations, which is: +-- +-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale, +-- but PEP 383 only works properly on UTF-8 encodings, so good luck) +-- 2. on windows does permissive UTF-16 encoding, where coding errors generate +-- Chars in the surrogate range +-- +-- Looking up the locale requires IO. If you're not worried about calls +-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure +-- to deeply evaluate the result to catch exceptions). +decodeFS :: OsPath -> IO FilePath +decodeFS = OS.decodeFS + + +-- | Constructs an @OsPath@ from a ByteString. +-- +-- On windows, this ensures valid UCS-2LE, on unix it is passed unchanged/unchecked. +-- +-- Throws 'EncodingException' on invalid UCS-2LE on windows (although unlikely). +fromBytes :: MonadThrow m + => ByteString + -> m OsPath +fromBytes = OS.fromBytes + + + +#if defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) +-- | QuasiQuote an 'OsPath'. This accepts Unicode characters +-- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid' +-- on the input. If used as a pattern, requires turning on the @ViewPatterns@ +-- extension. +osp :: QuasiQuoter +osp = QuasiQuoter +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + { quoteExp = \s -> do + osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s + when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') + lift osp' + , quotePat = \s -> do + osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s + when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') + [p|((==) osp' -> True)|] + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" + } +#else + { quoteExp = \s -> do + osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s + when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') + lift osp' + , quotePat = \s -> do + osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s + when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') + [p|((==) osp' -> True)|] + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" + } +#endif +#else +osp :: a +osp = error "System.OsPath.Internal.ostr: no Template Haskell" +#endif /* defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) */ + + +-- | Unpack an 'OsPath' to a list of 'OsChar'. +unpack :: OsPath -> [OsChar] +unpack = OS.unpack + + +-- | Pack a list of 'OsChar' to an 'OsPath'. +-- +-- Note that using this in conjunction with 'unsafeFromChar' to +-- convert from @[Char]@ to 'OsPath' is probably not what +-- you want, because it will truncate unicode code points. +pack :: [OsChar] -> OsPath +pack = OS.pack + diff --git a/System/OsPath/Posix.hs b/System/OsPath/Posix.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Posix.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE ViewPatterns #-} + +#undef WINDOWS +#define POSIX +#define IS_WINDOWS False +#define FILEPATH_NAME PosixPath +#define OSSTRING_NAME PosixString +#define WORD_NAME PosixChar + +#include "Common.hs" + +#if defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) +-- | QuasiQuote a 'PosixPath'. This accepts Unicode characters +-- and encodes as UTF-8. Runs 'isValid' on the input. +pstr :: QuasiQuoter +pstr = + QuasiQuoter + { quoteExp = \s -> do + ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) s + when (not $ isValid ps) $ fail ("filepath not valid: " ++ show ps) + lift ps + , quotePat = \s -> do + osp' <- either (fail . show) pure . encodeWith (mkUTF8 ErrorOnCodingFailure) $ s + when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') + [p|((==) osp' -> True)|] + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" + } +#else +pstr :: a +pstr = error "System.OsPath.Posix.pstr: no Template Haskell" +#endif /* defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) */ + diff --git a/System/OsPath/Posix/Internal.hs b/System/OsPath/Posix/Internal.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Posix/Internal.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE CPP #-} + +#undef WINDOWS +#define OS_PATH +#define IS_WINDOWS False +#define MODULE_NAME Posix + +#include "../../FilePath/Internal.hs" diff --git a/System/OsPath/Types.hs b/System/OsPath/Types.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Types.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP #-} + +module System.OsPath.Types + ( + -- * FilePath types + OsPath + , WindowsPath + , PosixPath + , PlatformPath + + -- * OsString reexports + , WindowsString + , PosixString + , WindowsChar + , PosixChar + , OsString + , OsChar + ) +where + +import System.OsString.Internal.Types + + +-- | Filepaths are @wchar_t*@ data on windows as passed to syscalls. +type WindowsPath = WindowsString + +-- | Filepaths are @char[]@ data on unix as passed to syscalls. +type PosixPath = PosixString + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +-- | Ifdef around current platform (either 'WindowsPath' or 'PosixPath'). +type PlatformPath = WindowsPath +#else +-- | Ifdef around current platform (either 'WindowsPath' or 'PosixPath'). +type PlatformPath = PosixPath +#endif + + +-- | Type representing filenames\/pathnames. +-- +-- This type doesn't add any guarantees over 'OsString'. +type OsPath = OsString diff --git a/System/OsPath/Windows.hs b/System/OsPath/Windows.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Windows.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE ViewPatterns #-} + +#undef POSIX +#define IS_WINDOWS True +#define WINDOWS +#define FILEPATH_NAME WindowsPath +#define OSSTRING_NAME WindowsString +#define WORD_NAME WindowsChar + +#include "Common.hs" + +#if defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) +-- | QuasiQuote a 'WindowsPath'. This accepts Unicode characters +-- and encodes as UTF-16LE. Runs 'isValid' on the input. +pstr :: QuasiQuoter +pstr = + QuasiQuoter + { quoteExp = \s -> do + ps <- either (fail . show) pure $ encodeWith (mkUTF16le ErrorOnCodingFailure) s + when (not $ isValid ps) $ fail ("filepath not valid: " ++ show ps) + lift ps + , quotePat = \s -> do + osp' <- either (fail . show) pure . encodeWith (mkUTF16le ErrorOnCodingFailure) $ s + when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') + [p|((==) osp' -> True)|] + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" + } +#else +pstr :: a +pstr = error "Systen.OsPath.Windows.pstr: no Template Haskell" +#endif /* defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskellquasi_quoter) */ diff --git a/System/OsPath/Windows/Internal.hs b/System/OsPath/Windows/Internal.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Windows/Internal.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +#undef POSIX +#define WINDOWS +#define OS_PATH +#define IS_WINDOWS True +#define MODULE_NAME Windows + +#include "../../FilePath/Internal.hs" diff --git a/bench/BenchFilePath.hs b/bench/BenchFilePath.hs new file mode 100644 --- /dev/null +++ b/bench/BenchFilePath.hs @@ -0,0 +1,245 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuasiQuotes #-} + +module Main where + +import System.OsPath.Types +import System.OsPath.Encoding ( ucs2le ) +import qualified System.OsString.Internal.Types as OST +import qualified Data.ByteString.Short as SBS + +import Test.Tasty.Bench + +import qualified System.FilePath.Posix as PF +import qualified System.FilePath.Posix as WF +import qualified System.OsString.Posix as OSP +import qualified System.OsString.Windows as WSP +import qualified System.OsPath.Posix as APF +import qualified System.OsPath.Windows as AWF + +main :: IO () +main = defaultMain + [ bgroup "filepath (string)" $ map (uncurry bench) + [("splitExtension (posix)" , nf PF.splitExtension posixPath) + ,("splitExtension (windows)" , nf WF.splitExtension windowsPath) + ,("takeExtension (posix)" , nf PF.takeExtension posixPath) + ,("takeExtension (windows)" , nf WF.takeExtension windowsPath) + ,("replaceExtension (posix)" , nf (PF.replaceExtension ".lol") posixPath) + ,("replaceExtension (windows)" , nf (WF.replaceExtension ".lol") windowsPath) + ,("dropExtension (posix)" , nf PF.dropExtension posixPath) + ,("dropExtension (windows)" , nf WF.dropExtension windowsPath) + ,("addExtension (posix)" , nf (PF.addExtension ".lol") posixPath) + ,("addExtension (windows)" , nf (WF.addExtension ".lol") windowsPath) + ,("hasExtension (posix)" , nf PF.hasExtension posixPath) + ,("hasExtension (windows)" , nf WF.hasExtension windowsPath) + ,("splitExtensions (posix)" , nf PF.splitExtensions posixPath) + ,("splitExtensions (windows)" , nf WF.splitExtensions windowsPath) + ,("dropExtensions (posix)" , nf PF.dropExtensions posixPath) + ,("dropExtensions (windows)" , nf WF.dropExtensions windowsPath) + ,("takeExtensions (posix)" , nf PF.takeExtensions posixPath) + ,("takeExtensions (windows)" , nf WF.takeExtensions windowsPath) + ,("replaceExtensions (posix)" , nf (PF.replaceExtensions ".lol") posixPath) + ,("replaceExtensions (windows)" , nf (WF.replaceExtensions ".lol") windowsPath) + ,("isExtensionOf (posix)" , nf (PF.isExtensionOf ".lol") posixPath) + ,("isExtensionOf (windows)" , nf (WF.isExtensionOf ".lol") windowsPath) + ,("stripExtension (posix)" , nf (PF.stripExtension ".lol") posixPath) + ,("stripExtension (windows)" , nf (WF.stripExtension ".lol") windowsPath) + + ,("splitFileName (posix)" , nf PF.splitFileName posixPath) + ,("splitFileName (windows)" , nf WF.splitFileName windowsPath) + ,("takeFileName (posix)" , nf PF.takeFileName posixPath) + ,("takeFileName (windows)" , nf WF.takeFileName windowsPath) + ,("replaceFileName (posix)" , nf (PF.replaceFileName "lol") posixPath) + ,("replaceFileName (windows)" , nf (WF.replaceFileName "lol") windowsPath) + ,("dropFileName (posix)" , nf PF.dropFileName posixPath) + ,("dropFileName (windows)" , nf WF.dropFileName windowsPath) + ,("takeBaseName (posix)" , nf PF.takeBaseName posixPath) + ,("takeBaseName (windows)" , nf WF.takeBaseName windowsPath) + ,("replaceBaseName (posix)" , nf (PF.replaceBaseName "lol") posixPath) + ,("replaceBaseName (windows)" , nf (WF.replaceBaseName "lol") windowsPath) + ,("takeDirectory (posix)" , nf PF.takeDirectory posixPath) + ,("takeDirectory (windows)" , nf WF.takeDirectory windowsPath) + ,("replaceDirectory (posix)" , nf (PF.replaceDirectory "lol") posixPath) + ,("replaceDirectory (windows)" , nf (WF.replaceDirectory "lol") windowsPath) + ,("combine (posix)" , nf (PF.combine "lol") posixPath) + ,("combine (windows)" , nf (WF.combine "lol") windowsPath) + ,("splitPath (posix)" , nf PF.splitPath posixPath) + ,("splitPath (windows)" , nf WF.splitPath windowsPath) + ,("joinPath (posix)" , nf PF.joinPath (PF.splitPath posixPath)) + ,("joinPath (windows)" , nf WF.joinPath (WF.splitPath windowsPath)) + ,("splitDirectories (posix)" , nf PF.splitDirectories posixPath) + ,("splitDirectories (windows)" , nf WF.splitDirectories windowsPath) + + ,("splitDrive (posix)" , nf PF.splitDrive posixPath) + ,("splitDrive (windows)" , nf WF.splitDrive windowsPath) + ,("joinDrive (posix)" , nf (PF.joinDrive "/") posixPath) + ,("joinDrive (windows)" , nf (WF.joinDrive "C:\\") windowsPath) + ,("takeDrive (posix)" , nf PF.takeDrive posixPath) + ,("takeDrive (windows)" , nf WF.takeDrive windowsPath) + ,("hasDrive (posix)" , nf PF.hasDrive posixPath) + ,("hasDrive (windows)" , nf WF.hasDrive windowsPath) + ,("dropDrive (posix)" , nf PF.dropDrive posixPath) + ,("dropDrive (windows)" , nf WF.dropDrive windowsPath) + ,("isDrive (posix)" , nf PF.isDrive posixPath) + ,("isDrive (windows)" , nf WF.isDrive windowsPath) + + ,("hasTrailingPathSeparator (posix)" , nf PF.hasTrailingPathSeparator posixPath) + ,("hasTrailingPathSeparator (windows)" , nf WF.hasTrailingPathSeparator windowsPath) + ,("addTrailingPathSeparator (posix)" , nf PF.addTrailingPathSeparator posixPath) + ,("addTrailingPathSeparator (windows)" , nf WF.addTrailingPathSeparator windowsPath) + ,("dropTrailingPathSeparator (posix)" , nf PF.addTrailingPathSeparator posixPath) + ,("dropTrailingPathSeparator (windows)" , nf WF.addTrailingPathSeparator windowsPath) + + ,("normalise (posix)" , nf PF.normalise posixPath) + ,("normalise (windows)" , nf WF.normalise windowsPath) + ,("equalFilePath (posix)" , nf (PF.equalFilePath "abc/def/zs") posixPath) + ,("equalFilePath (windows)" , nf (WF.equalFilePath "abc/def/zs") windowsPath) + ,("makeRelative (posix)" , nf (PF.makeRelative "abc/def/zs") posixPath) + ,("makeRelative (windows)" , nf (WF.makeRelative "abc/def/zs") windowsPath) + ,("isRelative (posix)" , nf PF.isRelative posixPath) + ,("isRelative (windows)" , nf WF.isRelative windowsPath) + ,("isAbsolute (posix)" , nf PF.isAbsolute posixPath) + ,("isAbsolute (windows)" , nf WF.isAbsolute windowsPath) + ,("isValid (posix)" , nf PF.isValid posixPath) + ,("isValid (windows)" , nf WF.isValid windowsPath) + ,("makeValid (posix)" , nf PF.makeValid posixPath) + ,("makeValid (windows)" , nf WF.makeValid windowsPath) + + ,("splitSearchPath (posix)" , nf PF.splitSearchPath posixSearchPath) + ,("splitSearchPath (windows)" , nf WF.splitSearchPath windowsSearchPath) + ] + + , bgroup "filepath (AFPP)" $ map (uncurry bench) + [ ("splitExtension (posix)" , nf APF.splitExtension posixPathAFPP) + , ("splitExtension (windows)" , nf AWF.splitExtension windowsPathAFPP) + , ("takeExtension (posix)" , nf APF.takeExtension posixPathAFPP) + , ("takeExtension (windows)" , nf AWF.takeExtension windowsPathAFPP) + , ("replaceExtension (posix)" , nf (APF.replaceExtension [OSP.pstr|.lol|]) posixPathAFPP) + , ("replaceExtension (windows)" , nf (AWF.replaceExtension [WSP.pstr|.lol|]) windowsPathAFPP) + , ("dropExtension (posix)" , nf APF.dropExtension posixPathAFPP) + , ("dropExtension (windows)" , nf AWF.dropExtension windowsPathAFPP) + , ("addExtension (posix)" , nf (APF.addExtension [OSP.pstr|.lol|]) posixPathAFPP) + , ("addExtension (windows)" , nf (AWF.addExtension [WSP.pstr|.lol|]) windowsPathAFPP) + , ("hasExtension (posix)" , nf APF.hasExtension posixPathAFPP) + , ("hasExtension (windows)" , nf AWF.hasExtension windowsPathAFPP) + , ("splitExtensions (posix)" , nf APF.splitExtensions posixPathAFPP) + , ("splitExtensions (windows)" , nf AWF.splitExtensions windowsPathAFPP) + , ("dropExtensions (posix)" , nf APF.dropExtensions posixPathAFPP) + , ("dropExtensions (windows)" , nf AWF.dropExtensions windowsPathAFPP) + , ("takeExtensions (posix)" , nf APF.takeExtensions posixPathAFPP) + , ("takeExtensions (windows)" , nf AWF.takeExtensions windowsPathAFPP) + , ("replaceExtensions (posix)" , nf (APF.replaceExtensions [OSP.pstr|.lol|]) posixPathAFPP) + , ("replaceExtensions (windows)" , nf (AWF.replaceExtensions [WSP.pstr|.lol|]) windowsPathAFPP) + , ("isExtensionOf (posix)" , nf (APF.isExtensionOf [OSP.pstr|.lol|]) posixPathAFPP) + , ("isExtensionOf (windows)" , nf (AWF.isExtensionOf [WSP.pstr|.lol|]) windowsPathAFPP) + , ("stripExtension (posix)" , nf (APF.stripExtension [OSP.pstr|.lol|]) posixPathAFPP) + , ("stripExtension (windows)" , nf (AWF.stripExtension [WSP.pstr|.lol|]) windowsPathAFPP) + + , ("splitFileName (posix)" , nf APF.splitFileName posixPathAFPP) + , ("splitFileName (windows)" , nf AWF.splitFileName windowsPathAFPP) + , ("takeFileName (posix)" , nf APF.takeFileName posixPathAFPP) + , ("takeFileName (windows)" , nf AWF.takeFileName windowsPathAFPP) + , ("replaceFileName (posix)" , nf (APF.replaceFileName [OSP.pstr|lol|]) posixPathAFPP) + , ("replaceFileName (windows)" , nf (AWF.replaceFileName [WSP.pstr|lol|]) windowsPathAFPP) + , ("dropFileName (posix)" , nf APF.dropFileName posixPathAFPP) + , ("dropFileName (windows)" , nf AWF.dropFileName windowsPathAFPP) + , ("takeBaseName (posix)" , nf APF.takeBaseName posixPathAFPP) + , ("takeBaseName (windows)" , nf AWF.takeBaseName windowsPathAFPP) + , ("replaceBaseName (posix)" , nf (APF.replaceBaseName [OSP.pstr|lol|]) posixPathAFPP) + , ("replaceBaseName (windows)" , nf (AWF.replaceBaseName [WSP.pstr|lol|]) windowsPathAFPP) + , ("takeDirectory (posix)" , nf APF.takeDirectory posixPathAFPP) + , ("takeDirectory (windows)" , nf AWF.takeDirectory windowsPathAFPP) + , ("replaceDirectory (posix)" , nf (APF.replaceDirectory [OSP.pstr|lol|]) posixPathAFPP) + , ("replaceDirectory (windows)" , nf (AWF.replaceDirectory [WSP.pstr|lol|]) windowsPathAFPP) + , ("combine (posix)" , nf (APF.combine [OSP.pstr|lol|]) posixPathAFPP) + , ("combine (windows)" , nf (AWF.combine [WSP.pstr|lol|]) windowsPathAFPP) + , ("splitPath (posix)" , nf APF.splitPath posixPathAFPP) + , ("splitPath (windows)" , nf AWF.splitPath windowsPathAFPP) + , ("joinPath (posix)" , nf APF.joinPath (APF.splitPath posixPathAFPP)) + , ("joinPath (windows)" , nf AWF.joinPath (AWF.splitPath windowsPathAFPP)) + , ("splitDirectories (posix)" , nf APF.splitDirectories posixPathAFPP) + , ("splitDirectories (windows)" , nf AWF.splitDirectories windowsPathAFPP) + + , ("splitDrive (posix)" , nf APF.splitDrive posixPathAFPP) + , ("splitDrive (windows)" , nf AWF.splitDrive windowsPathAFPP) + , ("joinDrive (posix)" , nf (APF.joinDrive [OSP.pstr|/|]) posixPathAFPP) + , ("joinDrive (windows)" , nf (AWF.joinDrive [WSP.pstr|C:\|]) windowsPathAFPP) + , ("takeDrive (posix)" , nf APF.takeDrive posixPathAFPP) + , ("takeDrive (windows)" , nf AWF.takeDrive windowsPathAFPP) + , ("hasDrive (posix)" , nf APF.hasDrive posixPathAFPP) + , ("hasDrive (windows)" , nf AWF.hasDrive windowsPathAFPP) + , ("dropDrive (posix)" , nf APF.dropDrive posixPathAFPP) + , ("dropDrive (windows)" , nf AWF.dropDrive windowsPathAFPP) + , ("isDrive (posix)" , nf APF.isDrive posixPathAFPP) + , ("isDrive (windows)" , nf AWF.isDrive windowsPathAFPP) + + , ("hasTrailingPathSeparator (posix)" , nf APF.hasTrailingPathSeparator posixPathAFPP) + , ("hasTrailingPathSeparator (windows)" , nf AWF.hasTrailingPathSeparator windowsPathAFPP) + , ("addTrailingPathSeparator (posix)" , nf APF.addTrailingPathSeparator posixPathAFPP) + , ("addTrailingPathSeparator (windows)" , nf AWF.addTrailingPathSeparator windowsPathAFPP) + , ("dropTrailingPathSeparator (posix)" , nf APF.addTrailingPathSeparator posixPathAFPP) + , ("dropTrailingPathSeparator (windows)" , nf AWF.addTrailingPathSeparator windowsPathAFPP) + + , ("normalise (posix)" , nf APF.normalise posixPathAFPP) + , ("normalise (windows)" , nf AWF.normalise windowsPathAFPP) + , ("equalFilePath (posix)" , nf (APF.equalFilePath [OSP.pstr|abc/def/zs|]) posixPathAFPP) + , ("equalFilePath (windows)" , nf (AWF.equalFilePath [WSP.pstr|abc/def/zs|]) windowsPathAFPP) + , ("makeRelative (posix)" , nf (APF.makeRelative [OSP.pstr|abc/def/zs|]) posixPathAFPP) + , ("makeRelative (windows)" , nf (AWF.makeRelative [WSP.pstr|abc/def/zs|]) windowsPathAFPP) + , ("isRelative (posix)" , nf APF.isRelative posixPathAFPP) + , ("isRelative (windows)" , nf AWF.isRelative windowsPathAFPP) + , ("isAbsolute (posix)" , nf APF.isAbsolute posixPathAFPP) + , ("isAbsolute (windows)" , nf AWF.isAbsolute windowsPathAFPP) + , ("isValid (posix)" , nf APF.isValid posixPathAFPP) + , ("isValid (windows)" , nf AWF.isValid windowsPathAFPP) + , ("makeValid (posix)" , nf APF.makeValid posixPathAFPP) + , ("makeValid (windows)" , nf AWF.makeValid windowsPathAFPP) + + , ("splitSearchPath (posix)" , nf APF.splitSearchPath posixSearchPathAFPP) + , ("splitSearchPath (windows)" , nf AWF.splitSearchPath windowsSearchPathAFPP) + ] + + , bgroup "encoding/decoding" $ map (uncurry bench) + [ ("decodeUtf (posix)" , nf (APF.decodeUtf @Maybe) posixPathAFPP) + , ("decodeUtf (windows)" , nf (AWF.decodeUtf @Maybe) windowsPathAFPP) + , ("decodeWith (windows)" , nf (AWF.decodeWith ucs2le) windowsPathAFPP) + + , ("encodeUtf (posix)" , nf (APF.encodeUtf @Maybe) posixPath) + , ("encodeUtf (windows)" , nf (AWF.encodeUtf @Maybe) windowsPath) + , ("encodeWith (windows)" , nf (AWF.encodeWith ucs2le) windowsPath) + + , ("unpack PlatformString (posix)" , nf APF.unpack posixPathAFPP) + , ("unpack PlatformString (windows)" , nf AWF.unpack windowsPathAFPP) + , ("pack PlatformString (posix)" , nf APF.pack (APF.unpack posixPathAFPP)) + , ("pack PlatformString (windows)" , nf AWF.pack (AWF.unpack windowsPathAFPP)) + + , ("fromBytes (posix)" , nf (OSP.fromBytes @Maybe) (SBS.fromShort . OST.getPosixString $ posixPathAFPP)) + , ("fromBytes (windows)" , nf (WSP.fromBytes @Maybe) (SBS.fromShort . OST.getWindowsString $ windowsPathAFPP)) + ] + ] + + +posixPath :: FilePath +posixPath = "/foo/bar/bath/baz/baz/tz/fooooooooooooooo/laaaaaaaaaaaaaaa/baaaaaaaaaaaaar/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz/kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk/kkkkkkkkkkkkkkkkkk/h/h/h/a/s/r/a/h/gt/r/r/r/s/s.txt" + +windowsPath :: FilePath +windowsPath = "C:\\foo\\bar\\bath\\baz\\baz\\tz\\fooooooooooooooo\\laaaaaaaaaaaaaaa\\baaaaaaaaaaaaar\\zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz\\zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz\\kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk\\kkkkkkkkkkkkkkkkkk\\h\\h\\h\\a\\s\\r\\a\\h\\gt\\r\\r\\r\\s\\s.txt" + +posixPathAFPP :: PosixPath +posixPathAFPP = [OSP.pstr|/foo/bar/bath/baz/baz/tz/fooooooooooooooo/laaaaaaaaaaaaaaa/baaaaaaaaaaaaar/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz/kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk/kkkkkkkkkkkkkkkkkk/h/h/h/a/s/r/a/h/gt/r/r/r/s/s.txt|] + +windowsPathAFPP :: WindowsPath +windowsPathAFPP = [WSP.pstr|C:\\foo\\bar\\bath\\baz\\baz\\tz\\fooooooooooooooo\\laaaaaaaaaaaaaaa\\baaaaaaaaaaaaar\\zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz\\zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz\\kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk\\kkkkkkkkkkkkkkkkkk\\h\\h\\h\\a\\s\\r\\a\\h\\gt\\r\\r\\r\\s\\s.txt|] + +posixSearchPath :: FilePath +posixSearchPath = ":foo:bar:bath:baz:baz:tz:fooooooooooooooo:laaaaaaaaaaaaaaa:baaaaaaaaaaaaar:zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz:zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz:kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk:kkkkkkkkkkkkkkkkkk:h:h:h:a:s:r:a:h:gt:r:r:r:s:s.txt" + +windowsSearchPath :: FilePath +windowsSearchPath = "foo;bar;bath;baz;baz;tz;fooooooooooooooo;laaaaaaaaaaaaaaa;baaaaaaaaaaaaar;zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz;zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk;kkkkkkkkkkkkkkkkkk;h;h;h;a;s;r;a;h;gt;r;r;r;s;s.txt" + +posixSearchPathAFPP :: PosixString +posixSearchPathAFPP = [OSP.pstr|:foo:bar:bath:baz:baz:tz:fooooooooooooooo:laaaaaaaaaaaaaaa:baaaaaaaaaaaaar:zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz:zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz:kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk:kkkkkkkkkkkkkkkkkk:h:h:h:a:s:r:a:h:gt:r:r:r:s:s.txt|] + +windowsSearchPathAFPP :: WindowsString +windowsSearchPathAFPP = [WSP.pstr|foo;bar;bath;baz;baz;tz;fooooooooooooooo;laaaaaaaaaaaaaaa;baaaaaaaaaaaaar;zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz;zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk;kkkkkkkkkkkkkkkkkk;h;h;h;a;s;r;a;h;gt;r;r;r;s;s.txt|] diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -2,6 +2,58 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ +## 1.5.5.0 *Jan 2026* + +* support MicroHS wrt [#257](https://github.com/haskell/filepath/pull/257) +* Switch from template-haskell to template-haskell-quasiquoter and -lift wrt [#258](https://github.com/haskell/filepath/pull/258) + +## 1.5.4.0 *Nov 2024* + +* Don't catch async exceptions in internal functions wrt https://github.com/haskell/os-string/issues/22 + +## 1.5.3.0 *Jun 2024* + +* Adjust for `encodeFS`/`decodedFS` deprecation in os-string + +## 1.5.2.0 *Jan 2024* + +* Fix a bug in `[splitFileName](https://github.com/haskell/filepath/issues/219)` +* make `osp :: QuasiQuoter` valid as a pattern wrt [#210](https://github.com/haskell/filepath/pull/210) +* Add `unsafeEncodeUtf` from os-string + +## 1.5.0.0 *Nov 2023* + +* remove `OsString` modules + +## 1.4.200.0 *Nov 2023* + +* deprecate `OsString` modules + +## 1.4.100.4 *Jul 2023* + +* Fix isInfixOf and breakSubString in Word16, wrt [#195](https://github.com/haskell/filepath/issues/195) + +## 1.4.100.3 *Feb 2023* + +* Fix a regression in `splitFileName` wrt [#189](https://github.com/haskell/filepath/pull/189) + +## 1.4.100.2 *Feb 2023* + +* Speed up `splitFileName`, `splitExtension`, `readDriveLetter` and various other helpers (up to 20x faster) by @Bodigrim + +## 1.4.100.1 *Feb 2023* + +* Fix regression in `System.FilePath.Windows.normalise` wrt [#187](https://github.com/haskell/filepath/issues/187) +* Fix tests on GHC 9.4.4 +* Avoid head and tail + +## 1.4.100.0 *July 2022* + +Implementation of the [Abstract FilePath Proposal](https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/abstract-file-path) +in user-space as a separate type. + +Introduction to the new API is explained [in this blog post](https://hasufell.github.io/posts/2022-06-29-fixing-haskell-filepaths.html). + ## 1.4.2.2 *Dec 2021* This release is purely a documentation release, fixing the broken haddock links. diff --git a/filepath.cabal b/filepath.cabal --- a/filepath.cabal +++ b/filepath.cabal @@ -1,68 +1,193 @@ -cabal-version: 1.18 -name: filepath -version: 1.4.2.2 +cabal-version: 2.2 +name: filepath +version: 1.5.5.0 + -- NOTE: Don't forget to update ./changelog.md -license: BSD3 -license-file: LICENSE -author: Neil Mitchell -maintainer: Julian Ospald -copyright: Neil Mitchell 2005-2020 -bug-reports: https://github.com/haskell/filepath/issues -homepage: https://github.com/haskell/filepath#readme -category: System -build-type: Simple -synopsis: Library for manipulating FilePaths in a cross platform way. -tested-with: GHC==9.2.1, GHC==9.0.1, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 +license: BSD-3-Clause +license-file: LICENSE +author: Neil Mitchell +maintainer: Julian Ospald +copyright: Neil Mitchell 2005-2020, Julian Ospald 2021-2022 +bug-reports: https://github.com/haskell/filepath/issues +homepage: + https://github.com/haskell/filepath/blob/master/README.md + +category: System +build-type: Simple +synopsis: Library for manipulating FilePaths in a cross platform way. +tested-with: + GHC ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.3 + || ==9.8.1 + description: - This package provides functionality for manipulating @FilePath@ values, and is shipped with both and the . It provides three modules: - . - * "System.FilePath.Posix" manipulates POSIX\/Linux style @FilePath@ values (with @\/@ as the path separator). - . - * "System.FilePath.Windows" manipulates Windows style @FilePath@ values (with either @\\@ or @\/@ as the path separator, and deals with drives). - . - * "System.FilePath" 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). + This package provides functionality for manipulating @FilePath@ values, and is shipped with . It provides two variants for filepaths: + . + 1. legacy filepaths: @type FilePath = String@ + . + 2. operating system abstracted filepaths (@OsPath@): internally unpinned @ShortByteString@ (platform-dependent encoding) + . + It is recommended to use @OsPath@ when possible, because it is more correct. + . + For each variant there are three main modules: + . + * "System.FilePath.Posix" / "System.OsPath.Posix" manipulates POSIX\/Linux style @FilePath@ values (with @\/@ as the path separator). + . + * "System.FilePath.Windows" / "System.OsPath.Windows" manipulates Windows style @FilePath@ values (with either @\\@ or @\/@ as the path separator, and deals with drives). + . + * "System.FilePath" / "System.OsPath" for dealing with current platform-specific filepaths + . + For more powerful string manipulation of @OsPath@, you can use the (@OsPath@ is a type synonym for @OsString@). + . + An introduction into the new API can be found in this + . + Code examples for the new API can be found . extra-source-files: - System/FilePath/Internal.hs - Makefile + Generate.hs + Makefile + System/FilePath/Internal.hs + System/OsPath/Common.hs + extra-doc-files: - README.md - HACKING.md - changelog.md + changelog.md + HACKING.md + README.md +flag cpphs + description: Use cpphs (fixes haddock source links) + default: False + manual: True + source-repository head - type: git - location: https://github.com/haskell/filepath.git + type: git + location: https://github.com/haskell/filepath library - default-language: Haskell2010 - other-extensions: - CPP - PatternGuards - if impl(GHC >= 7.2) - other-extensions: Safe + exposed-modules: + System.FilePath + System.FilePath.Posix + System.FilePath.Windows + System.OsPath + System.OsPath.Encoding + System.OsPath.Internal + System.OsPath.Posix + System.OsPath.Posix.Internal + System.OsPath.Types + System.OsPath.Windows + System.OsPath.Windows.Internal - exposed-modules: - System.FilePath - System.FilePath.Posix - System.FilePath.Windows + other-extensions: + CPP + PatternGuards - build-depends: - base >= 4.9 && < 4.17 + if impl(ghc >=7.2) + other-extensions: Safe - ghc-options: -Wall + default-language: Haskell2010 + build-depends: + , base >=4.12.0.0 && <4.23 + , bytestring >=0.11.3.0 + , deepseq + , exceptions + , os-string >=2.0.1 + -- template-haskell-lift was added as a boot library in GHC-9.14 + -- once we no longer wish to backport releases to older major releases, + -- this conditional can be dropped + if impl(ghc < 9.14) + build-depends: template-haskell + elif impl(ghc) + build-depends: + , template-haskell-lift >=0.1 && <0.2 + , template-haskell-quasiquoter >=0.1 && <0.2 + ghc-options: -Wall + + if flag(cpphs) + ghc-options: -pgmPcpphs -optP--cpp + build-tool-depends: cpphs:cpphs -any + test-suite filepath-tests - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Test.hs - hs-source-dirs: tests - other-modules: - TestGen - TestUtil - build-depends: - filepath, - base, - QuickCheck >= 2.7 && < 2.15 + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: tests tests/filepath-tests + other-modules: + TestGen + TestUtil + + build-depends: + , base + , bytestring >=0.11.3.0 + , filepath + , os-string >=2.0.1 + , tasty + , tasty-quickcheck + + default-language: Haskell2010 + ghc-options: -Wall + +test-suite filepath-equivalent-tests + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: TestEquiv.hs + hs-source-dirs: tests tests/filepath-equivalent-tests + other-modules: + Legacy.System.FilePath + Legacy.System.FilePath.Posix + Legacy.System.FilePath.Windows + TestUtil + Gen + + build-depends: + , base + , bytestring >=0.11.3.0 + , filepath + , generic-random + , generic-deriving + , os-string >=2.0.1 + , tasty + , tasty-quickcheck + , QuickCheck + +test-suite abstract-filepath + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: tests tests/abstract-filepath + other-modules: + Arbitrary + OsPathSpec + TestUtil + + build-depends: + , base + , bytestring >=0.11.3.0 + , deepseq + , filepath + , os-string >=2.0.1 + , quickcheck-classes-base ^>=0.6.2 + , tasty + , tasty-quickcheck + +benchmark bench-filepath + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: BenchFilePath.hs + hs-source-dirs: bench + build-depends: + , base + , bytestring >=0.11.3.0 + , deepseq + , filepath + , os-string >=2.0.1 + , tasty-bench + + ghc-options: -with-rtsopts=-A32m diff --git a/tests/Test.hs b/tests/Test.hs deleted file mode 100644 --- a/tests/Test.hs +++ /dev/null @@ -1,30 +0,0 @@ - -module Main where - -import System.Environment -import TestGen -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 total = length tests - let showOutput x = show x{output=""} ++ "\n" ++ output x - bad <- fmap catMaybes $ forM (zip [1..] tests) $ \(i,(msg,prop)) -> do - putStrLn $ "Test " ++ show i ++ " of " ++ show total ++ ": " ++ msg - res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop - case res of - Success{} -> pure Nothing - bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ 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/TestGen.hs b/tests/TestGen.hs deleted file mode 100644 --- a/tests/TestGen.hs +++ /dev/null @@ -1,466 +0,0 @@ --- GENERATED CODE: See ../Generate.hs -module TestGen(tests) where -import TestUtil -import qualified System.FilePath.Windows as W -import qualified System.FilePath.Posix as P -{-# ANN module "HLint: ignore" #-} -tests :: [(String, Property)] -tests = - [("W.pathSeparator == '\\\\'", property $ W.pathSeparator == '\\') - ,("P.pathSeparator == '/'", property $ P.pathSeparator == '/') - ,("P.isPathSeparator P.pathSeparator", property $ P.isPathSeparator P.pathSeparator) - ,("W.isPathSeparator W.pathSeparator", property $ W.isPathSeparator W.pathSeparator) - ,("W.pathSeparators == ['\\\\', '/']", property $ W.pathSeparators == ['\\', '/']) - ,("P.pathSeparators == ['/']", property $ P.pathSeparators == ['/']) - ,("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 == ';'", property $ W.searchPathSeparator == ';') - ,("P.searchPathSeparator == ':'", property $ P.searchPathSeparator == ':') - ,("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 == '.'", property $ P.extSeparator == '.') - ,("W.extSeparator == '.'", property $ W.extSeparator == '.') - ,("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.splitSearchPath \"File1:File2:File3\" == [\"File1\", \"File2\", \"File3\"]", property $ P.splitSearchPath "File1:File2:File3" == ["File1", "File2", "File3"]) - ,("P.splitSearchPath \"File1::File2:File3\" == [\"File1\", \".\", \"File2\", \"File3\"]", property $ P.splitSearchPath "File1::File2:File3" == ["File1", ".", "File2", "File3"]) - ,("W.splitSearchPath \"File1;File2;File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;File2;File3" == ["File1", "File2", "File3"]) - ,("W.splitSearchPath \"File1;;File2;File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;;File2;File3" == ["File1", "File2", "File3"]) - ,("W.splitSearchPath \"File1;\\\"File2\\\";File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;\"File2\";File3" == ["File1", "File2", "File3"]) - ,("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 x) -> uncurry (++) (P.splitExtension x) == x) - ,("uncurry (++) (W.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (++) (W.splitExtension x) == x) - ,("uncurry P.addExtension (P.splitExtension x) == x", property $ \(QFilePathValidP x) -> uncurry P.addExtension (P.splitExtension x) == x) - ,("uncurry W.addExtension (W.splitExtension x) == x", property $ \(QFilePathValidW x) -> 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 x) -> P.takeExtension x == snd (P.splitExtension x)) - ,("W.takeExtension x == snd (W.splitExtension x)", property $ \(QFilePath x) -> W.takeExtension x == snd (W.splitExtension x)) - ,("P.takeExtension (P.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeExtension (P.addExtension x "ext") == ".ext") - ,("W.takeExtension (W.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeExtension (W.addExtension x "ext") == ".ext") - ,("P.takeExtension (P.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeExtension (P.replaceExtension x "ext") == ".ext") - ,("W.takeExtension (W.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> 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 x) (QFilePath y) -> P.replaceExtension x y == P.addExtension (P.dropExtension x) y) - ,("W.replaceExtension x y == W.addExtension (W.dropExtension x) y", property $ \(QFilePath x) (QFilePath y) -> 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 x) -> P.dropExtension x == fst (P.splitExtension x)) - ,("W.dropExtension x == fst (W.splitExtension x)", property $ \(QFilePath x) -> 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 x) -> P.addExtension x "" == x) - ,("W.addExtension x \"\" == x", property $ \(QFilePath x) -> W.addExtension x "" == x) - ,("P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) "ext") == ".ext") - ,("W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> 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 x) -> null (P.takeExtension x) == not (P.hasExtension x)) - ,("null (W.takeExtension x) == not (W.hasExtension x)", property $ \(QFilePath x) -> 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 x) -> P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)) - ,("W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)", property $ \(QFilePath x) -> W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)) - ,("P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)", property $ \(QFilePath x) -> P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)) - ,("W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)", property $ \(QFilePath x) -> 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 x) -> P.stripExtension "" x == Just x) - ,("W.stripExtension \"\" x == Just x", property $ \(QFilePath x) -> 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 x) -> uncurry (++) (P.splitExtensions x) == x) - ,("uncurry (++) (W.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (++) (W.splitExtensions x) == x) - ,("uncurry P.addExtension (P.splitExtensions x) == x", property $ \(QFilePathValidP x) -> uncurry P.addExtension (P.splitExtensions x) == x) - ,("uncurry W.addExtension (W.splitExtensions x) == x", property $ \(QFilePathValidW x) -> 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 x) -> not $ P.hasExtension $ P.dropExtensions x) - ,("not $ W.hasExtension $ W.dropExtensions x", property $ \(QFilePath x) -> not $ W.hasExtension $ W.dropExtensions x) - ,("not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x", property $ \(QFilePath x) -> not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x) - ,("not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x", property $ \(QFilePath x) -> 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 x) -> uncurry (++) (P.splitDrive x) == x) - ,("uncurry (++) (W.splitDrive x) == x", property $ \(QFilePath x) -> 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 x) -> uncurry P.joinDrive (P.splitDrive x) == x) - ,("uncurry W.joinDrive (W.splitDrive x) == x", property $ \(QFilePathValidW x) -> 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 x) -> P.takeDrive x == fst (P.splitDrive x)) - ,("W.takeDrive x == fst (W.splitDrive x)", property $ \(QFilePath x) -> W.takeDrive x == fst (W.splitDrive x)) - ,("P.dropDrive x == snd (P.splitDrive x)", property $ \(QFilePath x) -> P.dropDrive x == snd (P.splitDrive x)) - ,("W.dropDrive x == snd (W.splitDrive x)", property $ \(QFilePath x) -> W.dropDrive x == snd (W.splitDrive x)) - ,("not (P.hasDrive x) == null (P.takeDrive x)", property $ \(QFilePath x) -> not (P.hasDrive x) == null (P.takeDrive x)) - ,("not (W.hasDrive x) == null (W.takeDrive x)", property $ \(QFilePath x) -> 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 x) -> uncurry (P.) (P.splitFileName x) == x || fst (P.splitFileName x) == "./") - ,("uncurry (W.) (W.splitFileName x) == x || fst (W.splitFileName x) == \"./\"", property $ \(QFilePathValidW x) -> uncurry (W.) (W.splitFileName x) == x || fst (W.splitFileName x) == "./") - ,("P.isValid (fst (P.splitFileName x))", property $ \(QFilePathValidP x) -> P.isValid (fst (P.splitFileName x))) - ,("W.isValid (fst (W.splitFileName x))", property $ \(QFilePathValidW x) -> 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 x) -> P.replaceFileName x (P.takeFileName x) == x) - ,("W.replaceFileName x (W.takeFileName x) == x", property $ \(QFilePathValidW x) -> 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 x) -> P.dropFileName x == fst (P.splitFileName x)) - ,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath x) -> 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 x) -> P.takeFileName x `isSuffixOf` x) - ,("W.takeFileName x `isSuffixOf` x", property $ \(QFilePath x) -> W.takeFileName x `isSuffixOf` x) - ,("P.takeFileName x == snd (P.splitFileName x)", property $ \(QFilePath x) -> P.takeFileName x == snd (P.splitFileName x)) - ,("W.takeFileName x == snd (W.splitFileName x)", property $ \(QFilePath x) -> W.takeFileName x == snd (W.splitFileName x)) - ,("P.takeFileName (P.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidP x) -> P.takeFileName (P.replaceFileName x "fred") == "fred") - ,("W.takeFileName (W.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidW x) -> W.takeFileName (W.replaceFileName x "fred") == "fred") - ,("P.takeFileName (x P. \"fred\") == \"fred\"", property $ \(QFilePathValidP x) -> P.takeFileName (x P. "fred") == "fred") - ,("W.takeFileName (x W. \"fred\") == \"fred\"", property $ \(QFilePathValidW x) -> W.takeFileName (x W. "fred") == "fred") - ,("P.isRelative (P.takeFileName x)", property $ \(QFilePathValidP x) -> P.isRelative (P.takeFileName x)) - ,("W.isRelative (W.takeFileName x)", property $ \(QFilePathValidW x) -> 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 x) -> P.takeBaseName (P.addTrailingPathSeparator x) == "") - ,("W.takeBaseName (W.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath x) -> 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 x) -> P.replaceBaseName x (P.takeBaseName x) == x) - ,("W.replaceBaseName x (W.takeBaseName x) == x", property $ \(QFilePathValidW x) -> 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 x) -> P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)) - ,("W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)", property $ \(QFilePath x) -> W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)) - ,("P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x) - ,("W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> 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 x) -> 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 x) -> P.takeDirectory x `isPrefixOf` x || P.takeDirectory x == ".") - ,("W.takeDirectory x `isPrefixOf` x || W.takeDirectory x == \".\"", property $ \(QFilePath x) -> 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") - ,("P.replaceDirectory x (P.takeDirectory x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> P.replaceDirectory x (P.takeDirectory x) `P.equalFilePath` x) - ,("W.replaceDirectory x (W.takeDirectory x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> W.replaceDirectory x (W.takeDirectory x) `W.equalFilePath` x) - ,("\"/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.takeDirectory x P. P.takeFileName x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> (P.takeDirectory x P. P.takeFileName x) `P.equalFilePath` x) - ,("(W.takeDirectory x W. W.takeFileName x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> (W.takeDirectory x W. W.takeFileName x) `W.equalFilePath` x) - ,("\"/\" 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"]) - ,("concat (P.splitPath x) == x", property $ \(QFilePath x) -> concat (P.splitPath x) == x) - ,("concat (W.splitPath x) == x", property $ \(QFilePath x) -> concat (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.joinPath (P.splitDirectories x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> P.joinPath (P.splitDirectories x) `P.equalFilePath` x) - ,("W.joinPath (W.splitDirectories x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> W.joinPath (W.splitDirectories x) `W.equalFilePath` x) - ,("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 a == foldr (P.) \"\" a", property $ \a -> P.joinPath a == foldr (P.) "" a) - ,("W.joinPath a == foldr (W.) \"\" a", property $ \a -> W.joinPath a == foldr (W.) "" a) - ,("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 x) -> P.joinPath (P.splitPath x) == x) - ,("W.joinPath (W.splitPath x) == x", property $ \(QFilePathValidW x) -> 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") - ,("x == y ==> P.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> x == y ==> P.equalFilePath x y) - ,("x == y ==> W.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> x == y ==> W.equalFilePath x y) - ,("P.normalise x == P.normalise y ==> P.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> P.normalise x == P.normalise y ==> P.equalFilePath x y) - ,("W.normalise x == W.normalise y ==> W.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> W.normalise x == W.normalise y ==> W.equalFilePath x y) - ,("P.equalFilePath \"foo\" \"foo/\"", property $ P.equalFilePath "foo" "foo/") - ,("W.equalFilePath \"foo\" \"foo/\"", property $ W.equalFilePath "foo" "foo/") - ,("not (P.equalFilePath \"/a/../c\" \"/c\")", property $ not (P.equalFilePath "/a/../c" "/c")) - ,("not (W.equalFilePath \"/a/../c\" \"/c\")", property $ not (W.equalFilePath "/a/../c" "/c")) - ,("not (P.equalFilePath \"foo\" \"/foo\")", property $ not (P.equalFilePath "foo" "/foo")) - ,("not (W.equalFilePath \"foo\" \"/foo\")", property $ not (W.equalFilePath "foo" "/foo")) - ,("not (P.equalFilePath \"foo\" \"FOO\")", property $ not (P.equalFilePath "foo" "FOO")) - ,("W.equalFilePath \"foo\" \"FOO\"", property $ W.equalFilePath "foo" "FOO") - ,("not (W.equalFilePath \"C:\" \"C:/\")", property $ not (W.equalFilePath "C:" "C:/")) - ,("P.makeRelative \"/directory\" \"/directory/file.ext\" == \"file.ext\"", property $ P.makeRelative "/directory" "/directory/file.ext" == "file.ext") - ,("W.makeRelative \"/directory\" \"/directory/file.ext\" == \"file.ext\"", property $ W.makeRelative "/directory" "/directory/file.ext" == "file.ext") - ,("P.makeRelative (P.takeDirectory x) x `P.equalFilePath` P.takeFileName x", property $ \(QFilePathValidP x) -> P.makeRelative (P.takeDirectory x) x `P.equalFilePath` P.takeFileName x) - ,("W.makeRelative (W.takeDirectory x) x `W.equalFilePath` W.takeFileName x", property $ \(QFilePathValidW x) -> W.makeRelative (W.takeDirectory x) x `W.equalFilePath` W.takeFileName x) - ,("P.makeRelative x x == \".\"", property $ \(QFilePath x) -> P.makeRelative x x == ".") - ,("W.makeRelative x x == \".\"", property $ \(QFilePath x) -> W.makeRelative x x == ".") - ,("P.equalFilePath x y || (P.isRelative x && P.makeRelative y x == x) || P.equalFilePath (y P. P.makeRelative y x) x", property $ \(QFilePathValidP x) (QFilePathValidP y) -> P.equalFilePath x y || (P.isRelative x && P.makeRelative y x == x) || P.equalFilePath (y P. P.makeRelative y x) x) - ,("W.equalFilePath x y || (W.isRelative x && W.makeRelative y x == x) || W.equalFilePath (y W. W.makeRelative y x) x", property $ \(QFilePathValidW x) (QFilePathValidW y) -> W.equalFilePath x y || (W.isRelative x && W.makeRelative y x == x) || W.equalFilePath (y W. W.makeRelative y x) x) - ,("W.makeRelative \"C:\\\\Home\" \"c:\\\\home\\\\bob\" == \"bob\"", property $ W.makeRelative "C:\\Home" "c:\\home\\bob" == "bob") - ,("W.makeRelative \"C:\\\\Home\" \"c:/home/bob\" == \"bob\"", property $ W.makeRelative "C:\\Home" "c:/home/bob" == "bob") - ,("W.makeRelative \"C:\\\\Home\" \"D:\\\\Home\\\\Bob\" == \"D:\\\\Home\\\\Bob\"", property $ W.makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob") - ,("W.makeRelative \"C:\\\\Home\" \"C:Home\\\\Bob\" == \"C:Home\\\\Bob\"", property $ W.makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob") - ,("W.makeRelative \"/Home\" \"/home/bob\" == \"bob\"", property $ W.makeRelative "/Home" "/home/bob" == "bob") - ,("W.makeRelative \"/\" \"//\" == \"//\"", property $ W.makeRelative "/" "//" == "//") - ,("P.makeRelative \"/Home\" \"/home/bob\" == \"/home/bob\"", property $ P.makeRelative "/Home" "/home/bob" == "/home/bob") - ,("P.makeRelative \"/home/\" \"/home/bob/foo/bar\" == \"bob/foo/bar\"", property $ P.makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar") - ,("P.makeRelative \"/fred\" \"bob\" == \"bob\"", property $ P.makeRelative "/fred" "bob" == "bob") - ,("P.makeRelative \"/file/test\" \"/file/test/fred\" == \"fred\"", property $ P.makeRelative "/file/test" "/file/test/fred" == "fred") - ,("P.makeRelative \"/file/test\" \"/file/test/fred/\" == \"fred/\"", property $ P.makeRelative "/file/test" "/file/test/fred/" == "fred/") - ,("P.makeRelative \"some/path\" \"some/path/a/b/c\" == \"a/b/c\"", property $ P.makeRelative "some/path" "some/path/a/b/c" == "a/b/c") - ,("P.normalise \"/file/\\\\test////\" == \"/file/\\\\test/\"", property $ P.normalise "/file/\\test////" == "/file/\\test/") - ,("P.normalise \"/file/./test\" == \"/file/test\"", property $ P.normalise "/file/./test" == "/file/test") - ,("P.normalise \"/test/file/../bob/fred/\" == \"/test/file/../bob/fred/\"", property $ P.normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/") - ,("P.normalise \"../bob/fred/\" == \"../bob/fred/\"", property $ P.normalise "../bob/fred/" == "../bob/fred/") - ,("P.normalise \"/a/../c\" == \"/a/../c\"", property $ P.normalise "/a/../c" == "/a/../c") - ,("P.normalise \"./bob/fred/\" == \"bob/fred/\"", property $ P.normalise "./bob/fred/" == "bob/fred/") - ,("W.normalise \"c:\\\\file/bob\\\\\" == \"C:\\\\file\\\\bob\\\\\"", property $ W.normalise "c:\\file/bob\\" == "C:\\file\\bob\\") - ,("W.normalise \"c:\\\\\" == \"C:\\\\\"", property $ W.normalise "c:\\" == "C:\\") - ,("W.normalise \"C:.\\\\\" == \"C:\"", property $ W.normalise "C:.\\" == "C:") - ,("W.normalise \"\\\\\\\\server\\\\test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "\\\\server\\test" == "\\\\server\\test") - ,("W.normalise \"//server/test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "//server/test" == "\\\\server\\test") - ,("W.normalise \"c:/file\" == \"C:\\\\file\"", property $ W.normalise "c:/file" == "C:\\file") - ,("W.normalise \"/file\" == \"\\\\file\"", property $ W.normalise "/file" == "\\file") - ,("W.normalise \"\\\\\" == \"\\\\\"", property $ W.normalise "\\" == "\\") - ,("W.normalise \"/./\" == \"\\\\\"", property $ W.normalise "/./" == "\\") - ,("P.normalise \".\" == \".\"", property $ P.normalise "." == ".") - ,("W.normalise \".\" == \".\"", property $ W.normalise "." == ".") - ,("P.normalise \"./\" == \"./\"", property $ P.normalise "./" == "./") - ,("P.normalise \"./.\" == \"./\"", property $ P.normalise "./." == "./") - ,("P.normalise \"/./\" == \"/\"", property $ P.normalise "/./" == "/") - ,("P.normalise \"/\" == \"/\"", property $ P.normalise "/" == "/") - ,("P.normalise \"bob/fred/.\" == \"bob/fred/\"", property $ P.normalise "bob/fred/." == "bob/fred/") - ,("P.normalise \"//home\" == \"/home\"", property $ P.normalise "//home" == "/home") - ,("P.isValid \"\" == False", property $ P.isValid "" == False) - ,("W.isValid \"\" == False", property $ W.isValid "" == False) - ,("P.isValid \"\\0\" == False", property $ P.isValid "\0" == False) - ,("W.isValid \"\\0\" == False", property $ W.isValid "\0" == False) - ,("P.isValid \"/random_ path:*\" == True", property $ P.isValid "/random_ path:*" == True) - ,("P.isValid x == not (null x)", property $ \(QFilePath x) -> P.isValid x == not (null x)) - ,("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) - ,("P.isValid (P.makeValid x)", property $ \(QFilePath x) -> P.isValid (P.makeValid x)) - ,("W.isValid (W.makeValid x)", property $ \(QFilePath x) -> W.isValid (W.makeValid x)) - ,("P.isValid x ==> P.makeValid x == x", property $ \(QFilePath x) -> P.isValid x ==> P.makeValid x == x) - ,("W.isValid x ==> W.makeValid x == x", property $ \(QFilePath x) -> W.isValid x ==> W.makeValid x == x) - ,("P.makeValid \"\" == \"_\"", property $ P.makeValid "" == "_") - ,("W.makeValid \"\" == \"_\"", property $ W.makeValid "" == "_") - ,("P.makeValid \"file\\0name\" == \"file_name\"", property $ P.makeValid "file\0name" == "file_name") - ,("W.makeValid \"file\\0name\" == \"file_name\"", property $ W.makeValid "file\0name" == "file_name") - ,("W.makeValid \"c:\\\\already\\\\/valid\" == \"c:\\\\already\\\\/valid\"", property $ W.makeValid "c:\\already\\/valid" == "c:\\already\\/valid") - ,("W.makeValid \"c:\\\\test:of_test\" == \"c:\\\\test_of_test\"", property $ W.makeValid "c:\\test:of_test" == "c:\\test_of_test") - ,("W.makeValid \"test*\" == \"test_\"", property $ W.makeValid "test*" == "test_") - ,("W.makeValid \"c:\\\\test\\\\nul\" == \"c:\\\\test\\\\nul_\"", property $ W.makeValid "c:\\test\\nul" == "c:\\test\\nul_") - ,("W.makeValid \"c:\\\\test\\\\prn.txt\" == \"c:\\\\test\\\\prn_.txt\"", property $ W.makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt") - ,("W.makeValid \"c:\\\\test/prn.txt\" == \"c:\\\\test/prn_.txt\"", property $ W.makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt") - ,("W.makeValid \"c:\\\\nul\\\\file\" == \"c:\\\\nul_\\\\file\"", property $ W.makeValid "c:\\nul\\file" == "c:\\nul_\\file") - ,("W.makeValid \"\\\\\\\\\\\\foo\" == \"\\\\\\\\drive\"", property $ W.makeValid "\\\\\\foo" == "\\\\drive") - ,("W.makeValid \"\\\\\\\\?\\\\D:file\" == \"\\\\\\\\?\\\\D:\\\\file\"", property $ W.makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file") - ,("W.makeValid \"nul .txt\" == \"nul _.txt\"", property $ W.makeValid "nul .txt" == "nul _.txt") - ,("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 x) -> P.isAbsolute x == not (P.isRelative x)) - ,("W.isAbsolute x == not (W.isRelative x)", property $ \(QFilePath x) -> W.isAbsolute x == not (W.isRelative x)) - ] diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs --- a/tests/TestUtil.hs +++ b/tests/TestUtil.hs @@ -1,19 +1,38 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module TestUtil( - (==>), QFilePath(..), QFilePathValidW(..), QFilePathValidP(..), - module Test.QuickCheck, + module TestUtil, + module Test.Tasty.QuickCheck, module Data.List, module Data.Maybe ) where -import Test.QuickCheck hiding ((==>)) +import Test.Tasty.QuickCheck hiding ((==>)) +import Data.ByteString.Short (ShortByteString) import Data.List import Data.Maybe import Control.Monad import qualified System.FilePath.Windows as W import qualified System.FilePath.Posix as P +#ifdef GHC_MAKE +import qualified System.OsPath.Windows.Internal as AFP_W +import qualified System.OsPath.Posix.Internal as AFP_P +#else +import qualified System.OsPath.Windows as AFP_W +import qualified System.OsPath.Posix as AFP_P +import System.OsPath.Types +#endif +import System.OsString.Internal.Types +import System.OsString.Encoding.Internal +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import GHC.IO.Encoding.Failure + infixr 0 ==> +(==>) :: Bool -> Bool -> Bool a ==> b = not a || b @@ -50,3 +69,91 @@ | 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') + +encodeUtf16LE :: String -> ShortByteString +encodeUtf16LE = either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure) + +encodeUtf8 :: String -> ShortByteString +encodeUtf8 = either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure) + +decodeUtf16LE :: ShortByteString -> String +decodeUtf16LE = either (error . show) id . decodeWithTE (mkUTF16le TransliterateCodingFailure) + +decodeUtf8 :: ShortByteString -> String +decodeUtf8 = either (error . show) id . decodeWithTE (mkUTF8 TransliterateCodingFailure) + +#ifdef GHC_MAKE +newtype QFilePathValidAFP_W = QFilePathValidAFP_W ShortByteString deriving Show + +instance Arbitrary QFilePathValidAFP_W where + arbitrary = fmap (QFilePathValidAFP_W . AFP_W.makeValid . encodeUtf16LE) arbitraryFilePath + shrink (QFilePathValidAFP_W x) = shrinkValid (QFilePathValidAFP_W . encodeUtf16LE) (decodeUtf16LE . AFP_W.makeValid . encodeUtf16LE) (decodeUtf16LE x) + +newtype QFilePathValidAFP_P = QFilePathValidAFP_P ShortByteString deriving Show + +instance Arbitrary QFilePathValidAFP_P where + arbitrary = fmap (QFilePathValidAFP_P . AFP_P.makeValid . encodeUtf8) arbitraryFilePath + shrink (QFilePathValidAFP_P x) = shrinkValid (QFilePathValidAFP_P . encodeUtf8) (decodeUtf8 . AFP_P.makeValid . encodeUtf8) (decodeUtf8 x) + +newtype QFilePathAFP_W = QFilePathAFP_W ShortByteString deriving Show +newtype QFilePathAFP_P = QFilePathAFP_P ShortByteString deriving Show + +instance Arbitrary QFilePathAFP_W where + arbitrary = fmap (QFilePathAFP_W . encodeUtf16LE) arbitraryFilePath + shrink (QFilePathAFP_W x) = shrinkValid (QFilePathAFP_W . encodeUtf16LE) id (decodeUtf16LE x) + +instance Arbitrary QFilePathAFP_P where + arbitrary = fmap (QFilePathAFP_P . encodeUtf8) arbitraryFilePath + shrink (QFilePathAFP_P x) = shrinkValid (QFilePathAFP_P . encodeUtf8) id (decodeUtf8 x) + +newtype QFilePathsAFP_W = QFilePathsAFP_W [ShortByteString] deriving Show +newtype QFilePathsAFP_P = QFilePathsAFP_P [ShortByteString] deriving Show + +instance Arbitrary QFilePathsAFP_W where + arbitrary = fmap (QFilePathsAFP_W . fmap encodeUtf16LE) (listOf arbitraryFilePath) + +instance Arbitrary QFilePathsAFP_P where + arbitrary = fmap (QFilePathsAFP_P . fmap encodeUtf8) (listOf arbitraryFilePath) + +#else + + +newtype QFilePathValidAFP_W = QFilePathValidAFP_W WindowsPath deriving Show + +instance Arbitrary QFilePathValidAFP_W where + arbitrary = fmap (QFilePathValidAFP_W . AFP_W.makeValid . WS . encodeUtf16LE) arbitraryFilePath + shrink (QFilePathValidAFP_W x) = shrinkValid (QFilePathValidAFP_W . WS . encodeUtf16LE) (decodeUtf16LE . getWindowsString . AFP_W.makeValid . WS . encodeUtf16LE) (decodeUtf16LE . getWindowsString $ x) + +newtype QFilePathValidAFP_P = QFilePathValidAFP_P PosixPath deriving Show + +instance Arbitrary QFilePathValidAFP_P where + arbitrary = fmap (QFilePathValidAFP_P . AFP_P.makeValid . PS . encodeUtf8) arbitraryFilePath + shrink (QFilePathValidAFP_P x) = shrinkValid (QFilePathValidAFP_P . PS . encodeUtf8) (decodeUtf8 . getPosixString . AFP_P.makeValid . PS . encodeUtf8) (decodeUtf8 . getPosixString $ x) + +newtype QFilePathAFP_W = QFilePathAFP_W WindowsPath deriving Show +newtype QFilePathAFP_P = QFilePathAFP_P PosixPath deriving Show + +instance Arbitrary QFilePathAFP_W where + arbitrary = fmap (QFilePathAFP_W . WS . encodeUtf16LE) arbitraryFilePath + shrink (QFilePathAFP_W x) = shrinkValid (QFilePathAFP_W . WS . encodeUtf16LE) id (decodeUtf16LE . getWindowsString $ x) + +instance Arbitrary QFilePathAFP_P where + arbitrary = fmap (QFilePathAFP_P . PS . encodeUtf8) arbitraryFilePath + shrink (QFilePathAFP_P x) = shrinkValid (QFilePathAFP_P . PS . encodeUtf8) id (decodeUtf8 . getPosixString $ x) + +newtype QFilePathsAFP_W = QFilePathsAFP_W [WindowsPath] deriving Show +newtype QFilePathsAFP_P = QFilePathsAFP_P [PosixPath] deriving Show + +instance Arbitrary QFilePathsAFP_W where + arbitrary = fmap (QFilePathsAFP_W . fmap (WS . encodeUtf16LE)) (listOf arbitraryFilePath) + +instance Arbitrary QFilePathsAFP_P where + arbitrary = fmap (QFilePathsAFP_P . fmap (PS . encodeUtf8)) (listOf arbitraryFilePath) + +instance Arbitrary WindowsChar where + arbitrary = WW <$> arbitrary + +instance Arbitrary PosixChar where + arbitrary = PW <$> arbitrary +#endif + diff --git a/tests/abstract-filepath/Arbitrary.hs b/tests/abstract-filepath/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/tests/abstract-filepath/Arbitrary.hs @@ -0,0 +1,69 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Arbitrary where + +import Data.Char +import Data.Maybe +import System.OsString +import System.OsString.Internal.Types +import qualified System.OsString.Posix as Posix +import qualified System.OsString.Windows as Windows +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as ByteString +import Test.Tasty.QuickCheck + + +instance Arbitrary OsString where + arbitrary = fmap fromJust $ encodeUtf <$> listOf filepathChar + +instance Arbitrary PosixString where + arbitrary = fmap fromJust $ Posix.encodeUtf <$> listOf filepathChar + +instance Arbitrary WindowsString where + arbitrary = fmap fromJust $ Windows.encodeUtf <$> listOf filepathChar + + +newtype NonNullString = NonNullString { nonNullString :: String } + deriving Show + +instance Arbitrary NonNullString where + arbitrary = NonNullString <$> listOf filepathChar + +filepathChar :: Gen Char +filepathChar = arbitraryUnicodeChar `suchThat` (\c -> not (isNull c) && isValidUnicode c) + where + isNull = (== '\NUL') + isValidUnicode c = case generalCategory c of + Surrogate -> False + NotAssigned -> False + _ -> True + + +newtype NonNullAsciiString = NonNullAsciiString { nonNullAsciiString :: String } + deriving Show + +instance Arbitrary NonNullAsciiString where + arbitrary = NonNullAsciiString <$> listOf filepathAsciiChar + +filepathAsciiChar :: Gen Char +filepathAsciiChar = arbitraryASCIIChar `suchThat` (\c -> not (isNull c)) + where + isNull = (== '\NUL') + +newtype NonNullSurrogateString = NonNullSurrogateString { nonNullSurrogateString :: String } + deriving Show + +instance Arbitrary NonNullSurrogateString where + arbitrary = NonNullSurrogateString <$> listOf filepathWithSurrogates + +filepathWithSurrogates :: Gen Char +filepathWithSurrogates = + frequency + [(3, arbitraryASCIIChar), + (1, arbitraryUnicodeChar), + (1, arbitraryBoundedEnum) + ] + + +instance Arbitrary ByteString where arbitrary = ByteString.pack <$> arbitrary +instance CoArbitrary ByteString where coarbitrary = coarbitrary . ByteString.unpack diff --git a/tests/abstract-filepath/OsPathSpec.hs b/tests/abstract-filepath/OsPathSpec.hs new file mode 100644 --- /dev/null +++ b/tests/abstract-filepath/OsPathSpec.hs @@ -0,0 +1,261 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE QuasiQuotes #-} + +module OsPathSpec where + +import Data.Maybe + +import System.OsPath as OSP +import System.OsString.Internal.Types +import System.OsPath.Posix as Posix +import System.OsPath.Windows as Windows +import System.OsPath.Encoding +import qualified System.OsString.Internal.Types as OS +import System.OsString.Data.ByteString.Short ( toShort ) +import System.OsString.Posix as PosixS hiding (map) +import System.OsString.Windows as WindowsS hiding (map) + +import Control.Exception +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import qualified Test.QuickCheck.Classes.Base as QC +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import GHC.IO.Encoding ( setFileSystemEncoding ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import Control.DeepSeq +import Data.Bifunctor ( first ) +import qualified Data.ByteString.Char8 as C +import qualified System.OsString.Data.ByteString.Short.Word16 as BS16 +import qualified System.OsString.Data.ByteString.Short as SBS +import Data.Char ( ord ) +import Data.Proxy ( Proxy(..) ) +import Test.Tasty +import Test.Tasty.QuickCheck + +import Arbitrary + + +fromRight :: b -> Either a b -> b +fromRight _ (Right b) = b +fromRight b _ = b + + +tests :: TestTree +tests = testGroup "Abstract filepath" [ + testGroup "filepaths" + [ testProperties "OSP" + [ ("pack . unpack == id", + property $ \ws@(OsString _) -> + OSP.pack (OSP.unpack ws) === ws + ), + ("encodeUtf . decodeUtf == id", + property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str) + ], + testProperties "Windows" + [ ("pack . unpack == id (Windows)", + property $ \ws@(WindowsString _) -> + Windows.pack (Windows.unpack ws) === ws + ) + , ("decodeUtf . encodeUtf == id", + property $ \(NonNullString str) -> (Windows.decodeUtf . fromJust . Windows.encodeUtf) str == Just str) + , ("encodeWith ucs2le . decodeWith ucs2le == id", + property $ \(padEven -> bs) -> (Windows.encodeWith ucs2le . (\(Right r) -> r) . Windows.decodeWith ucs2le . OS.WS . toShort) bs + === Right (OS.WS . toShort $ bs)) + , ("decodeFS . encodeFS == id (Windows)", + property $ \(NonNullString str) -> ioProperty $ do + r1 <- Windows.encodeFS str + r2 <- try @SomeException $ Windows.decodeFS r1 + r3 <- evaluate $ force $ first displayException r2 + pure (r3 === Right str) + ) + , ("fromPlatformString* functions are equivalent under ASCII", + property $ \(WindowsString . BS16.pack . map (fromIntegral . ord) . nonNullAsciiString -> str) -> ioProperty $ do + r1 <- Windows.decodeFS str + r2 <- Windows.decodeUtf str + (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) str + (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) str + (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) str + pure ( r1 === r2 + .&&. r1 === r3 + .&&. r1 === r4 + .&&. r1 === r5 + ) + ) + , ("toPlatformString* functions are equivalent under ASCII", + property $ \(NonNullAsciiString str) -> ioProperty $ do + r1 <- Windows.encodeFS str + r2 <- Windows.encodeUtf str + (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str + (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str + (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str + pure ( r1 === r2 + .&&. r1 === r3 + .&&. r1 === r4 + .&&. r1 === r5 + ) + ) + , ("Unit test toPlatformString*", + property $ ioProperty $ do + let str = "ABcK_(ツ123_&**" + let expected = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a] + r1 <- Windows.encodeFS str + r2 <- Windows.encodeUtf str + (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str + (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str + (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str + pure ( r1 === expected + .&&. r2 === expected + .&&. r3 === expected + .&&. r4 === expected + .&&. r5 === expected + ) + ) + , ("Unit test fromPlatformString*", + property $ ioProperty $ do + let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a] + let expected = "ABcK_(ツ123_&**" + r1 <- Windows.decodeFS bs + r2 <- Windows.decodeUtf bs + (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) bs + (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) bs + (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) bs + pure ( r1 === expected + .&&. r2 === expected + .&&. r3 === expected + .&&. r4 === expected + .&&. r5 === expected + ) + ) + ] + , testProperties "Posix" + [ ("decodeUtf . encodeUtf == id", + property $ \(NonNullString str) -> (Posix.decodeUtf . fromJust . Posix.encodeUtf) str == Just str) + , ("encodeWith ucs2le . decodeWith ucs2le == id (Posix)", + property $ \(padEven -> bs) -> (Posix.encodeWith ucs2le . (\(Right r) -> r) . Posix.decodeWith ucs2le . OS.PS . toShort) bs === Right (OS.PS . toShort $ bs)) + , ("decodeFS . encodeFS == id", + property $ \(NonNullString str) -> ioProperty $ do + setFileSystemEncoding (mkUTF8 TransliterateCodingFailure) + r1 <- Posix.encodeFS str + r2 <- try @SomeException $ Posix.decodeFS r1 + r3 <- evaluate $ force $ first displayException r2 + pure (r3 === Right str) + ) + , ("fromPlatformString* functions are equivalent under ASCII", + property $ \(PosixString . SBS.toShort . C.pack . nonNullAsciiString -> str) -> ioProperty $ do + r1 <- Posix.decodeFS str + r2 <- Posix.decodeUtf str + (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) str + (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) str + (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) str + pure ( r1 === r2 + .&&. r1 === r3 + .&&. r1 === r4 + .&&. r1 === r5 + ) + ) + , ("toPlatformString* functions are equivalent under ASCII", + property $ \(NonNullAsciiString str) -> ioProperty $ do + r1 <- Posix.encodeFS str + r2 <- Posix.encodeUtf str + (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str + (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str + (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str + pure ( r1 === r2 + .&&. r1 === r3 + .&&. r1 === r4 + .&&. r1 === r5 + ) + ) + , ("Unit test toPlatformString*", + property $ ioProperty $ do + let str = "ABcK_(ツ123_&**" + let expected = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a] + r1 <- Posix.encodeFS str + r2 <- Posix.encodeUtf str + (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str + (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str + (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str + pure ( r1 === expected + .&&. r2 === expected + .&&. r3 === expected + .&&. r4 === expected + .&&. r5 === expected + ) + ) + , ("Unit test fromPlatformString*", + property $ ioProperty $ do + let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a] + let expected = "ABcK_(ツ123_&**" + r1 <- Posix.decodeFS bs + r2 <- Posix.decodeUtf bs + (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) bs + (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) bs + (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) bs + pure ( r1 === expected + .&&. r2 === expected + .&&. r3 === expected + .&&. r4 === expected + .&&. r5 === expected + ) + ) + , ("pack . unpack == id (Posix)", + property $ \ws@(PosixString _) -> + Posix.pack (Posix.unpack ws) === ws + ) + ] + ], + testGroup "QuasiQuoter" + [ testProperties "windows" + [ ("QuasiQuoter (WindowsPath)", + property $ do + let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f] + let expected = [Windows.pstr|ABcK_|] + bs === expected + ) + , ("QuasiQuoter (WindowsString)", + property $ do + let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a] + let expected = [WindowsS.pstr|ABcK_(ツ123_&**|] + bs === expected + ) + ], + testProperties "posix" + [ ("QuasiQuoter (PosixPath)", + property $ do + let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f] + let expected = [Posix.pstr|ABcK_|] + bs === expected + ) + , ("QuasiQuoter (PosixString)", + property $ do + let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a] + let expected = [PosixS.pstr|ABcK_(ツ123_&**|] + bs === expected + ) + ] + ], + testProperties "Type laws" + (QC.lawsProperties (QC.ordLaws (Proxy @OsPath)) + ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsPath)) + + ++ QC.lawsProperties (QC.ordLaws (Proxy @OsString)) + ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsString)) + + ++ QC.lawsProperties (QC.ordLaws (Proxy @WindowsString)) + ++ QC.lawsProperties (QC.monoidLaws (Proxy @WindowsString)) + + ++ QC.lawsProperties (QC.ordLaws (Proxy @PosixString)) + ++ QC.lawsProperties (QC.monoidLaws (Proxy @PosixString)) + + ++ QC.lawsProperties (QC.ordLaws (Proxy @PlatformString)) + ++ QC.lawsProperties (QC.monoidLaws (Proxy @PlatformString))) + ] + + +padEven :: ByteString -> ByteString +padEven bs + | even (BS.length bs) = bs + | otherwise = bs `BS.append` BS.pack [70] diff --git a/tests/abstract-filepath/Test.hs b/tests/abstract-filepath/Test.hs new file mode 100644 --- /dev/null +++ b/tests/abstract-filepath/Test.hs @@ -0,0 +1,7 @@ +module Main (main) where + +import qualified OsPathSpec +import Test.Tasty + +main :: IO () +main = defaultMain OsPathSpec.tests diff --git a/tests/filepath-equivalent-tests/Gen.hs b/tests/filepath-equivalent-tests/Gen.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-equivalent-tests/Gen.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia, TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DataKinds #-} + +module Gen where + +import System.FilePath +import Data.List.NonEmpty (NonEmpty(..)) +import GHC.Generics +import Generic.Random +import Generics.Deriving.Show +import Prelude as P +import Test.Tasty.QuickCheck hiding ((==>)) + +import qualified Data.List.NonEmpty as NE + + +class AltShow a where + altShow :: a -> String + +instance {-# OVERLAPPABLE #-} Show a => AltShow a where + altShow = show + +instance {-# OVERLAPS #-} AltShow String where + altShow = id + +instance {-# OVERLAPPABLE #-} AltShow a => AltShow (Maybe a) where + altShow Nothing = "" + altShow (Just a) = altShow a + + +newtype WindowsFilePaths = WindowsFilePaths { unWindowsFilePaths :: [WindowsFilePath] } + deriving (Show, Eq, Ord, Generic) + +-- filepath = namespace *"\" namespace-tail +-- / UNC +-- / [ disk ] *"\" relative-path +-- / disk *"\" +data WindowsFilePath = NS NameSpace [Separator] NSTail + | UNC UNCShare + | N (Maybe Char) [Separator] (Maybe RelFilePath) + -- ^ This differs from the grammar, because we allow + -- empty paths + | PotentiallyInvalid FilePath + -- ^ this branch is added purely for the tests + deriving (GShow, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[6, 2, 2, 1] `AndShrinking` WindowsFilePath) + +instance Show WindowsFilePath where + show wf = gshow wf ++ " (" ++ altShow wf ++ ")" + +instance AltShow WindowsFilePath where + altShow (NS ns seps nstail) = altShow ns ++ altShow seps ++ altShow nstail + altShow (UNC unc) = altShow unc + altShow (N mdisk seps mfrp) = maybe [] (:[]) mdisk ++ (altShow seps ++ altShow mfrp) + altShow (PotentiallyInvalid fp) = fp + + +-- namespace-tail = ( disk 1*"\" relative-path ; C:foo\bar is not valid +-- ; namespaced paths are all absolute +-- / disk *"\" +-- / relative-path +-- ) +data NSTail = NST1 Char (NonEmpty Separator) RelFilePath + | NST2 Char [Separator] + | NST3 RelFilePath + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[1, 1, 1] `AndShrinking` NSTail) + +instance AltShow NSTail where + altShow (NST1 disk seps relfp) = disk:':':(altShow seps ++ altShow relfp) + altShow (NST2 disk seps) = disk:':':altShow seps + altShow (NST3 relfp) = altShow relfp + + +-- UNC = "\\" 1*pchar "\" 1*pchar [ 1*"\" [ relative-path ] ] +data UNCShare = UNCShare Separator Separator + NonEmptyString + (NonEmpty Separator) + NonEmptyString + (Maybe (NonEmpty Separator, Maybe RelFilePath)) + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[1] `AndShrinking` UNCShare) + +instance AltShow UNCShare where + altShow (UNCShare sep1 sep2 fp1 seps fp2 mrfp) = altShow sep1 ++ altShow sep2 ++ altShow fp1 ++ altShow seps ++ altShow fp2 ++ maybe "" (\(a, b) -> altShow a ++ maybe "" altShow b) mrfp + +newtype NonEmptyString = NonEmptyString (NonEmpty Char) + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[1] `AndShrinking` NonEmptyString) + +instance Semigroup NonEmptyString where + (<>) (NonEmptyString ne) (NonEmptyString ne') = NonEmptyString (ne <> ne') + +instance AltShow NonEmptyString where + altShow (NonEmptyString ns) = NE.toList ns + + +-- | Windows API Namespaces +-- +-- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#namespaces +-- https://support.microsoft.com/en-us/topic/70b92942-a643-2f2d-2ac6-aad8acad49fb +-- https://superuser.com/a/1096784/854039 +-- https://reverseengineering.stackexchange.com/a/15178 +-- https://stackoverflow.com/a/25099634 +-- +-- namespace = file-namespace / device-namespace / nt-namespace +-- file-namespace = "\" "\" "?" "\" +-- device-namespace = "\" "\" "." "\" +-- nt-namespace = "\" "?" "?" "\" +data NameSpace = FileNameSpace + | DeviceNameSpace + | NTNameSpace + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[3, 1, 1] `AndShrinking` NameSpace) + +instance AltShow NameSpace where + altShow FileNameSpace = "\\\\?\\" + altShow DeviceNameSpace = "\\\\.\\" + altShow NTNameSpace = "\\??\\" + + +data Separator = UnixSep + | WindowsSep + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[1, 1] `AndShrinking` Separator) + +instance AltShow Separator where + altShow UnixSep = "/" + altShow WindowsSep = "\\" + +instance {-# OVERLAPS #-} AltShow (NonEmpty Separator) where + altShow ne = mconcat $ NE.toList (altShow <$> ne) + +instance {-# OVERLAPS #-} AltShow [Separator] where + altShow [] = "" + altShow ne = altShow (NE.fromList ne) + +-- relative-path = 1*(path-name 1*"\") [ file-name ] / file-name +data RelFilePath = Rel1 (NonEmpty (NonEmptyString, NonEmpty Separator)) (Maybe FileName) + | Rel2 FileName + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[2, 1] `AndShrinking` RelFilePath) + +instance AltShow RelFilePath where + altShow (Rel1 ns mf) = mconcat (NE.toList $ fmap (\(a, b) -> altShow a ++ altShow b) ns) ++ altShow mf + altShow (Rel2 fn) = altShow fn + +-- file-name = 1*pchar [ stream ] +data FileName = FileName NonEmptyString (Maybe DataStream) + deriving (GShow, Show, Eq, Ord, Generic) + +instance Arbitrary FileName where + -- make sure that half of the filenames include a dot '.' + -- so that we can deal with extensions + arbitrary = do + ns <- arbitrary + ds <- arbitrary + i <- chooseInt (0, 100) + if i >= 50 + then do + ns' <- arbitrary + pure $ FileName (ns <> NonEmptyString ('.':|[]) <> ns') ds + else pure $ FileName ns ds + shrink = genericShrink + + +instance Arbitrary (Maybe DataStream) where + arbitrary = genericArbitraryRec (1 % 1 % ()) + shrink = genericShrink + +instance AltShow FileName where + altShow (FileName ns ds) = altShow ns ++ altShow ds + +-- stream = ":" 1*schar [ ":" 1*schar ] / ":" ":" 1*schar +data DataStream = DS1 NonEmptyString (Maybe NonEmptyString) + | DS2 NonEmptyString -- ::datatype + deriving (GShow, Show, Eq, Ord, Generic) + deriving Arbitrary via (GenericArbitraryRec '[1, 1] `AndShrinking` DataStream) + +instance AltShow DataStream where + altShow (DS1 ns Nothing) = ":" ++ altShow ns + altShow (DS1 ns (Just ns2)) = ":" ++ altShow ns ++ ":" ++ altShow ns2 + altShow (DS2 ns) = "::" ++ altShow ns + +instance Arbitrary WindowsFilePaths where + arbitrary = WindowsFilePaths <$> listOf' arbitrary + shrink = genericShrink + +instance Arbitrary [Separator] where + arbitrary = listOf' arbitrary + shrink = genericShrink + +#if !MIN_VERSION_QuickCheck(2,17,0) +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = NE.fromList <$> listOf1' arbitrary + shrink = genericShrink +#endif diff --git a/tests/filepath-equivalent-tests/Legacy/System/FilePath.hs b/tests/filepath-equivalent-tests/Legacy/System/FilePath.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-equivalent-tests/Legacy/System/FilePath.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Safe #-} +#endif +{- | +Module : System.FilePath +Copyright : (c) Neil Mitchell 2005-2014 +License : BSD3 + +Maintainer : ndmitchell@gmail.com +Stability : stable +Portability : portable + +A library for 'FilePath' manipulations, using Posix or Windows filepaths +depending on the platform. + +Both "System.FilePath.Posix" and "System.FilePath.Windows" provide the +same interface. + +Given the example 'FilePath': @\/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:/ Download a file from @url@ and save it to disk: + +@do let file = 'makeValid' url + System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@ + +/Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@: + +@'takeDirectory' file '' \"interface\" '' ('takeFileName' file '-<.>' \"hi\")@ + +References: +[1] (Microsoft MSDN) +-} + + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +module Legacy.System.FilePath( + -- * Separator predicates + FilePath, + 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 Legacy.System.FilePath.Windows +#else +module Legacy.System.FilePath( + -- * Separator predicates + FilePath, + 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 Legacy.System.FilePath.Posix +#endif diff --git a/tests/filepath-equivalent-tests/Legacy/System/FilePath/Posix.hs b/tests/filepath-equivalent-tests/Legacy/System/FilePath/Posix.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-equivalent-tests/Legacy/System/FilePath/Posix.hs @@ -0,0 +1,1048 @@ + + + +{-# LANGUAGE PatternGuards #-} + +-- This template expects CPP definitions for: +-- MODULE_NAME = Posix | Windows +-- IS_WINDOWS = False | True + +-- | +-- Module : System.FilePath.MODULE_NAME +-- Copyright : (c) Neil Mitchell 2005-2014 +-- License : BSD3 +-- +-- Maintainer : ndmitchell@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- A library for 'FilePath' manipulations, using MODULE_NAME style paths on +-- all platforms. Importing "System.FilePath" is usually better. +-- +-- Given the example 'FilePath': @\/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:/ Download a file from @url@ and save it to disk: +-- +-- @do let file = 'makeValid' url +-- System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@ +-- +-- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@: +-- +-- @'takeDirectory' file '' \"interface\" '' ('takeFileName' file '-<.>' \"hi\")@ +-- +-- References: +-- [1] (Microsoft MSDN) +module Legacy.System.FilePath.Posix + ( + -- * Separator predicates + FilePath, + 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.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) +import Data.Maybe(isJust) +import Data.List(stripPrefix, isSuffixOf) + +import System.Environment(getEnv) + + +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 = False + + +--------------------------------------------------------------------- +-- 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 == '\\' +-- > Posix: pathSeparator == '/' +-- > isPathSeparator pathSeparator +pathSeparator :: Char +pathSeparator = if isWindows then '\\' else '/' + +-- | The list of all possible separators. +-- +-- > Windows: pathSeparators == ['\\', '/'] +-- > Posix: pathSeparators == ['/'] +-- > pathSeparator `elem` pathSeparators +pathSeparators :: [Char] +pathSeparators = if isWindows then "\\/" else "/" + +-- | Rather than using @(== 'pathSeparator')@, use this. Test if something +-- is a path separator. +-- +-- > isPathSeparator a == (a `elem` pathSeparators) +isPathSeparator :: Char -> Bool +isPathSeparator '/' = True +isPathSeparator '\\' = isWindows +isPathSeparator _ = False + + +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > Windows: searchPathSeparator == ';' +-- > Posix: searchPathSeparator == ':' +searchPathSeparator :: Char +searchPathSeparator = if isWindows then ';' else ':' + +-- | Is the character a file separator? +-- +-- > isSearchPathSeparator a == (a == searchPathSeparator) +isSearchPathSeparator :: Char -> Bool +isSearchPathSeparator = (== searchPathSeparator) + + +-- | File extension character +-- +-- > extSeparator == '.' +extSeparator :: Char +extSeparator = '.' + +-- | Is the character an extension character? +-- +-- > isExtSeparator a == (a == extSeparator) +isExtSeparator :: Char -> 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 +-- +-- +-- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] +-- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] +-- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] +-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] +-- > 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 :: FilePath -> (String, String) +splitExtension x = case nameDot of + "" -> (x,"") + _ -> (dir ++ init nameDot, extSeparator : ext) + where + (dir,file) = splitFileName_ x + (nameDot,ext) = 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 :: FilePath -> String +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" +(-<.>) :: FilePath -> String -> FilePath +(-<.>) = 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 :: FilePath -> String -> FilePath +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" +(<.>) :: FilePath -> String -> FilePath +(<.>) = addExtension + +-- | Remove last extension, and the \".\" preceding it. +-- +-- > dropExtension "/directory/path.ext" == "/directory/path" +-- > dropExtension x == fst (splitExtension x) +dropExtension :: FilePath -> FilePath +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 :: FilePath -> String -> FilePath +addExtension file "" = file +addExtension file xs@(x:_) = joinDrive a res + where + res = if isExtSeparator x then b ++ xs + else b ++ [extSeparator] ++ xs + + (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 :: FilePath -> Bool +hasExtension = 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 :: String -> FilePath -> Bool +isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions +isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions + +-- | 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 :: String -> FilePath -> Maybe FilePath +stripExtension [] path = Just path +stripExtension ext@(x:_) path = stripSuffix dotExt path + where dotExt = if isExtSeparator x then ext else '.':ext + + +-- | 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 :: FilePath -> (FilePath, String) +splitExtensions x = (a ++ c, d) + where + (a,b) = splitFileName_ x + (c,d) = 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 :: FilePath -> FilePath +dropExtensions = fst . splitExtensions + +-- | Get all extensions. +-- +-- > takeExtensions "/directory/path.ext" == ".ext" +-- > takeExtensions "file.tar.gz" == ".tar.gz" +takeExtensions :: FilePath -> String +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 :: FilePath -> String -> FilePath +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 :: Char -> Bool +isLetter x = isAsciiLower x || isAsciiUpper 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 :: FilePath -> (FilePath, FilePath) +splitDrive x | isPosix = span (== '/') x +splitDrive x | Just y <- readDriveLetter x = y +splitDrive x | Just y <- readDriveUNC x = y +splitDrive x | Just y <- readDriveShare x = y +splitDrive x = ("",x) + +addSlash :: FilePath -> FilePath -> (FilePath, FilePath) +addSlash a xs = (a++c,d) + where (c,d) = span isPathSeparator xs + +-- See [1]. +-- "\\?\D:\" or "\\?\UNC\\" +readDriveUNC :: FilePath -> Maybe (FilePath, FilePath) +readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] = + case map toUpper xs of + ('U':'N':'C':s4:_) | isPathSeparator s4 -> + let (a,b) = readDriveShareName (drop 4 xs) + in Just (s1:s2:'?':s3:take 4 xs ++ a, b) + _ -> case readDriveLetter xs of + -- Extended-length path. + Just (a,b) -> Just (s1:s2:'?':s3:a,b) + Nothing -> Nothing +readDriveUNC _ = Nothing + +{- c:\ -} +readDriveLetter :: String -> Maybe (FilePath, FilePath) +readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs) +readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs) +readDriveLetter _ = Nothing + +{- \\sharename\ -} +readDriveShare :: String -> Maybe (FilePath, FilePath) +readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 = + Just (s1:s2:a,b) + where (a,b) = readDriveShareName xs +readDriveShare _ = Nothing + +{- assume you have already seen \\ -} +{- share\bob -> "share\", "bob" -} +readDriveShareName :: String -> (FilePath, FilePath) +readDriveShareName name = addSlash a b + where (a,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 :: FilePath -> FilePath -> FilePath +joinDrive = combineAlways + +-- | Get the drive from a filepath. +-- +-- > takeDrive x == fst (splitDrive x) +takeDrive :: FilePath -> FilePath +takeDrive = fst . splitDrive + +-- | Delete the drive, if it exists. +-- +-- > dropDrive x == snd (splitDrive x) +dropDrive :: FilePath -> FilePath +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 :: FilePath -> Bool +hasDrive = not . 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 :: FilePath -> Bool +isDrive x = not (null x) && 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 :: FilePath -> (String, String) +splitFileName x = (if 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_ :: FilePath -> (String, String) +splitFileName_ x = (drv ++ dir, file) + where + (drv,pth) = splitDrive x + (dir,file) = breakEnd isPathSeparator pth + +-- | Set the filename. +-- +-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" +-- > Valid x => replaceFileName x (takeFileName x) == x +replaceFileName :: FilePath -> String -> FilePath +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 :: FilePath -> FilePath +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 :: FilePath -> FilePath +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 :: FilePath -> String +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 :: FilePath -> String -> FilePath +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 :: FilePath -> Bool +hasTrailingPathSeparator "" = False +hasTrailingPathSeparator x = isPathSeparator (last x) + + +hasLeadingPathSeparator :: FilePath -> Bool +hasLeadingPathSeparator "" = False +hasLeadingPathSeparator x = isPathSeparator (head x) + + +-- | 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 :: FilePath -> FilePath +addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator] + + +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > dropTrailingPathSeparator "/" == "/" +-- > Windows: dropTrailingPathSeparator "\\" == "\\" +-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x +dropTrailingPathSeparator :: FilePath -> FilePath +dropTrailingPathSeparator x = + if hasTrailingPathSeparator x && not (isDrive x) + then let x' = dropWhileEnd isPathSeparator x + in if null x' then [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 :: FilePath -> FilePath +takeDirectory = dropTrailingPathSeparator . dropFileName + +-- | Set the directory, keeping the filename the same. +-- +-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" +-- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x +replaceDirectory :: FilePath -> String -> FilePath +replaceDirectory x dir = combineAlways dir (takeFileName x) + + +-- | An alias for ''. +combine :: FilePath -> FilePath -> FilePath +combine a b | hasLeadingPathSeparator b || hasDrive b = b + | otherwise = combineAlways a b + +-- | Combine two paths, assuming rhs is NOT absolute. +combineAlways :: FilePath -> FilePath -> FilePath +combineAlways a b | null a = b + | null b = a + | hasTrailingPathSeparator a = a ++ b + | otherwise = case a of + [a1,':'] | isWindows && isLetter a1 -> a ++ b + _ -> a ++ [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" +-- > 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" +() :: FilePath -> FilePath -> FilePath +() = combine + + +-- | Split a path by the directory separator. +-- +-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] +-- > concat (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 :: FilePath -> [FilePath] +splitPath x = [drive | drive /= ""] ++ f path + where + (drive,path) = splitDrive x + + f "" = [] + f y = (a++c) : f d + where + (a,b) = break isPathSeparator y + (c,d) = 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"] +-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x +-- > splitDirectories "" == [] +-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] +-- > splitDirectories "/test///file" == ["/","test","file"] +splitDirectories :: FilePath -> [FilePath] +splitDirectories = map dropTrailingPathSeparator . splitPath + + +-- | Join path elements back together. +-- +-- > joinPath a == foldr () "" a +-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" +-- > Valid x => joinPath (splitPath x) == x +-- > joinPath [] == "" +-- > Posix: joinPath ["test","file","path"] == "test/file/path" +joinPath :: [FilePath] -> FilePath +-- Note that this definition on c:\\c:\\, join then split will give c:\\. +joinPath = foldr combine "" + + + + + + +--------------------------------------------------------------------- +-- 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. +-- +-- Similar to 'normalise', this does not expand @".."@, because of symlinks. +-- +-- > x == y ==> equalFilePath x y +-- > normalise x == normalise y ==> equalFilePath x y +-- > equalFilePath "foo" "foo/" +-- > not (equalFilePath "/a/../c" "/c") +-- > not (equalFilePath "foo" "/foo") +-- > Posix: not (equalFilePath "foo" "FOO") +-- > Windows: equalFilePath "foo" "FOO" +-- > 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@. +-- +-- > makeRelative "/directory" "/directory/file.ext" == "file.ext" +-- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x +-- > makeRelative x x == "." +-- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" +-- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" +-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" +-- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" +-- > Windows: makeRelative "/Home" "/home/bob" == "bob" +-- > Windows: makeRelative "/" "//" == "//" +-- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob" +-- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" +-- > Posix: makeRelative "/fred" "bob" == "bob" +-- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" +-- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" +-- > 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' +-- +-- * .\/ -> \"\" +-- +-- Does not remove @".."@, because of symlinks. +-- +-- > Posix: normalise "/file/\\test////" == "/file/\\test/" +-- > Posix: normalise "/file/./test" == "/file/test" +-- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" +-- > Posix: normalise "../bob/fred/" == "../bob/fred/" +-- > Posix: normalise "/a/../c" == "/a/../c" +-- > Posix: normalise "./bob/fred/" == "bob/fred/" +-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" +-- > Windows: normalise "c:\\" == "C:\\" +-- > Windows: normalise "C:.\\" == "C:" +-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" +-- > Windows: normalise "//server/test" == "\\\\server\\test" +-- > Windows: normalise "c:/file" == "C:\\file" +-- > Windows: normalise "/file" == "\\file" +-- > Windows: normalise "\\" == "\\" +-- > Windows: normalise "/./" == "\\" +-- > normalise "." == "." +-- > Posix: normalise "./" == "./" +-- > Posix: normalise "./." == "./" +-- > Posix: normalise "/./" == "/" +-- > Posix: normalise "/" == "/" +-- > Posix: normalise "bob/fred/." == "bob/fred/" +-- > Posix: normalise "//home" == "/home" +normalise :: 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 :: Char -> Bool +isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\"" + +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 FilePath 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 == not (null x) +-- > 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 :: FilePath -> Bool +isValid "" = False +isValid x | '\0' `elem` x = False +isValid _ | isPosix = True +isValid path = + not (any isBadCharacter x2) && + not (any f $ splitDirectories x2) && + not (isJust (readDriveShare x1) && all isPathSeparator x1) && + not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) + where + (x1,x2) = splitDrive path + f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements + + +-- | Take a FilePath and make it valid; does not change already valid FilePaths. +-- +-- > isValid (makeValid x) +-- > isValid x ==> makeValid x == x +-- > makeValid "" == "_" +-- > makeValid "file\0name" == "file_name" +-- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" +-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" +-- > Windows: makeValid "test*" == "test_" +-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" +-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" +-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" +-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" +-- > Windows: makeValid "\\\\\\foo" == "\\\\drive" +-- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" +-- > 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 :: FilePath -> Bool +isRelative x = 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 :: String -> Bool +isRelativeDrive x = + maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x) + + +-- | @not . 'isRelative'@ +-- +-- > isAbsolute x == not (isRelative x) +isAbsolute :: FilePath -> Bool +isAbsolute = not . isRelative + + +----------------------------------------------------------------------------- +-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2]) +-- Note that Data.List.dropWhileEnd is only available in base >= 4.5. +dropWhileEnd :: (a -> Bool) -> [a] -> [a] +dropWhileEnd p = reverse . dropWhile p . reverse + +-- 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/tests/filepath-equivalent-tests/Legacy/System/FilePath/Windows.hs b/tests/filepath-equivalent-tests/Legacy/System/FilePath/Windows.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-equivalent-tests/Legacy/System/FilePath/Windows.hs @@ -0,0 +1,1048 @@ + + + +{-# LANGUAGE PatternGuards #-} + +-- This template expects CPP definitions for: +-- MODULE_NAME = Posix | Windows +-- IS_WINDOWS = False | True + +-- | +-- Module : System.FilePath.MODULE_NAME +-- Copyright : (c) Neil Mitchell 2005-2014 +-- License : BSD3 +-- +-- Maintainer : ndmitchell@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- A library for 'FilePath' manipulations, using MODULE_NAME style paths on +-- all platforms. Importing "System.FilePath" is usually better. +-- +-- Given the example 'FilePath': @\/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:/ Download a file from @url@ and save it to disk: +-- +-- @do let file = 'makeValid' url +-- System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@ +-- +-- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@: +-- +-- @'takeDirectory' file '' \"interface\" '' ('takeFileName' file '-<.>' \"hi\")@ +-- +-- References: +-- [1] (Microsoft MSDN) +module Legacy.System.FilePath.Windows + ( + -- * Separator predicates + FilePath, + 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.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) +import Data.Maybe(isJust) +import Data.List(stripPrefix, isSuffixOf) + +import System.Environment(getEnv) + + +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 = True + + +--------------------------------------------------------------------- +-- 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 == '\\' +-- > Posix: pathSeparator == '/' +-- > isPathSeparator pathSeparator +pathSeparator :: Char +pathSeparator = if isWindows then '\\' else '/' + +-- | The list of all possible separators. +-- +-- > Windows: pathSeparators == ['\\', '/'] +-- > Posix: pathSeparators == ['/'] +-- > pathSeparator `elem` pathSeparators +pathSeparators :: [Char] +pathSeparators = if isWindows then "\\/" else "/" + +-- | Rather than using @(== 'pathSeparator')@, use this. Test if something +-- is a path separator. +-- +-- > isPathSeparator a == (a `elem` pathSeparators) +isPathSeparator :: Char -> Bool +isPathSeparator '/' = True +isPathSeparator '\\' = isWindows +isPathSeparator _ = False + + +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > Windows: searchPathSeparator == ';' +-- > Posix: searchPathSeparator == ':' +searchPathSeparator :: Char +searchPathSeparator = if isWindows then ';' else ':' + +-- | Is the character a file separator? +-- +-- > isSearchPathSeparator a == (a == searchPathSeparator) +isSearchPathSeparator :: Char -> Bool +isSearchPathSeparator = (== searchPathSeparator) + + +-- | File extension character +-- +-- > extSeparator == '.' +extSeparator :: Char +extSeparator = '.' + +-- | Is the character an extension character? +-- +-- > isExtSeparator a == (a == extSeparator) +isExtSeparator :: Char -> 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 +-- +-- +-- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] +-- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] +-- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] +-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] +-- > 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 :: FilePath -> (String, String) +splitExtension x = case nameDot of + "" -> (x,"") + _ -> (dir ++ init nameDot, extSeparator : ext) + where + (dir,file) = splitFileName_ x + (nameDot,ext) = 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 :: FilePath -> String +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" +(-<.>) :: FilePath -> String -> FilePath +(-<.>) = 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 :: FilePath -> String -> FilePath +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" +(<.>) :: FilePath -> String -> FilePath +(<.>) = addExtension + +-- | Remove last extension, and the \".\" preceding it. +-- +-- > dropExtension "/directory/path.ext" == "/directory/path" +-- > dropExtension x == fst (splitExtension x) +dropExtension :: FilePath -> FilePath +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 :: FilePath -> String -> FilePath +addExtension file "" = file +addExtension file xs@(x:_) = joinDrive a res + where + res = if isExtSeparator x then b ++ xs + else b ++ [extSeparator] ++ xs + + (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 :: FilePath -> Bool +hasExtension = 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 :: String -> FilePath -> Bool +isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions +isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions + +-- | 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 :: String -> FilePath -> Maybe FilePath +stripExtension [] path = Just path +stripExtension ext@(x:_) path = stripSuffix dotExt path + where dotExt = if isExtSeparator x then ext else '.':ext + + +-- | 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 :: FilePath -> (FilePath, String) +splitExtensions x = (a ++ c, d) + where + (a,b) = splitFileName_ x + (c,d) = 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 :: FilePath -> FilePath +dropExtensions = fst . splitExtensions + +-- | Get all extensions. +-- +-- > takeExtensions "/directory/path.ext" == ".ext" +-- > takeExtensions "file.tar.gz" == ".tar.gz" +takeExtensions :: FilePath -> String +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 :: FilePath -> String -> FilePath +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 :: Char -> Bool +isLetter x = isAsciiLower x || isAsciiUpper 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 :: FilePath -> (FilePath, FilePath) +splitDrive x | isPosix = span (== '/') x +splitDrive x | Just y <- readDriveLetter x = y +splitDrive x | Just y <- readDriveUNC x = y +splitDrive x | Just y <- readDriveShare x = y +splitDrive x = ("",x) + +addSlash :: FilePath -> FilePath -> (FilePath, FilePath) +addSlash a xs = (a++c,d) + where (c,d) = span isPathSeparator xs + +-- See [1]. +-- "\\?\D:\" or "\\?\UNC\\" +readDriveUNC :: FilePath -> Maybe (FilePath, FilePath) +readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] = + case map toUpper xs of + ('U':'N':'C':s4:_) | isPathSeparator s4 -> + let (a,b) = readDriveShareName (drop 4 xs) + in Just (s1:s2:'?':s3:take 4 xs ++ a, b) + _ -> case readDriveLetter xs of + -- Extended-length path. + Just (a,b) -> Just (s1:s2:'?':s3:a,b) + Nothing -> Nothing +readDriveUNC _ = Nothing + +{- c:\ -} +readDriveLetter :: String -> Maybe (FilePath, FilePath) +readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs) +readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs) +readDriveLetter _ = Nothing + +{- \\sharename\ -} +readDriveShare :: String -> Maybe (FilePath, FilePath) +readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 = + Just (s1:s2:a,b) + where (a,b) = readDriveShareName xs +readDriveShare _ = Nothing + +{- assume you have already seen \\ -} +{- share\bob -> "share\", "bob" -} +readDriveShareName :: String -> (FilePath, FilePath) +readDriveShareName name = addSlash a b + where (a,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 :: FilePath -> FilePath -> FilePath +joinDrive = combineAlways + +-- | Get the drive from a filepath. +-- +-- > takeDrive x == fst (splitDrive x) +takeDrive :: FilePath -> FilePath +takeDrive = fst . splitDrive + +-- | Delete the drive, if it exists. +-- +-- > dropDrive x == snd (splitDrive x) +dropDrive :: FilePath -> FilePath +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 :: FilePath -> Bool +hasDrive = not . 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 :: FilePath -> Bool +isDrive x = not (null x) && 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 :: FilePath -> (String, String) +splitFileName x = (if 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_ :: FilePath -> (String, String) +splitFileName_ x = (drv ++ dir, file) + where + (drv,pth) = splitDrive x + (dir,file) = breakEnd isPathSeparator pth + +-- | Set the filename. +-- +-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" +-- > Valid x => replaceFileName x (takeFileName x) == x +replaceFileName :: FilePath -> String -> FilePath +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 :: FilePath -> FilePath +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 :: FilePath -> FilePath +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 :: FilePath -> String +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 :: FilePath -> String -> FilePath +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 :: FilePath -> Bool +hasTrailingPathSeparator "" = False +hasTrailingPathSeparator x = isPathSeparator (last x) + + +hasLeadingPathSeparator :: FilePath -> Bool +hasLeadingPathSeparator "" = False +hasLeadingPathSeparator x = isPathSeparator (head x) + + +-- | 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 :: FilePath -> FilePath +addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator] + + +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > dropTrailingPathSeparator "/" == "/" +-- > Windows: dropTrailingPathSeparator "\\" == "\\" +-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x +dropTrailingPathSeparator :: FilePath -> FilePath +dropTrailingPathSeparator x = + if hasTrailingPathSeparator x && not (isDrive x) + then let x' = dropWhileEnd isPathSeparator x + in if null x' then [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 :: FilePath -> FilePath +takeDirectory = dropTrailingPathSeparator . dropFileName + +-- | Set the directory, keeping the filename the same. +-- +-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" +-- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x +replaceDirectory :: FilePath -> String -> FilePath +replaceDirectory x dir = combineAlways dir (takeFileName x) + + +-- | An alias for ''. +combine :: FilePath -> FilePath -> FilePath +combine a b | hasLeadingPathSeparator b || hasDrive b = b + | otherwise = combineAlways a b + +-- | Combine two paths, assuming rhs is NOT absolute. +combineAlways :: FilePath -> FilePath -> FilePath +combineAlways a b | null a = b + | null b = a + | hasTrailingPathSeparator a = a ++ b + | otherwise = case a of + [a1,':'] | isWindows && isLetter a1 -> a ++ b + _ -> a ++ [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" +-- > 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" +() :: FilePath -> FilePath -> FilePath +() = combine + + +-- | Split a path by the directory separator. +-- +-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] +-- > concat (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 :: FilePath -> [FilePath] +splitPath x = [drive | drive /= ""] ++ f path + where + (drive,path) = splitDrive x + + f "" = [] + f y = (a++c) : f d + where + (a,b) = break isPathSeparator y + (c,d) = 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"] +-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x +-- > splitDirectories "" == [] +-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] +-- > splitDirectories "/test///file" == ["/","test","file"] +splitDirectories :: FilePath -> [FilePath] +splitDirectories = map dropTrailingPathSeparator . splitPath + + +-- | Join path elements back together. +-- +-- > joinPath a == foldr () "" a +-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" +-- > Valid x => joinPath (splitPath x) == x +-- > joinPath [] == "" +-- > Posix: joinPath ["test","file","path"] == "test/file/path" +joinPath :: [FilePath] -> FilePath +-- Note that this definition on c:\\c:\\, join then split will give c:\\. +joinPath = foldr combine "" + + + + + + +--------------------------------------------------------------------- +-- 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. +-- +-- Similar to 'normalise', this does not expand @".."@, because of symlinks. +-- +-- > x == y ==> equalFilePath x y +-- > normalise x == normalise y ==> equalFilePath x y +-- > equalFilePath "foo" "foo/" +-- > not (equalFilePath "/a/../c" "/c") +-- > not (equalFilePath "foo" "/foo") +-- > Posix: not (equalFilePath "foo" "FOO") +-- > Windows: equalFilePath "foo" "FOO" +-- > 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@. +-- +-- > makeRelative "/directory" "/directory/file.ext" == "file.ext" +-- > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x +-- > makeRelative x x == "." +-- > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" +-- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" +-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" +-- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" +-- > Windows: makeRelative "/Home" "/home/bob" == "bob" +-- > Windows: makeRelative "/" "//" == "//" +-- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob" +-- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" +-- > Posix: makeRelative "/fred" "bob" == "bob" +-- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" +-- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" +-- > 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' +-- +-- * .\/ -> \"\" +-- +-- Does not remove @".."@, because of symlinks. +-- +-- > Posix: normalise "/file/\\test////" == "/file/\\test/" +-- > Posix: normalise "/file/./test" == "/file/test" +-- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" +-- > Posix: normalise "../bob/fred/" == "../bob/fred/" +-- > Posix: normalise "/a/../c" == "/a/../c" +-- > Posix: normalise "./bob/fred/" == "bob/fred/" +-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" +-- > Windows: normalise "c:\\" == "C:\\" +-- > Windows: normalise "C:.\\" == "C:" +-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" +-- > Windows: normalise "//server/test" == "\\\\server\\test" +-- > Windows: normalise "c:/file" == "C:\\file" +-- > Windows: normalise "/file" == "\\file" +-- > Windows: normalise "\\" == "\\" +-- > Windows: normalise "/./" == "\\" +-- > normalise "." == "." +-- > Posix: normalise "./" == "./" +-- > Posix: normalise "./." == "./" +-- > Posix: normalise "/./" == "/" +-- > Posix: normalise "/" == "/" +-- > Posix: normalise "bob/fred/." == "bob/fred/" +-- > Posix: normalise "//home" == "/home" +normalise :: 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 :: Char -> Bool +isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\"" + +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 FilePath 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 == not (null x) +-- > 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 :: FilePath -> Bool +isValid "" = False +isValid x | '\0' `elem` x = False +isValid _ | isPosix = True +isValid path = + not (any isBadCharacter x2) && + not (any f $ splitDirectories x2) && + not (isJust (readDriveShare x1) && all isPathSeparator x1) && + not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1)) + where + (x1,x2) = splitDrive path + f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements + + +-- | Take a FilePath and make it valid; does not change already valid FilePaths. +-- +-- > isValid (makeValid x) +-- > isValid x ==> makeValid x == x +-- > makeValid "" == "_" +-- > makeValid "file\0name" == "file_name" +-- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" +-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" +-- > Windows: makeValid "test*" == "test_" +-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" +-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" +-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" +-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" +-- > Windows: makeValid "\\\\\\foo" == "\\\\drive" +-- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" +-- > 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 :: FilePath -> Bool +isRelative x = 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 :: String -> Bool +isRelativeDrive x = + maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x) + + +-- | @not . 'isRelative'@ +-- +-- > isAbsolute x == not (isRelative x) +isAbsolute :: FilePath -> Bool +isAbsolute = not . isRelative + + +----------------------------------------------------------------------------- +-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2]) +-- Note that Data.List.dropWhileEnd is only available in base >= 4.5. +dropWhileEnd :: (a -> Bool) -> [a] -> [a] +dropWhileEnd p = reverse . dropWhile p . reverse + +-- 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/tests/filepath-equivalent-tests/TestEquiv.hs b/tests/filepath-equivalent-tests/TestEquiv.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-equivalent-tests/TestEquiv.hs @@ -0,0 +1,433 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeApplications #-} + +module Main where + +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((==>)) +import TestUtil +import Prelude as P +import Data.Char (isAsciiLower, isAsciiUpper) +import Gen + +import qualified System.FilePath.Windows as W +import qualified System.FilePath.Posix as P +import qualified Legacy.System.FilePath.Windows as LW +import qualified Legacy.System.FilePath.Posix as LP + + +main :: IO () +main = defaultMain equivalentTests + + +equivalentTests :: TestTree +equivalentTests = testGroup "equivalence" + [ testProperties "windows" + [ + ( "pathSeparator" + , property $ W.pathSeparator == LW.pathSeparator + ) + , + ( "pathSeparators" + , property $ W.pathSeparators == LW.pathSeparators + ) + , + ( "isPathSeparator" + , property $ \p -> W.isPathSeparator p == LW.isPathSeparator p + ) + , + ( "searchPathSeparator" + , property $ W.searchPathSeparator == LW.searchPathSeparator + ) + , + ( "isSearchPathSeparator" + , property $ \p -> W.isSearchPathSeparator p == LW.isSearchPathSeparator p + ) + , + ( "extSeparator" + , property $ W.extSeparator == LW.extSeparator + ) + , + ( "isExtSeparator" + , property $ \p -> W.isExtSeparator p == LW.isExtSeparator p + ) + , + ( "splitSearchPath" + , property $ \(xs :: WindowsFilePaths) + -> let p = (intercalate ";" (altShow <$> unWindowsFilePaths xs)) + in W.splitSearchPath p == LW.splitSearchPath p + ) + , + ( "splitExtension" + , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtension p == LW.splitExtension p + ) + , + ( "takeExtension" + , property $ \(altShow @WindowsFilePath -> p) -> W.takeExtension p == LW.takeExtension p + ) + , + ( "replaceExtension" + , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtension p s == LW.replaceExtension p s + ) + , + ( "dropExtension" + , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtension p == LW.dropExtension p + ) + , + ( "addExtension" + , property $ \(altShow @WindowsFilePath -> p) s -> W.addExtension p s == LW.addExtension p s + ) + , + ( "hasExtension" + , property $ \(altShow @WindowsFilePath -> p) -> W.hasExtension p == LW.hasExtension p + ) + , + ( "splitExtensions" + , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtensions p == LW.splitExtensions p + ) + , + ( "dropExtensions" + , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtensions p == LW.dropExtensions p + ) + , + ( "takeExtensions" + , property $ \p -> W.takeExtensions p == LW.takeExtensions p + ) + , + ( "replaceExtensions" + , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtensions p s == LW.replaceExtensions p s + ) + , + ( "isExtensionOf" + , property $ \(altShow @WindowsFilePath -> p) s -> W.isExtensionOf p s == LW.isExtensionOf p s + ) + , + ( "stripExtension" + , property $ \(altShow @WindowsFilePath -> p) s -> W.stripExtension p s == LW.stripExtension p s + ) + , + ( "splitFileName" + , property $ \(altShow @WindowsFilePath -> p) -> W.splitFileName p == LW.splitFileName p + ) + , + ( "takeFileName" + , property $ \(altShow @WindowsFilePath -> p) -> W.takeFileName p == LW.takeFileName p + ) + , + ( "replaceFileName" + , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceFileName p s == LW.replaceFileName p s + ) + , + ( "dropFileName" + , property $ \(altShow @WindowsFilePath -> p) -> W.dropFileName p == LW.dropFileName p + ) + , + ( "takeBaseName" + , property $ \(altShow @WindowsFilePath -> p) -> W.takeBaseName p == LW.takeBaseName p + ) + , + ( "replaceBaseName" + , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceBaseName p s == LW.replaceBaseName p s + ) + , + ( "takeDirectory" + , property $ \(altShow @WindowsFilePath -> p) -> W.takeDirectory p == LW.takeDirectory p + ) + , + ( "replaceDirectory" + , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceDirectory p s == LW.replaceDirectory p s + ) + , + ( "combine" + , property $ \(altShow @WindowsFilePath -> p) s -> W.combine p s == LW.combine p s + ) + , + ( "splitPath" + , property $ \(altShow @WindowsFilePath -> p) -> W.splitPath p == LW.splitPath p + ) + , + ( "joinPath" + , property $ \(xs :: WindowsFilePaths) -> + let p = altShow <$> unWindowsFilePaths xs + in W.joinPath p == LW.joinPath p + ) + , + ( "splitDirectories" + , property $ \(altShow @WindowsFilePath -> p) -> W.splitDirectories p == LW.splitDirectories p + ) + , + ( "splitDrive" + , property $ \(altShow @WindowsFilePath -> p) -> W.splitDrive p == LW.splitDrive p + ) + , + ( "joinDrive" + , property $ \(altShow @WindowsFilePath -> p) s -> W.joinDrive p s == LW.joinDrive p s + ) + , + ( "takeDrive" + , property $ \(altShow @WindowsFilePath -> p) -> W.takeDrive p == LW.takeDrive p + ) + , + ( "hasDrive" + , property $ \(altShow @WindowsFilePath -> p) -> W.hasDrive p == LW.hasDrive p + ) + , + ( "dropDrive" + , property $ \(altShow @WindowsFilePath -> p) -> W.dropDrive p == LW.dropDrive p + ) + , + ( "isDrive" + , property $ \(altShow @WindowsFilePath -> p) -> W.isDrive p == LW.isDrive p + ) + , + ( "hasTrailingPathSeparator" + , property $ \(altShow @WindowsFilePath -> p) -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p + ) + , + ( "addTrailingPathSeparator" + , property $ \(altShow @WindowsFilePath -> p) -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p + ) + , + ( "dropTrailingPathSeparator" + , property $ \(altShow @WindowsFilePath -> p) -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p + ) + , + ( "normalise" + , property $ \(altShow @WindowsFilePath -> p) -> case p of + (l:':':rs) + -- new filepath normalises "a:////////" to "A:\\" + -- see https://github.com/haskell/filepath/commit/cb4890aa03a5ee61f16f7a08dd2d964fffffb385 + | isAsciiLower l || isAsciiUpper l + , let (seps, path) = span LW.isPathSeparator rs + , length seps > 1 -> let np = l : ':' : LW.pathSeparator : path in W.normalise np == LW.normalise np + _ -> W.normalise p == LW.normalise p + ) + , + ( "equalFilePath" + , property $ \p s -> W.equalFilePath p s == LW.equalFilePath p s + ) + , + ( "makeRelative" + , property $ \p s -> W.makeRelative p s == LW.makeRelative p s + ) + , + ( "isRelative" + , property $ \p -> W.isRelative p == LW.isRelative p + ) + , + ( "isAbsolute" + , property $ \p -> W.isAbsolute p == LW.isAbsolute p + ) + , + ( "isValid" + , property $ \p -> W.isValid p == LW.isValid p + ) + , + ( "makeValid" + , property $ \p -> W.makeValid p == LW.makeValid p + ) + ], + testProperties "posix" $ [ + ( "pathSeparator" + , property $ P.pathSeparator == LP.pathSeparator + ) + , + ( "pathSeparators" + , property $ P.pathSeparators == LP.pathSeparators + ) + , + ( "isPathSeparator" + , property $ \p -> P.isPathSeparator p == LP.isPathSeparator p + ) + , + ( "searchPathSeparator" + , property $ P.searchPathSeparator == LP.searchPathSeparator + ) + , + ( "isSearchPathSeparator" + , property $ \p -> P.isSearchPathSeparator p == LP.isSearchPathSeparator p + ) + , + ( "extSeparator" + , property $ P.extSeparator == LP.extSeparator + ) + , + ( "isExtSeparator" + , property $ \p -> P.isExtSeparator p == LP.isExtSeparator p + ) + , + ( "splitSearchPath" + , property $ \p -> P.splitSearchPath p == LP.splitSearchPath p + ) + , + ( "splitExtension" + , property $ \p -> P.splitExtension p == LP.splitExtension p + ) + , + ( "takeExtension" + , property $ \p -> P.takeExtension p == LP.takeExtension p + ) + , + ( "replaceExtension" + , property $ \p s -> P.replaceExtension p s == LP.replaceExtension p s + ) + , + ( "dropExtension" + , property $ \p -> P.dropExtension p == LP.dropExtension p + ) + , + ( "addExtension" + , property $ \p s -> P.addExtension p s == LP.addExtension p s + ) + , + ( "hasExtension" + , property $ \p -> P.hasExtension p == LP.hasExtension p + ) + , + ( "splitExtensions" + , property $ \p -> P.splitExtensions p == LP.splitExtensions p + ) + , + ( "dropExtensions" + , property $ \p -> P.dropExtensions p == LP.dropExtensions p + ) + , + ( "takeExtensions" + , property $ \p -> P.takeExtensions p == LP.takeExtensions p + ) + , + ( "replaceExtensions" + , property $ \p s -> P.replaceExtensions p s == LP.replaceExtensions p s + ) + , + ( "isExtensionOf" + , property $ \p s -> P.isExtensionOf p s == LP.isExtensionOf p s + ) + , + ( "stripExtension" + , property $ \p s -> P.stripExtension p s == LP.stripExtension p s + ) + , + ( "splitFileName" + , property $ \p -> P.splitFileName p == LP.splitFileName p + ) + , + ( "takeFileName" + , property $ \p -> P.takeFileName p == LP.takeFileName p + ) + , + ( "replaceFileName" + , property $ \p s -> P.replaceFileName p s == LP.replaceFileName p s + ) + , + ( "dropFileName" + , property $ \p -> P.dropFileName p == LP.dropFileName p + ) + , + ( "takeBaseName" + , property $ \p -> P.takeBaseName p == LP.takeBaseName p + ) + , + ( "replaceBaseName" + , property $ \p s -> P.replaceBaseName p s == LP.replaceBaseName p s + ) + , + ( "takeDirectory" + , property $ \p -> P.takeDirectory p == LP.takeDirectory p + ) + , + ( "replaceDirectory" + , property $ \p s -> P.replaceDirectory p s == LP.replaceDirectory p s + ) + , + ( "combine" + , property $ \p s -> P.combine p s == LP.combine p s + ) + , + ( "splitPath" + , property $ \p -> P.splitPath p == LP.splitPath p + ) + , + ( "joinPath" + , property $ \p -> P.joinPath p == LP.joinPath p + ) + , + ( "splitDirectories" + , property $ \p -> P.splitDirectories p == LP.splitDirectories p + ) + , + ( "splitDirectories" + , property $ \p -> P.splitDirectories p == LP.splitDirectories p + ) + , + ( "splitDrive" + , property $ \p -> P.splitDrive p == LP.splitDrive p + ) + , + ( "joinDrive" + , property $ \p s -> P.joinDrive p s == LP.joinDrive p s + ) + , + ( "takeDrive" + , property $ \p -> P.takeDrive p == LP.takeDrive p + ) + , + ( "hasDrive" + , property $ \p -> P.hasDrive p == LP.hasDrive p + ) + , + ( "dropDrive" + , property $ \p -> P.dropDrive p == LP.dropDrive p + ) + , + ( "isDrive" + , property $ \p -> P.isDrive p == LP.isDrive p + ) + , + ( "hasTrailingPathSeparator" + , property $ \p -> P.hasTrailingPathSeparator p == LP.hasTrailingPathSeparator p + ) + , + ( "addTrailingPathSeparator" + , property $ \p -> P.addTrailingPathSeparator p == LP.addTrailingPathSeparator p + ) + , + ( "dropTrailingPathSeparator" + , property $ \p -> P.dropTrailingPathSeparator p == LP.dropTrailingPathSeparator p + ) + , + ( "normalise" + , property $ \p -> P.normalise p == LP.normalise p + ) + , + ( "equalFilePath" + , property $ \p s -> P.equalFilePath p s == LP.equalFilePath p s + ) + , + ( "makeRelative" + , property $ \p s -> P.makeRelative p s == LP.makeRelative p s + ) + , + ( "isRelative" + , property $ \p -> P.isRelative p == LP.isRelative p + ) + , + ( "isAbsolute" + , property $ \p -> P.isAbsolute p == LP.isAbsolute p + ) + , + ( "isValid" + , property $ \p -> P.isValid p == LP.isValid p + ) + , + ( "makeValid" + , property $ \p -> P.makeValid p == LP.makeValid p + ) + ] + ] + diff --git a/tests/filepath-tests/Test.hs b/tests/filepath-tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-tests/Test.hs @@ -0,0 +1,9 @@ +module Main where + +import TestGen (tests) +import Test.Tasty +import Test.Tasty.QuickCheck + +main :: IO () +main = defaultMain $ testProperties "doctests" tests + diff --git a/tests/filepath-tests/TestGen.hs b/tests/filepath-tests/TestGen.hs new file mode 100644 --- /dev/null +++ b/tests/filepath-tests/TestGen.hs @@ -0,0 +1,955 @@ +-- GENERATED CODE: See ../Generate.hs +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module TestGen(tests) where +import TestUtil +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif +import Prelude as P +import Data.String +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import System.OsString.Internal.Types +import System.OsString.Encoding.Internal +import qualified Data.Char as C +import qualified System.OsString.Data.ByteString.Short as SBS +import qualified System.OsString.Data.ByteString.Short.Word16 as SBS16 +import qualified System.FilePath.Windows as W +import qualified System.FilePath.Posix as P +import qualified System.OsPath.Windows as AFP_W +import qualified System.OsPath.Posix as AFP_P +instance IsString WindowsString where fromString = WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure) +instance IsString PosixString where fromString = PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure) +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +instance IsString OsString where fromString = OsString . WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure) +#else +instance IsString OsString where fromString = OsString . PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure) +#endif +tests :: [(String, Property)] +tests = + [("W.pathSeparator == '\\\\'", property $ W.pathSeparator == '\\') + ,("AFP_W.pathSeparator == (WW . fromIntegral . C.ord $ '\\\\')", property $ AFP_W.pathSeparator == (WW . fromIntegral . C.ord $ '\\')) + ,("P.pathSeparator == '/'", property $ P.pathSeparator == '/') + ,("AFP_P.pathSeparator == (PW . fromIntegral . C.ord $ '/')", property $ AFP_P.pathSeparator == (PW . fromIntegral . C.ord $ '/')) + ,("P.isPathSeparator P.pathSeparator", property $ P.isPathSeparator P.pathSeparator) + ,("W.isPathSeparator W.pathSeparator", property $ W.isPathSeparator W.pathSeparator) + ,("AFP_P.isPathSeparator AFP_P.pathSeparator", property $ AFP_P.isPathSeparator AFP_P.pathSeparator) + ,("AFP_W.isPathSeparator AFP_W.pathSeparator", property $ AFP_W.isPathSeparator AFP_W.pathSeparator) + ,("W.pathSeparators == ['\\\\', '/']", property $ W.pathSeparators == ['\\', '/']) + ,("AFP_W.pathSeparators == [(WW . fromIntegral . C.ord $ '\\\\'), (WW . fromIntegral . C.ord $ '/')]", property $ AFP_W.pathSeparators == [(WW . fromIntegral . C.ord $ '\\'), (WW . fromIntegral . C.ord $ '/')]) + ,("P.pathSeparators == ['/']", property $ P.pathSeparators == ['/']) + ,("AFP_P.pathSeparators == [(PW . fromIntegral . C.ord $ '/')]", property $ AFP_P.pathSeparators == [(PW . fromIntegral . C.ord $ '/')]) + ,("P.pathSeparator `elem` P.pathSeparators", property $ P.pathSeparator `elem` P.pathSeparators) + ,("W.pathSeparator `elem` W.pathSeparators", property $ W.pathSeparator `elem` W.pathSeparators) + ,("AFP_P.pathSeparator `elem` AFP_P.pathSeparators", property $ AFP_P.pathSeparator `elem` AFP_P.pathSeparators) + ,("AFP_W.pathSeparator `elem` AFP_W.pathSeparators", property $ AFP_W.pathSeparator `elem` AFP_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)) + ,("AFP_P.isPathSeparator a == (a `elem` AFP_P.pathSeparators)", property $ \a -> AFP_P.isPathSeparator a == (a `elem` AFP_P.pathSeparators)) + ,("AFP_W.isPathSeparator a == (a `elem` AFP_W.pathSeparators)", property $ \a -> AFP_W.isPathSeparator a == (a `elem` AFP_W.pathSeparators)) + ,("W.searchPathSeparator == ';'", property $ W.searchPathSeparator == ';') + ,("AFP_W.searchPathSeparator == (WW . fromIntegral . C.ord $ ';')", property $ AFP_W.searchPathSeparator == (WW . fromIntegral . C.ord $ ';')) + ,("P.searchPathSeparator == ':'", property $ P.searchPathSeparator == ':') + ,("AFP_P.searchPathSeparator == (PW . fromIntegral . C.ord $ ':')", property $ AFP_P.searchPathSeparator == (PW . fromIntegral . C.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)) + ,("AFP_P.isSearchPathSeparator a == (a == AFP_P.searchPathSeparator)", property $ \a -> AFP_P.isSearchPathSeparator a == (a == AFP_P.searchPathSeparator)) + ,("AFP_W.isSearchPathSeparator a == (a == AFP_W.searchPathSeparator)", property $ \a -> AFP_W.isSearchPathSeparator a == (a == AFP_W.searchPathSeparator)) + ,("P.extSeparator == '.'", property $ P.extSeparator == '.') + ,("W.extSeparator == '.'", property $ W.extSeparator == '.') + ,("AFP_P.extSeparator == (PW . fromIntegral . C.ord $ '.')", property $ AFP_P.extSeparator == (PW . fromIntegral . C.ord $ '.')) + ,("AFP_W.extSeparator == (WW . fromIntegral . C.ord $ '.')", property $ AFP_W.extSeparator == (WW . fromIntegral . C.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)) + ,("AFP_P.isExtSeparator a == (a == AFP_P.extSeparator)", property $ \a -> AFP_P.isExtSeparator a == (a == AFP_P.extSeparator)) + ,("AFP_W.isExtSeparator a == (a == AFP_W.extSeparator)", property $ \a -> AFP_W.isExtSeparator a == (a == AFP_W.extSeparator)) + ,("P.splitSearchPath \"File1:File2:File3\" == [\"File1\", \"File2\", \"File3\"]", property $ P.splitSearchPath "File1:File2:File3" == ["File1", "File2", "File3"]) + ,("AFP_P.splitSearchPath (\"File1:File2:File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_P.splitSearchPath ("File1:File2:File3") == [("File1"), ("File2"), ("File3")]) + ,("P.splitSearchPath \"File1::File2:File3\" == [\"File1\", \".\", \"File2\", \"File3\"]", property $ P.splitSearchPath "File1::File2:File3" == ["File1", ".", "File2", "File3"]) + ,("AFP_P.splitSearchPath (\"File1::File2:File3\") == [(\"File1\"), (\".\"), (\"File2\"), (\"File3\")]", property $ AFP_P.splitSearchPath ("File1::File2:File3") == [("File1"), ("."), ("File2"), ("File3")]) + ,("W.splitSearchPath \"File1;File2;File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;File2;File3" == ["File1", "File2", "File3"]) + ,("AFP_W.splitSearchPath (\"File1;File2;File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_W.splitSearchPath ("File1;File2;File3") == [("File1"), ("File2"), ("File3")]) + ,("W.splitSearchPath \"File1;;File2;File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;;File2;File3" == ["File1", "File2", "File3"]) + ,("AFP_W.splitSearchPath (\"File1;;File2;File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_W.splitSearchPath ("File1;;File2;File3") == [("File1"), ("File2"), ("File3")]) + ,("W.splitSearchPath \"File1;\\\"File2\\\";File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;\"File2\";File3" == ["File1", "File2", "File3"]) + ,("AFP_W.splitSearchPath (\"File1;\\\"File2\\\";File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_W.splitSearchPath ("File1;\"File2\";File3") == [("File1"), ("File2"), ("File3")]) + ,("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")) + ,("AFP_P.splitExtension (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_P.splitExtension ("/directory/path.ext") == (("/directory/path"), (".ext"))) + ,("AFP_W.splitExtension (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_W.splitExtension ("/directory/path.ext") == (("/directory/path"), (".ext"))) + ,("uncurry (<>) (P.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (<>) (P.splitExtension x) == x) + ,("uncurry (<>) (W.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (<>) (W.splitExtension x) == x) + ,("uncurry (<>) (AFP_P.splitExtension x) == x", property $ \(QFilePathAFP_P x) -> uncurry (<>) (AFP_P.splitExtension x) == x) + ,("uncurry (<>) (AFP_W.splitExtension x) == x", property $ \(QFilePathAFP_W x) -> uncurry (<>) (AFP_W.splitExtension x) == x) + ,("uncurry P.addExtension (P.splitExtension x) == x", property $ \(QFilePathValidP x) -> uncurry P.addExtension (P.splitExtension x) == x) + ,("uncurry W.addExtension (W.splitExtension x) == x", property $ \(QFilePathValidW x) -> uncurry W.addExtension (W.splitExtension x) == x) + ,("uncurry AFP_P.addExtension (AFP_P.splitExtension x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.addExtension (AFP_P.splitExtension x) == x) + ,("uncurry AFP_W.addExtension (AFP_W.splitExtension x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.addExtension (AFP_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")) + ,("AFP_P.splitExtension (\"file.txt\") == ((\"file\"), (\".txt\"))", property $ AFP_P.splitExtension ("file.txt") == (("file"), (".txt"))) + ,("AFP_W.splitExtension (\"file.txt\") == ((\"file\"), (\".txt\"))", property $ AFP_W.splitExtension ("file.txt") == (("file"), (".txt"))) + ,("P.splitExtension \"file\" == (\"file\", \"\")", property $ P.splitExtension "file" == ("file", "")) + ,("W.splitExtension \"file\" == (\"file\", \"\")", property $ W.splitExtension "file" == ("file", "")) + ,("AFP_P.splitExtension (\"file\") == ((\"file\"), (\"\"))", property $ AFP_P.splitExtension ("file") == (("file"), (""))) + ,("AFP_W.splitExtension (\"file\") == ((\"file\"), (\"\"))", property $ AFP_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")) + ,("AFP_P.splitExtension (\"file/file.txt\") == ((\"file/file\"), (\".txt\"))", property $ AFP_P.splitExtension ("file/file.txt") == (("file/file"), (".txt"))) + ,("AFP_W.splitExtension (\"file/file.txt\") == ((\"file/file\"), (\".txt\"))", property $ AFP_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", "")) + ,("AFP_P.splitExtension (\"file.txt/boris\") == ((\"file.txt/boris\"), (\"\"))", property $ AFP_P.splitExtension ("file.txt/boris") == (("file.txt/boris"), (""))) + ,("AFP_W.splitExtension (\"file.txt/boris\") == ((\"file.txt/boris\"), (\"\"))", property $ AFP_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")) + ,("AFP_P.splitExtension (\"file.txt/boris.ext\") == ((\"file.txt/boris\"), (\".ext\"))", property $ AFP_P.splitExtension ("file.txt/boris.ext") == (("file.txt/boris"), (".ext"))) + ,("AFP_W.splitExtension (\"file.txt/boris.ext\") == ((\"file.txt/boris\"), (\".ext\"))", property $ AFP_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")) + ,("AFP_P.splitExtension (\"file/path.txt.bob.fred\") == ((\"file/path.txt.bob\"), (\".fred\"))", property $ AFP_P.splitExtension ("file/path.txt.bob.fred") == (("file/path.txt.bob"), (".fred"))) + ,("AFP_W.splitExtension (\"file/path.txt.bob.fred\") == ((\"file/path.txt.bob\"), (\".fred\"))", property $ AFP_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/", "")) + ,("AFP_P.splitExtension (\"file/path.txt/\") == ((\"file/path.txt/\"), (\"\"))", property $ AFP_P.splitExtension ("file/path.txt/") == (("file/path.txt/"), (""))) + ,("AFP_W.splitExtension (\"file/path.txt/\") == ((\"file/path.txt/\"), (\"\"))", property $ AFP_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") + ,("AFP_P.takeExtension (\"/directory/path.ext\") == (\".ext\")", property $ AFP_P.takeExtension ("/directory/path.ext") == (".ext")) + ,("AFP_W.takeExtension (\"/directory/path.ext\") == (\".ext\")", property $ AFP_W.takeExtension ("/directory/path.ext") == (".ext")) + ,("P.takeExtension x == snd (P.splitExtension x)", property $ \(QFilePath x) -> P.takeExtension x == snd (P.splitExtension x)) + ,("W.takeExtension x == snd (W.splitExtension x)", property $ \(QFilePath x) -> W.takeExtension x == snd (W.splitExtension x)) + ,("AFP_P.takeExtension x == snd (AFP_P.splitExtension x)", property $ \(QFilePathAFP_P x) -> AFP_P.takeExtension x == snd (AFP_P.splitExtension x)) + ,("AFP_W.takeExtension x == snd (AFP_W.splitExtension x)", property $ \(QFilePathAFP_W x) -> AFP_W.takeExtension x == snd (AFP_W.splitExtension x)) + ,("P.takeExtension (P.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeExtension (P.addExtension x "ext") == ".ext") + ,("W.takeExtension (W.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeExtension (W.addExtension x "ext") == ".ext") + ,("AFP_P.takeExtension (AFP_P.addExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeExtension (AFP_P.addExtension x ("ext")) == (".ext")) + ,("AFP_W.takeExtension (AFP_W.addExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeExtension (AFP_W.addExtension x ("ext")) == (".ext")) + ,("P.takeExtension (P.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeExtension (P.replaceExtension x "ext") == ".ext") + ,("W.takeExtension (W.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeExtension (W.replaceExtension x "ext") == ".ext") + ,("AFP_P.takeExtension (AFP_P.replaceExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeExtension (AFP_P.replaceExtension x ("ext")) == (".ext")) + ,("AFP_W.takeExtension (AFP_W.replaceExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeExtension (AFP_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\") AFP_P.-<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_P.-<.> ("ext") == ("/directory/path.ext")) + ,("(\"/directory/path.txt\") AFP_W.-<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_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") + ,("(\"/directory/path.txt\") AFP_P.-<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_P.-<.> (".ext") == ("/directory/path.ext")) + ,("(\"/directory/path.txt\") AFP_W.-<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_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") + ,("(\"foo.o\") AFP_P.-<.> (\"c\") == (\"foo.c\")", property $ ("foo.o") AFP_P.-<.> ("c") == ("foo.c")) + ,("(\"foo.o\") AFP_W.-<.> (\"c\") == (\"foo.c\")", property $ ("foo.o") AFP_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") + ,("AFP_P.replaceExtension (\"/directory/path.txt\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_P.replaceExtension ("/directory/path.txt") ("ext") == ("/directory/path.ext")) + ,("AFP_W.replaceExtension (\"/directory/path.txt\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_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") + ,("AFP_P.replaceExtension (\"/directory/path.txt\") (\".ext\") == (\"/directory/path.ext\")", property $ AFP_P.replaceExtension ("/directory/path.txt") (".ext") == ("/directory/path.ext")) + ,("AFP_W.replaceExtension (\"/directory/path.txt\") (\".ext\") == (\"/directory/path.ext\")", property $ AFP_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") + ,("AFP_P.replaceExtension (\"file.txt\") (\".bob\") == (\"file.bob\")", property $ AFP_P.replaceExtension ("file.txt") (".bob") == ("file.bob")) + ,("AFP_W.replaceExtension (\"file.txt\") (\".bob\") == (\"file.bob\")", property $ AFP_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") + ,("AFP_P.replaceExtension (\"file.txt\") (\"bob\") == (\"file.bob\")", property $ AFP_P.replaceExtension ("file.txt") ("bob") == ("file.bob")) + ,("AFP_W.replaceExtension (\"file.txt\") (\"bob\") == (\"file.bob\")", property $ AFP_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") + ,("AFP_P.replaceExtension (\"file\") (\".bob\") == (\"file.bob\")", property $ AFP_P.replaceExtension ("file") (".bob") == ("file.bob")) + ,("AFP_W.replaceExtension (\"file\") (\".bob\") == (\"file.bob\")", property $ AFP_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") + ,("AFP_P.replaceExtension (\"file.txt\") (\"\") == (\"file\")", property $ AFP_P.replaceExtension ("file.txt") ("") == ("file")) + ,("AFP_W.replaceExtension (\"file.txt\") (\"\") == (\"file\")", property $ AFP_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") + ,("AFP_P.replaceExtension (\"file.fred.bob\") (\"txt\") == (\"file.fred.txt\")", property $ AFP_P.replaceExtension ("file.fred.bob") ("txt") == ("file.fred.txt")) + ,("AFP_W.replaceExtension (\"file.fred.bob\") (\"txt\") == (\"file.fred.txt\")", property $ AFP_W.replaceExtension ("file.fred.bob") ("txt") == ("file.fred.txt")) + ,("P.replaceExtension x y == P.addExtension (P.dropExtension x) y", property $ \(QFilePath x) (QFilePath y) -> P.replaceExtension x y == P.addExtension (P.dropExtension x) y) + ,("W.replaceExtension x y == W.addExtension (W.dropExtension x) y", property $ \(QFilePath x) (QFilePath y) -> W.replaceExtension x y == W.addExtension (W.dropExtension x) y) + ,("AFP_P.replaceExtension x y == AFP_P.addExtension (AFP_P.dropExtension x) y", property $ \(QFilePathAFP_P x) (QFilePathAFP_P y) -> AFP_P.replaceExtension x y == AFP_P.addExtension (AFP_P.dropExtension x) y) + ,("AFP_W.replaceExtension x y == AFP_W.addExtension (AFP_W.dropExtension x) y", property $ \(QFilePathAFP_W x) (QFilePathAFP_W y) -> AFP_W.replaceExtension x y == AFP_W.addExtension (AFP_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\") AFP_P.<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_P.<.> ("ext") == ("/directory/path.ext")) + ,("(\"/directory/path\") AFP_W.<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_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") + ,("(\"/directory/path\") AFP_P.<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_P.<.> (".ext") == ("/directory/path.ext")) + ,("(\"/directory/path\") AFP_W.<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_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") + ,("AFP_P.dropExtension (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_P.dropExtension ("/directory/path.ext") == ("/directory/path")) + ,("AFP_W.dropExtension (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_W.dropExtension ("/directory/path.ext") == ("/directory/path")) + ,("P.dropExtension x == fst (P.splitExtension x)", property $ \(QFilePath x) -> P.dropExtension x == fst (P.splitExtension x)) + ,("W.dropExtension x == fst (W.splitExtension x)", property $ \(QFilePath x) -> W.dropExtension x == fst (W.splitExtension x)) + ,("AFP_P.dropExtension x == fst (AFP_P.splitExtension x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropExtension x == fst (AFP_P.splitExtension x)) + ,("AFP_W.dropExtension x == fst (AFP_W.splitExtension x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropExtension x == fst (AFP_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") + ,("AFP_P.addExtension (\"/directory/path\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_P.addExtension ("/directory/path") ("ext") == ("/directory/path.ext")) + ,("AFP_W.addExtension (\"/directory/path\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_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") + ,("AFP_P.addExtension (\"file.txt\") (\"bib\") == (\"file.txt.bib\")", property $ AFP_P.addExtension ("file.txt") ("bib") == ("file.txt.bib")) + ,("AFP_W.addExtension (\"file.txt\") (\"bib\") == (\"file.txt.bib\")", property $ AFP_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") + ,("AFP_P.addExtension (\"file.\") (\".bib\") == (\"file..bib\")", property $ AFP_P.addExtension ("file.") (".bib") == ("file..bib")) + ,("AFP_W.addExtension (\"file.\") (\".bib\") == (\"file..bib\")", property $ AFP_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") + ,("AFP_P.addExtension (\"file\") (\".bib\") == (\"file.bib\")", property $ AFP_P.addExtension ("file") (".bib") == ("file.bib")) + ,("AFP_W.addExtension (\"file\") (\".bib\") == (\"file.bib\")", property $ AFP_W.addExtension ("file") (".bib") == ("file.bib")) + ,("P.addExtension \"/\" \"x\" == \"/.x\"", property $ P.addExtension "/" "x" == "/.x") + ,("W.addExtension \"/\" \"x\" == \"/.x\"", property $ W.addExtension "/" "x" == "/.x") + ,("AFP_P.addExtension (\"/\") (\"x\") == (\"/.x\")", property $ AFP_P.addExtension ("/") ("x") == ("/.x")) + ,("AFP_W.addExtension (\"/\") (\"x\") == (\"/.x\")", property $ AFP_W.addExtension ("/") ("x") == ("/.x")) + ,("P.addExtension x \"\" == x", property $ \(QFilePath x) -> P.addExtension x "" == x) + ,("W.addExtension x \"\" == x", property $ \(QFilePath x) -> W.addExtension x "" == x) + ,("AFP_P.addExtension x (\"\") == x", property $ \(QFilePathAFP_P x) -> AFP_P.addExtension x ("") == x) + ,("AFP_W.addExtension x (\"\") == x", property $ \(QFilePathAFP_W x) -> AFP_W.addExtension x ("") == x) + ,("P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) "ext") == ".ext") + ,("W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) "ext") == ".ext") + ,("AFP_P.takeFileName (AFP_P.addExtension (AFP_P.addTrailingPathSeparator x) (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeFileName (AFP_P.addExtension (AFP_P.addTrailingPathSeparator x) ("ext")) == (".ext")) + ,("AFP_W.takeFileName (AFP_W.addExtension (AFP_W.addTrailingPathSeparator x) (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeFileName (AFP_W.addExtension (AFP_W.addTrailingPathSeparator x) ("ext")) == (".ext")) + ,("W.addExtension \"\\\\\\\\share\" \".txt\" == \"\\\\\\\\share\\\\.txt\"", property $ W.addExtension "\\\\share" ".txt" == "\\\\share\\.txt") + ,("AFP_W.addExtension (\"\\\\\\\\share\") (\".txt\") == (\"\\\\\\\\share\\\\.txt\")", property $ AFP_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) + ,("AFP_P.hasExtension (\"/directory/path.ext\") == True", property $ AFP_P.hasExtension ("/directory/path.ext") == True) + ,("AFP_W.hasExtension (\"/directory/path.ext\") == True", property $ AFP_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) + ,("AFP_P.hasExtension (\"/directory/path\") == False", property $ AFP_P.hasExtension ("/directory/path") == False) + ,("AFP_W.hasExtension (\"/directory/path\") == False", property $ AFP_W.hasExtension ("/directory/path") == False) + ,("null (P.takeExtension x) == not (P.hasExtension x)", property $ \(QFilePath x) -> null (P.takeExtension x) == not (P.hasExtension x)) + ,("null (W.takeExtension x) == not (W.hasExtension x)", property $ \(QFilePath x) -> null (W.takeExtension x) == not (W.hasExtension x)) + ,("(SBS.null . getPosixString) (AFP_P.takeExtension x) == not (AFP_P.hasExtension x)", property $ \(QFilePathAFP_P x) -> (SBS.null . getPosixString) (AFP_P.takeExtension x) == not (AFP_P.hasExtension x)) + ,("(SBS16.null . getWindowsString) (AFP_W.takeExtension x) == not (AFP_W.hasExtension x)", property $ \(QFilePathAFP_W x) -> (SBS16.null . getWindowsString) (AFP_W.takeExtension x) == not (AFP_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\") `AFP_P.isExtensionOf` (\"/directory/file.png\") == True", property $ ("png") `AFP_P.isExtensionOf` ("/directory/file.png") == True) + ,("(\"png\") `AFP_W.isExtensionOf` (\"/directory/file.png\") == True", property $ ("png") `AFP_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) + ,("(\".png\") `AFP_P.isExtensionOf` (\"/directory/file.png\") == True", property $ (".png") `AFP_P.isExtensionOf` ("/directory/file.png") == True) + ,("(\".png\") `AFP_W.isExtensionOf` (\"/directory/file.png\") == True", property $ (".png") `AFP_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) + ,("(\".tar.gz\") `AFP_P.isExtensionOf` (\"bar/foo.tar.gz\") == True", property $ (".tar.gz") `AFP_P.isExtensionOf` ("bar/foo.tar.gz") == True) + ,("(\".tar.gz\") `AFP_W.isExtensionOf` (\"bar/foo.tar.gz\") == True", property $ (".tar.gz") `AFP_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) + ,("(\"ar.gz\") `AFP_P.isExtensionOf` (\"bar/foo.tar.gz\") == False", property $ ("ar.gz") `AFP_P.isExtensionOf` ("bar/foo.tar.gz") == False) + ,("(\"ar.gz\") `AFP_W.isExtensionOf` (\"bar/foo.tar.gz\") == False", property $ ("ar.gz") `AFP_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) + ,("(\"png\") `AFP_P.isExtensionOf` (\"/directory/file.png.jpg\") == False", property $ ("png") `AFP_P.isExtensionOf` ("/directory/file.png.jpg") == False) + ,("(\"png\") `AFP_W.isExtensionOf` (\"/directory/file.png.jpg\") == False", property $ ("png") `AFP_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) + ,("(\"csv/table.csv\") `AFP_P.isExtensionOf` (\"/data/csv/table.csv\") == False", property $ ("csv/table.csv") `AFP_P.isExtensionOf` ("/data/csv/table.csv") == False) + ,("(\"csv/table.csv\") `AFP_W.isExtensionOf` (\"/data/csv/table.csv\") == False", property $ ("csv/table.csv") `AFP_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") + ,("AFP_P.stripExtension (\"hs.o\") (\"foo.x.hs.o\") == Just (\"foo.x\")", property $ AFP_P.stripExtension ("hs.o") ("foo.x.hs.o") == Just ("foo.x")) + ,("AFP_W.stripExtension (\"hs.o\") (\"foo.x.hs.o\") == Just (\"foo.x\")", property $ AFP_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) + ,("AFP_P.stripExtension (\"hi.o\") (\"foo.x.hs.o\") == Nothing", property $ AFP_P.stripExtension ("hi.o") ("foo.x.hs.o") == Nothing) + ,("AFP_W.stripExtension (\"hi.o\") (\"foo.x.hs.o\") == Nothing", property $ AFP_W.stripExtension ("hi.o") ("foo.x.hs.o") == Nothing) + ,("P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)", property $ \(QFilePath x) -> P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)) + ,("W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)", property $ \(QFilePath x) -> W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)) + ,("AFP_P.dropExtension x == fromJust (AFP_P.stripExtension (AFP_P.takeExtension x) x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropExtension x == fromJust (AFP_P.stripExtension (AFP_P.takeExtension x) x)) + ,("AFP_W.dropExtension x == fromJust (AFP_W.stripExtension (AFP_W.takeExtension x) x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropExtension x == fromJust (AFP_W.stripExtension (AFP_W.takeExtension x) x)) + ,("P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)", property $ \(QFilePath x) -> P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)) + ,("W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)", property $ \(QFilePath x) -> W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)) + ,("AFP_P.dropExtensions x == fromJust (AFP_P.stripExtension (AFP_P.takeExtensions x) x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropExtensions x == fromJust (AFP_P.stripExtension (AFP_P.takeExtensions x) x)) + ,("AFP_W.dropExtensions x == fromJust (AFP_W.stripExtension (AFP_W.takeExtensions x) x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropExtensions x == fromJust (AFP_W.stripExtension (AFP_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") + ,("AFP_P.stripExtension (\".c.d\") (\"a.b.c.d\") == Just (\"a.b\")", property $ AFP_P.stripExtension (".c.d") ("a.b.c.d") == Just ("a.b")) + ,("AFP_W.stripExtension (\".c.d\") (\"a.b.c.d\") == Just (\"a.b\")", property $ AFP_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.") + ,("AFP_P.stripExtension (\".c.d\") (\"a.b..c.d\") == Just (\"a.b.\")", property $ AFP_P.stripExtension (".c.d") ("a.b..c.d") == Just ("a.b.")) + ,("AFP_W.stripExtension (\".c.d\") (\"a.b..c.d\") == Just (\"a.b.\")", property $ AFP_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) + ,("AFP_P.stripExtension (\"baz\") (\"foo.bar\") == Nothing", property $ AFP_P.stripExtension ("baz") ("foo.bar") == Nothing) + ,("AFP_W.stripExtension (\"baz\") (\"foo.bar\") == Nothing", property $ AFP_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) + ,("AFP_P.stripExtension (\"bar\") (\"foobar\") == Nothing", property $ AFP_P.stripExtension ("bar") ("foobar") == Nothing) + ,("AFP_W.stripExtension (\"bar\") (\"foobar\") == Nothing", property $ AFP_W.stripExtension ("bar") ("foobar") == Nothing) + ,("P.stripExtension \"\" x == Just x", property $ \(QFilePath x) -> P.stripExtension "" x == Just x) + ,("W.stripExtension \"\" x == Just x", property $ \(QFilePath x) -> W.stripExtension "" x == Just x) + ,("AFP_P.stripExtension (\"\") x == Just x", property $ \(QFilePathAFP_P x) -> AFP_P.stripExtension ("") x == Just x) + ,("AFP_W.stripExtension (\"\") x == Just x", property $ \(QFilePathAFP_W x) -> AFP_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")) + ,("AFP_P.splitExtensions (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_P.splitExtensions ("/directory/path.ext") == (("/directory/path"), (".ext"))) + ,("AFP_W.splitExtensions (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_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")) + ,("AFP_P.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_P.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz"))) + ,("AFP_W.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_W.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz"))) + ,("uncurry (<>) (P.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (<>) (P.splitExtensions x) == x) + ,("uncurry (<>) (W.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (<>) (W.splitExtensions x) == x) + ,("uncurry (<>) (AFP_P.splitExtensions x) == x", property $ \(QFilePathAFP_P x) -> uncurry (<>) (AFP_P.splitExtensions x) == x) + ,("uncurry (<>) (AFP_W.splitExtensions x) == x", property $ \(QFilePathAFP_W x) -> uncurry (<>) (AFP_W.splitExtensions x) == x) + ,("uncurry P.addExtension (P.splitExtensions x) == x", property $ \(QFilePathValidP x) -> uncurry P.addExtension (P.splitExtensions x) == x) + ,("uncurry W.addExtension (W.splitExtensions x) == x", property $ \(QFilePathValidW x) -> uncurry W.addExtension (W.splitExtensions x) == x) + ,("uncurry AFP_P.addExtension (AFP_P.splitExtensions x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.addExtension (AFP_P.splitExtensions x) == x) + ,("uncurry AFP_W.addExtension (AFP_W.splitExtensions x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.addExtension (AFP_W.splitExtensions x) == x) + ,("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") + ,("AFP_P.dropExtensions (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_P.dropExtensions ("/directory/path.ext") == ("/directory/path")) + ,("AFP_W.dropExtensions (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_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") + ,("AFP_P.dropExtensions (\"file.tar.gz\") == (\"file\")", property $ AFP_P.dropExtensions ("file.tar.gz") == ("file")) + ,("AFP_W.dropExtensions (\"file.tar.gz\") == (\"file\")", property $ AFP_W.dropExtensions ("file.tar.gz") == ("file")) + ,("not $ P.hasExtension $ P.dropExtensions x", property $ \(QFilePath x) -> not $ P.hasExtension $ P.dropExtensions x) + ,("not $ W.hasExtension $ W.dropExtensions x", property $ \(QFilePath x) -> not $ W.hasExtension $ W.dropExtensions x) + ,("not $ AFP_P.hasExtension $ AFP_P.dropExtensions x", property $ \(QFilePathAFP_P x) -> not $ AFP_P.hasExtension $ AFP_P.dropExtensions x) + ,("not $ AFP_W.hasExtension $ AFP_W.dropExtensions x", property $ \(QFilePathAFP_W x) -> not $ AFP_W.hasExtension $ AFP_W.dropExtensions x) + ,("not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x", property $ \(QFilePath x) -> not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x) + ,("not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x", property $ \(QFilePath x) -> not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x) + ,("not $ (\\f (getPosixString -> x) -> SBS.any (f . PW) x) AFP_P.isExtSeparator $ AFP_P.takeFileName $ AFP_P.dropExtensions x", property $ \(QFilePathAFP_P x) -> not $ (\f (getPosixString -> x) -> SBS.any (f . PW) x) AFP_P.isExtSeparator $ AFP_P.takeFileName $ AFP_P.dropExtensions x) + ,("not $ (\\f (getWindowsString -> x) -> SBS16.any (f . WW) x) AFP_W.isExtSeparator $ AFP_W.takeFileName $ AFP_W.dropExtensions x", property $ \(QFilePathAFP_W x) -> not $ (\f (getWindowsString -> x) -> SBS16.any (f . WW) x) AFP_W.isExtSeparator $ AFP_W.takeFileName $ AFP_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") + ,("AFP_P.takeExtensions (\"/directory/path.ext\") == (\".ext\")", property $ AFP_P.takeExtensions ("/directory/path.ext") == (".ext")) + ,("AFP_W.takeExtensions (\"/directory/path.ext\") == (\".ext\")", property $ AFP_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") + ,("AFP_P.takeExtensions (\"file.tar.gz\") == (\".tar.gz\")", property $ AFP_P.takeExtensions ("file.tar.gz") == (".tar.gz")) + ,("AFP_W.takeExtensions (\"file.tar.gz\") == (\".tar.gz\")", property $ AFP_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") + ,("AFP_P.replaceExtensions (\"file.fred.bob\") (\"txt\") == (\"file.txt\")", property $ AFP_P.replaceExtensions ("file.fred.bob") ("txt") == ("file.txt")) + ,("AFP_W.replaceExtensions (\"file.fred.bob\") (\"txt\") == (\"file.txt\")", property $ AFP_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") + ,("AFP_P.replaceExtensions (\"file.fred.bob\") (\"tar.gz\") == (\"file.tar.gz\")", property $ AFP_P.replaceExtensions ("file.fred.bob") ("tar.gz") == ("file.tar.gz")) + ,("AFP_W.replaceExtensions (\"file.fred.bob\") (\"tar.gz\") == (\"file.tar.gz\")", property $ AFP_W.replaceExtensions ("file.fred.bob") ("tar.gz") == ("file.tar.gz")) + ,("uncurry (<>) (P.splitDrive x) == x", property $ \(QFilePath x) -> uncurry (<>) (P.splitDrive x) == x) + ,("uncurry (<>) (W.splitDrive x) == x", property $ \(QFilePath x) -> uncurry (<>) (W.splitDrive x) == x) + ,("uncurry (<>) (AFP_P.splitDrive x) == x", property $ \(QFilePathAFP_P x) -> uncurry (<>) (AFP_P.splitDrive x) == x) + ,("uncurry (<>) (AFP_W.splitDrive x) == x", property $ \(QFilePathAFP_W x) -> uncurry (<>) (AFP_W.splitDrive x) == x) + ,("W.splitDrive \"file\" == (\"\", \"file\")", property $ W.splitDrive "file" == ("", "file")) + ,("AFP_W.splitDrive (\"file\") == ((\"\"), (\"file\"))", property $ AFP_W.splitDrive ("file") == ((""), ("file"))) + ,("W.splitDrive \"c:/file\" == (\"c:/\", \"file\")", property $ W.splitDrive "c:/file" == ("c:/", "file")) + ,("AFP_W.splitDrive (\"c:/file\") == ((\"c:/\"), (\"file\"))", property $ AFP_W.splitDrive ("c:/file") == (("c:/"), ("file"))) + ,("W.splitDrive \"c:\\\\file\" == (\"c:\\\\\", \"file\")", property $ W.splitDrive "c:\\file" == ("c:\\", "file")) + ,("AFP_W.splitDrive (\"c:\\\\file\") == ((\"c:\\\\\"), (\"file\"))", property $ AFP_W.splitDrive ("c:\\file") == (("c:\\"), ("file"))) + ,("W.splitDrive \"\\\\\\\\shared\\\\test\" == (\"\\\\\\\\shared\\\\\", \"test\")", property $ W.splitDrive "\\\\shared\\test" == ("\\\\shared\\", "test")) + ,("AFP_W.splitDrive (\"\\\\\\\\shared\\\\test\") == ((\"\\\\\\\\shared\\\\\"), (\"test\"))", property $ AFP_W.splitDrive ("\\\\shared\\test") == (("\\\\shared\\"), ("test"))) + ,("W.splitDrive \"\\\\\\\\shared\" == (\"\\\\\\\\shared\", \"\")", property $ W.splitDrive "\\\\shared" == ("\\\\shared", "")) + ,("AFP_W.splitDrive (\"\\\\\\\\shared\") == ((\"\\\\\\\\shared\"), (\"\"))", property $ AFP_W.splitDrive ("\\\\shared") == (("\\\\shared"), (""))) + ,("W.splitDrive \"\\\\\\\\?\\\\UNC\\\\shared\\\\file\" == (\"\\\\\\\\?\\\\UNC\\\\shared\\\\\", \"file\")", property $ W.splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\", "file")) + ,("AFP_W.splitDrive (\"\\\\\\\\?\\\\UNC\\\\shared\\\\file\") == ((\"\\\\\\\\?\\\\UNC\\\\shared\\\\\"), (\"file\"))", property $ AFP_W.splitDrive ("\\\\?\\UNC\\shared\\file") == (("\\\\?\\UNC\\shared\\"), ("file"))) + ,("W.splitDrive \"\\\\\\\\?\\\\UNCshared\\\\file\" == (\"\\\\\\\\?\\\\\", \"UNCshared\\\\file\")", property $ W.splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\", "UNCshared\\file")) + ,("AFP_W.splitDrive (\"\\\\\\\\?\\\\UNCshared\\\\file\") == ((\"\\\\\\\\?\\\\\"), (\"UNCshared\\\\file\"))", property $ AFP_W.splitDrive ("\\\\?\\UNCshared\\file") == (("\\\\?\\"), ("UNCshared\\file"))) + ,("W.splitDrive \"\\\\\\\\?\\\\d:\\\\file\" == (\"\\\\\\\\?\\\\d:\\\\\", \"file\")", property $ W.splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\", "file")) + ,("AFP_W.splitDrive (\"\\\\\\\\?\\\\d:\\\\file\") == ((\"\\\\\\\\?\\\\d:\\\\\"), (\"file\"))", property $ AFP_W.splitDrive ("\\\\?\\d:\\file") == (("\\\\?\\d:\\"), ("file"))) + ,("W.splitDrive \"/d\" == (\"\", \"/d\")", property $ W.splitDrive "/d" == ("", "/d")) + ,("AFP_W.splitDrive (\"/d\") == ((\"\"), (\"/d\"))", property $ AFP_W.splitDrive ("/d") == ((""), ("/d"))) + ,("P.splitDrive \"/test\" == (\"/\", \"test\")", property $ P.splitDrive "/test" == ("/", "test")) + ,("AFP_P.splitDrive (\"/test\") == ((\"/\"), (\"test\"))", property $ AFP_P.splitDrive ("/test") == (("/"), ("test"))) + ,("P.splitDrive \"//test\" == (\"//\", \"test\")", property $ P.splitDrive "//test" == ("//", "test")) + ,("AFP_P.splitDrive (\"//test\") == ((\"//\"), (\"test\"))", property $ AFP_P.splitDrive ("//test") == (("//"), ("test"))) + ,("P.splitDrive \"test/file\" == (\"\", \"test/file\")", property $ P.splitDrive "test/file" == ("", "test/file")) + ,("AFP_P.splitDrive (\"test/file\") == ((\"\"), (\"test/file\"))", property $ AFP_P.splitDrive ("test/file") == ((""), ("test/file"))) + ,("P.splitDrive \"file\" == (\"\", \"file\")", property $ P.splitDrive "file" == ("", "file")) + ,("AFP_P.splitDrive (\"file\") == ((\"\"), (\"file\"))", property $ AFP_P.splitDrive ("file") == ((""), ("file"))) + ,("uncurry P.joinDrive (P.splitDrive x) == x", property $ \(QFilePathValidP x) -> uncurry P.joinDrive (P.splitDrive x) == x) + ,("uncurry W.joinDrive (W.splitDrive x) == x", property $ \(QFilePathValidW x) -> uncurry W.joinDrive (W.splitDrive x) == x) + ,("uncurry AFP_P.joinDrive (AFP_P.splitDrive x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.joinDrive (AFP_P.splitDrive x) == x) + ,("uncurry AFP_W.joinDrive (AFP_W.splitDrive x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.joinDrive (AFP_W.splitDrive x) == x) + ,("W.joinDrive \"C:\" \"foo\" == \"C:foo\"", property $ W.joinDrive "C:" "foo" == "C:foo") + ,("AFP_W.joinDrive (\"C:\") (\"foo\") == (\"C:foo\")", property $ AFP_W.joinDrive ("C:") ("foo") == ("C:foo")) + ,("W.joinDrive \"C:\\\\\" \"bar\" == \"C:\\\\bar\"", property $ W.joinDrive "C:\\" "bar" == "C:\\bar") + ,("AFP_W.joinDrive (\"C:\\\\\") (\"bar\") == (\"C:\\\\bar\")", property $ AFP_W.joinDrive ("C:\\") ("bar") == ("C:\\bar")) + ,("W.joinDrive \"\\\\\\\\share\" \"foo\" == \"\\\\\\\\share\\\\foo\"", property $ W.joinDrive "\\\\share" "foo" == "\\\\share\\foo") + ,("AFP_W.joinDrive (\"\\\\\\\\share\") (\"foo\") == (\"\\\\\\\\share\\\\foo\")", property $ AFP_W.joinDrive ("\\\\share") ("foo") == ("\\\\share\\foo")) + ,("W.joinDrive \"/:\" \"foo\" == \"/:\\\\foo\"", property $ W.joinDrive "/:" "foo" == "/:\\foo") + ,("AFP_W.joinDrive (\"/:\") (\"foo\") == (\"/:\\\\foo\")", property $ AFP_W.joinDrive ("/:") ("foo") == ("/:\\foo")) + ,("P.takeDrive x == fst (P.splitDrive x)", property $ \(QFilePath x) -> P.takeDrive x == fst (P.splitDrive x)) + ,("W.takeDrive x == fst (W.splitDrive x)", property $ \(QFilePath x) -> W.takeDrive x == fst (W.splitDrive x)) + ,("AFP_P.takeDrive x == fst (AFP_P.splitDrive x)", property $ \(QFilePathAFP_P x) -> AFP_P.takeDrive x == fst (AFP_P.splitDrive x)) + ,("AFP_W.takeDrive x == fst (AFP_W.splitDrive x)", property $ \(QFilePathAFP_W x) -> AFP_W.takeDrive x == fst (AFP_W.splitDrive x)) + ,("P.dropDrive x == snd (P.splitDrive x)", property $ \(QFilePath x) -> P.dropDrive x == snd (P.splitDrive x)) + ,("W.dropDrive x == snd (W.splitDrive x)", property $ \(QFilePath x) -> W.dropDrive x == snd (W.splitDrive x)) + ,("AFP_P.dropDrive x == snd (AFP_P.splitDrive x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropDrive x == snd (AFP_P.splitDrive x)) + ,("AFP_W.dropDrive x == snd (AFP_W.splitDrive x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropDrive x == snd (AFP_W.splitDrive x)) + ,("not (P.hasDrive x) == null (P.takeDrive x)", property $ \(QFilePath x) -> not (P.hasDrive x) == null (P.takeDrive x)) + ,("not (W.hasDrive x) == null (W.takeDrive x)", property $ \(QFilePath x) -> not (W.hasDrive x) == null (W.takeDrive x)) + ,("not (AFP_P.hasDrive x) == (SBS.null . getPosixString) (AFP_P.takeDrive x)", property $ \(QFilePathAFP_P x) -> not (AFP_P.hasDrive x) == (SBS.null . getPosixString) (AFP_P.takeDrive x)) + ,("not (AFP_W.hasDrive x) == (SBS16.null . getWindowsString) (AFP_W.takeDrive x)", property $ \(QFilePathAFP_W x) -> not (AFP_W.hasDrive x) == (SBS16.null . getWindowsString) (AFP_W.takeDrive x)) + ,("P.hasDrive \"/foo\" == True", property $ P.hasDrive "/foo" == True) + ,("AFP_P.hasDrive (\"/foo\") == True", property $ AFP_P.hasDrive ("/foo") == True) + ,("W.hasDrive \"C:\\\\foo\" == True", property $ W.hasDrive "C:\\foo" == True) + ,("AFP_W.hasDrive (\"C:\\\\foo\") == True", property $ AFP_W.hasDrive ("C:\\foo") == True) + ,("W.hasDrive \"C:foo\" == True", property $ W.hasDrive "C:foo" == True) + ,("AFP_W.hasDrive (\"C:foo\") == True", property $ AFP_W.hasDrive ("C:foo") == True) + ,("P.hasDrive \"foo\" == False", property $ P.hasDrive "foo" == False) + ,("W.hasDrive \"foo\" == False", property $ W.hasDrive "foo" == False) + ,("AFP_P.hasDrive (\"foo\") == False", property $ AFP_P.hasDrive ("foo") == False) + ,("AFP_W.hasDrive (\"foo\") == False", property $ AFP_W.hasDrive ("foo") == False) + ,("P.hasDrive \"\" == False", property $ P.hasDrive "" == False) + ,("W.hasDrive \"\" == False", property $ W.hasDrive "" == False) + ,("AFP_P.hasDrive (\"\") == False", property $ AFP_P.hasDrive ("") == False) + ,("AFP_W.hasDrive (\"\") == False", property $ AFP_W.hasDrive ("") == False) + ,("P.isDrive \"/\" == True", property $ P.isDrive "/" == True) + ,("AFP_P.isDrive (\"/\") == True", property $ AFP_P.isDrive ("/") == True) + ,("P.isDrive \"/foo\" == False", property $ P.isDrive "/foo" == False) + ,("AFP_P.isDrive (\"/foo\") == False", property $ AFP_P.isDrive ("/foo") == False) + ,("W.isDrive \"C:\\\\\" == True", property $ W.isDrive "C:\\" == True) + ,("AFP_W.isDrive (\"C:\\\\\") == True", property $ AFP_W.isDrive ("C:\\") == True) + ,("W.isDrive \"C:\\\\foo\" == False", property $ W.isDrive "C:\\foo" == False) + ,("AFP_W.isDrive (\"C:\\\\foo\") == False", property $ AFP_W.isDrive ("C:\\foo") == False) + ,("P.isDrive \"\" == False", property $ P.isDrive "" == False) + ,("W.isDrive \"\" == False", property $ W.isDrive "" == False) + ,("AFP_P.isDrive (\"\") == False", property $ AFP_P.isDrive ("") == False) + ,("AFP_W.isDrive (\"\") == False", property $ AFP_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")) + ,("AFP_P.splitFileName (\"/directory/file.ext\") == ((\"/directory/\"), (\"file.ext\"))", property $ AFP_P.splitFileName ("/directory/file.ext") == (("/directory/"), ("file.ext"))) + ,("AFP_W.splitFileName (\"/directory/file.ext\") == ((\"/directory/\"), (\"file.ext\"))", property $ AFP_W.splitFileName ("/directory/file.ext") == (("/directory/"), ("file.ext"))) + ,("uncurry (P.) (P.splitFileName x) == x || fst (P.splitFileName x) == \"./\"", property $ \(QFilePathValidP x) -> uncurry (P.) (P.splitFileName x) == x || fst (P.splitFileName x) == "./") + ,("uncurry (W.) (W.splitFileName x) == x || fst (W.splitFileName x) == \"./\"", property $ \(QFilePathValidW x) -> uncurry (W.) (W.splitFileName x) == x || fst (W.splitFileName x) == "./") + ,("uncurry (AFP_P.) (AFP_P.splitFileName x) == x || fst (AFP_P.splitFileName x) == (\"./\")", property $ \(QFilePathValidAFP_P x) -> uncurry (AFP_P.) (AFP_P.splitFileName x) == x || fst (AFP_P.splitFileName x) == ("./")) + ,("uncurry (AFP_W.) (AFP_W.splitFileName x) == x || fst (AFP_W.splitFileName x) == (\"./\")", property $ \(QFilePathValidAFP_W x) -> uncurry (AFP_W.) (AFP_W.splitFileName x) == x || fst (AFP_W.splitFileName x) == ("./")) + ,("P.isValid (fst (P.splitFileName x))", property $ \(QFilePathValidP x) -> P.isValid (fst (P.splitFileName x))) + ,("W.isValid (fst (W.splitFileName x))", property $ \(QFilePathValidW x) -> W.isValid (fst (W.splitFileName x))) + ,("AFP_P.isValid (fst (AFP_P.splitFileName x))", property $ \(QFilePathValidAFP_P x) -> AFP_P.isValid (fst (AFP_P.splitFileName x))) + ,("AFP_W.isValid (fst (AFP_W.splitFileName x))", property $ \(QFilePathValidAFP_W x) -> AFP_W.isValid (fst (AFP_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")) + ,("AFP_P.splitFileName (\"file/bob.txt\") == ((\"file/\"), (\"bob.txt\"))", property $ AFP_P.splitFileName ("file/bob.txt") == (("file/"), ("bob.txt"))) + ,("AFP_W.splitFileName (\"file/bob.txt\") == ((\"file/\"), (\"bob.txt\"))", property $ AFP_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/", "")) + ,("AFP_P.splitFileName (\"file/\") == ((\"file/\"), (\"\"))", property $ AFP_P.splitFileName ("file/") == (("file/"), (""))) + ,("AFP_W.splitFileName (\"file/\") == ((\"file/\"), (\"\"))", property $ AFP_W.splitFileName ("file/") == (("file/"), (""))) + ,("P.splitFileName \"bob\" == (\"./\", \"bob\")", property $ P.splitFileName "bob" == ("./", "bob")) + ,("W.splitFileName \"bob\" == (\"./\", \"bob\")", property $ W.splitFileName "bob" == ("./", "bob")) + ,("AFP_P.splitFileName (\"bob\") == ((\"./\"), (\"bob\"))", property $ AFP_P.splitFileName ("bob") == (("./"), ("bob"))) + ,("AFP_W.splitFileName (\"bob\") == ((\"./\"), (\"bob\"))", property $ AFP_W.splitFileName ("bob") == (("./"), ("bob"))) + ,("P.splitFileName \"/\" == (\"/\", \"\")", property $ P.splitFileName "/" == ("/", "")) + ,("AFP_P.splitFileName (\"/\") == ((\"/\"), (\"\"))", property $ AFP_P.splitFileName ("/") == (("/"), (""))) + ,("W.splitFileName \"c:\" == (\"c:\", \"\")", property $ W.splitFileName "c:" == ("c:", "")) + ,("AFP_W.splitFileName (\"c:\") == ((\"c:\"), (\"\"))", property $ AFP_W.splitFileName ("c:") == (("c:"), (""))) + ,("W.splitFileName \"\\\\\\\\?\\\\A:\\\\fred\" == (\"\\\\\\\\?\\\\A:\\\\\", \"fred\")", property $ W.splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\", "fred")) + ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\\\\fred\") == ((\"\\\\\\\\?\\\\A:\\\\\"), (\"fred\"))", property $ AFP_W.splitFileName ("\\\\?\\A:\\fred") == (("\\\\?\\A:\\"), ("fred"))) + ,("W.splitFileName \"\\\\\\\\?\\\\A:\" == (\"\\\\\\\\?\\\\A:\", \"\")", property $ W.splitFileName "\\\\?\\A:" == ("\\\\?\\A:", "")) + ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\") == ((\"\\\\\\\\?\\\\A:\"), (\"\"))", property $ AFP_W.splitFileName ("\\\\?\\A:") == (("\\\\?\\A:"), (""))) + ,("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") + ,("AFP_P.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_P.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext")) + ,("AFP_W.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_W.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext")) + ,("P.replaceFileName x (P.takeFileName x) == x", property $ \(QFilePathValidP x) -> P.replaceFileName x (P.takeFileName x) == x) + ,("W.replaceFileName x (W.takeFileName x) == x", property $ \(QFilePathValidW x) -> W.replaceFileName x (W.takeFileName x) == x) + ,("AFP_P.replaceFileName x (AFP_P.takeFileName x) == x", property $ \(QFilePathValidAFP_P x) -> AFP_P.replaceFileName x (AFP_P.takeFileName x) == x) + ,("AFP_W.replaceFileName x (AFP_W.takeFileName x) == x", property $ \(QFilePathValidAFP_W x) -> AFP_W.replaceFileName x (AFP_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/") + ,("AFP_P.dropFileName (\"/directory/file.ext\") == (\"/directory/\")", property $ AFP_P.dropFileName ("/directory/file.ext") == ("/directory/")) + ,("AFP_W.dropFileName (\"/directory/file.ext\") == (\"/directory/\")", property $ AFP_W.dropFileName ("/directory/file.ext") == ("/directory/")) + ,("P.dropFileName x == fst (P.splitFileName x)", property $ \(QFilePath x) -> P.dropFileName x == fst (P.splitFileName x)) + ,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath x) -> W.dropFileName x == fst (W.splitFileName x)) + ,("AFP_P.dropFileName x == fst (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropFileName x == fst (AFP_P.splitFileName x)) + ,("AFP_W.dropFileName x == fst (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropFileName x == fst (AFP_W.splitFileName x)) + ,("isPrefixOf (P.takeDrive x) (P.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (P.takeDrive x) (P.dropFileName x)) + ,("isPrefixOf (W.takeDrive x) (W.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (W.takeDrive x) (W.dropFileName x)) + ,("(\\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x)", property $ \(QFilePathAFP_P x) -> (\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x)) + ,("(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x)", property $ \(QFilePathAFP_W x) -> (\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName 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") + ,("AFP_P.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.takeFileName ("/directory/file.ext") == ("file.ext")) + ,("AFP_W.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_W.takeFileName ("/directory/file.ext") == ("file.ext")) + ,("P.takeFileName \"test/\" == \"\"", property $ P.takeFileName "test/" == "") + ,("W.takeFileName \"test/\" == \"\"", property $ W.takeFileName "test/" == "") + ,("AFP_P.takeFileName (\"test/\") == (\"\")", property $ AFP_P.takeFileName ("test/") == ("")) + ,("AFP_W.takeFileName (\"test/\") == (\"\")", property $ AFP_W.takeFileName ("test/") == ("")) + ,("isSuffixOf (P.takeFileName x) x", property $ \(QFilePath x) -> isSuffixOf (P.takeFileName x) x) + ,("isSuffixOf (W.takeFileName x) x", property $ \(QFilePath x) -> isSuffixOf (W.takeFileName x) x) + ,("(\\(getPosixString -> x) (getPosixString -> y) -> SBS.isSuffixOf x y) (AFP_P.takeFileName x) x", property $ \(QFilePathAFP_P x) -> (\(getPosixString -> x) (getPosixString -> y) -> SBS.isSuffixOf x y) (AFP_P.takeFileName x) x) + ,("(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isSuffixOf x y) (AFP_W.takeFileName x) x", property $ \(QFilePathAFP_W x) -> (\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isSuffixOf x y) (AFP_W.takeFileName x) x) + ,("P.takeFileName x == snd (P.splitFileName x)", property $ \(QFilePath x) -> P.takeFileName x == snd (P.splitFileName x)) + ,("W.takeFileName x == snd (W.splitFileName x)", property $ \(QFilePath x) -> W.takeFileName x == snd (W.splitFileName x)) + ,("AFP_P.takeFileName x == snd (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.takeFileName x == snd (AFP_P.splitFileName x)) + ,("AFP_W.takeFileName x == snd (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.takeFileName x == snd (AFP_W.splitFileName x)) + ,("P.takeFileName (P.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidP x) -> P.takeFileName (P.replaceFileName x "fred") == "fred") + ,("W.takeFileName (W.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidW x) -> W.takeFileName (W.replaceFileName x "fred") == "fred") + ,("AFP_P.takeFileName (AFP_P.replaceFileName x (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeFileName (AFP_P.replaceFileName x ("fred")) == ("fred")) + ,("AFP_W.takeFileName (AFP_W.replaceFileName x (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeFileName (AFP_W.replaceFileName x ("fred")) == ("fred")) + ,("P.takeFileName (x P. \"fred\") == \"fred\"", property $ \(QFilePathValidP x) -> P.takeFileName (x P. "fred") == "fred") + ,("W.takeFileName (x W. \"fred\") == \"fred\"", property $ \(QFilePathValidW x) -> W.takeFileName (x W. "fred") == "fred") + ,("AFP_P.takeFileName (x AFP_P. (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeFileName (x AFP_P. ("fred")) == ("fred")) + ,("AFP_W.takeFileName (x AFP_W. (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeFileName (x AFP_W. ("fred")) == ("fred")) + ,("P.isRelative (P.takeFileName x)", property $ \(QFilePathValidP x) -> P.isRelative (P.takeFileName x)) + ,("W.isRelative (W.takeFileName x)", property $ \(QFilePathValidW x) -> W.isRelative (W.takeFileName x)) + ,("AFP_P.isRelative (AFP_P.takeFileName x)", property $ \(QFilePathValidAFP_P x) -> AFP_P.isRelative (AFP_P.takeFileName x)) + ,("AFP_W.isRelative (AFP_W.takeFileName x)", property $ \(QFilePathValidAFP_W x) -> AFP_W.isRelative (AFP_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") + ,("AFP_P.takeBaseName (\"/directory/file.ext\") == (\"file\")", property $ AFP_P.takeBaseName ("/directory/file.ext") == ("file")) + ,("AFP_W.takeBaseName (\"/directory/file.ext\") == (\"file\")", property $ AFP_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") + ,("AFP_P.takeBaseName (\"file/test.txt\") == (\"test\")", property $ AFP_P.takeBaseName ("file/test.txt") == ("test")) + ,("AFP_W.takeBaseName (\"file/test.txt\") == (\"test\")", property $ AFP_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") + ,("AFP_P.takeBaseName (\"dave.ext\") == (\"dave\")", property $ AFP_P.takeBaseName ("dave.ext") == ("dave")) + ,("AFP_W.takeBaseName (\"dave.ext\") == (\"dave\")", property $ AFP_W.takeBaseName ("dave.ext") == ("dave")) + ,("P.takeBaseName \"\" == \"\"", property $ P.takeBaseName "" == "") + ,("W.takeBaseName \"\" == \"\"", property $ W.takeBaseName "" == "") + ,("AFP_P.takeBaseName (\"\") == (\"\")", property $ AFP_P.takeBaseName ("") == ("")) + ,("AFP_W.takeBaseName (\"\") == (\"\")", property $ AFP_W.takeBaseName ("") == ("")) + ,("P.takeBaseName \"test\" == \"test\"", property $ P.takeBaseName "test" == "test") + ,("W.takeBaseName \"test\" == \"test\"", property $ W.takeBaseName "test" == "test") + ,("AFP_P.takeBaseName (\"test\") == (\"test\")", property $ AFP_P.takeBaseName ("test") == ("test")) + ,("AFP_W.takeBaseName (\"test\") == (\"test\")", property $ AFP_W.takeBaseName ("test") == ("test")) + ,("P.takeBaseName (P.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath x) -> P.takeBaseName (P.addTrailingPathSeparator x) == "") + ,("W.takeBaseName (W.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath x) -> W.takeBaseName (W.addTrailingPathSeparator x) == "") + ,("AFP_P.takeBaseName (AFP_P.addTrailingPathSeparator x) == (\"\")", property $ \(QFilePathAFP_P x) -> AFP_P.takeBaseName (AFP_P.addTrailingPathSeparator x) == ("")) + ,("AFP_W.takeBaseName (AFP_W.addTrailingPathSeparator x) == (\"\")", property $ \(QFilePathAFP_W x) -> AFP_W.takeBaseName (AFP_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") + ,("AFP_P.takeBaseName (\"file/file.tar.gz\") == (\"file.tar\")", property $ AFP_P.takeBaseName ("file/file.tar.gz") == ("file.tar")) + ,("AFP_W.takeBaseName (\"file/file.tar.gz\") == (\"file.tar\")", property $ AFP_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") + ,("AFP_P.replaceBaseName (\"/directory/other.ext\") (\"file\") == (\"/directory/file.ext\")", property $ AFP_P.replaceBaseName ("/directory/other.ext") ("file") == ("/directory/file.ext")) + ,("AFP_W.replaceBaseName (\"/directory/other.ext\") (\"file\") == (\"/directory/file.ext\")", property $ AFP_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") + ,("AFP_P.replaceBaseName (\"file/test.txt\") (\"bob\") == (\"file/bob.txt\")", property $ AFP_P.replaceBaseName ("file/test.txt") ("bob") == ("file/bob.txt")) + ,("AFP_W.replaceBaseName (\"file/test.txt\") (\"bob\") == (\"file/bob.txt\")", property $ AFP_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") + ,("AFP_P.replaceBaseName (\"fred\") (\"bill\") == (\"bill\")", property $ AFP_P.replaceBaseName ("fred") ("bill") == ("bill")) + ,("AFP_W.replaceBaseName (\"fred\") (\"bill\") == (\"bill\")", property $ AFP_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") + ,("AFP_P.replaceBaseName (\"/dave/fred/bob.gz.tar\") (\"new\") == (\"/dave/fred/new.tar\")", property $ AFP_P.replaceBaseName ("/dave/fred/bob.gz.tar") ("new") == ("/dave/fred/new.tar")) + ,("AFP_W.replaceBaseName (\"/dave/fred/bob.gz.tar\") (\"new\") == (\"/dave/fred/new.tar\")", property $ AFP_W.replaceBaseName ("/dave/fred/bob.gz.tar") ("new") == ("/dave/fred/new.tar")) + ,("P.replaceBaseName x (P.takeBaseName x) == x", property $ \(QFilePathValidP x) -> P.replaceBaseName x (P.takeBaseName x) == x) + ,("W.replaceBaseName x (W.takeBaseName x) == x", property $ \(QFilePathValidW x) -> W.replaceBaseName x (W.takeBaseName x) == x) + ,("AFP_P.replaceBaseName x (AFP_P.takeBaseName x) == x", property $ \(QFilePathValidAFP_P x) -> AFP_P.replaceBaseName x (AFP_P.takeBaseName x) == x) + ,("AFP_W.replaceBaseName x (AFP_W.takeBaseName x) == x", property $ \(QFilePathValidAFP_W x) -> AFP_W.replaceBaseName x (AFP_W.takeBaseName x) == x) + ,("P.hasTrailingPathSeparator \"test\" == False", property $ P.hasTrailingPathSeparator "test" == False) + ,("W.hasTrailingPathSeparator \"test\" == False", property $ W.hasTrailingPathSeparator "test" == False) + ,("AFP_P.hasTrailingPathSeparator (\"test\") == False", property $ AFP_P.hasTrailingPathSeparator ("test") == False) + ,("AFP_W.hasTrailingPathSeparator (\"test\") == False", property $ AFP_W.hasTrailingPathSeparator ("test") == False) + ,("P.hasTrailingPathSeparator \"test/\" == True", property $ P.hasTrailingPathSeparator "test/" == True) + ,("W.hasTrailingPathSeparator \"test/\" == True", property $ W.hasTrailingPathSeparator "test/" == True) + ,("AFP_P.hasTrailingPathSeparator (\"test/\") == True", property $ AFP_P.hasTrailingPathSeparator ("test/") == True) + ,("AFP_W.hasTrailingPathSeparator (\"test/\") == True", property $ AFP_W.hasTrailingPathSeparator ("test/") == True) + ,("P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)", property $ \(QFilePath x) -> P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)) + ,("W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)", property $ \(QFilePath x) -> W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)) + ,("AFP_P.hasTrailingPathSeparator (AFP_P.addTrailingPathSeparator x)", property $ \(QFilePathAFP_P x) -> AFP_P.hasTrailingPathSeparator (AFP_P.addTrailingPathSeparator x)) + ,("AFP_W.hasTrailingPathSeparator (AFP_W.addTrailingPathSeparator x)", property $ \(QFilePathAFP_W x) -> AFP_W.hasTrailingPathSeparator (AFP_W.addTrailingPathSeparator x)) + ,("P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x) + ,("W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x) + ,("AFP_P.hasTrailingPathSeparator x ==> AFP_P.addTrailingPathSeparator x == x", property $ \(QFilePathAFP_P x) -> AFP_P.hasTrailingPathSeparator x ==> AFP_P.addTrailingPathSeparator x == x) + ,("AFP_W.hasTrailingPathSeparator x ==> AFP_W.addTrailingPathSeparator x == x", property $ \(QFilePathAFP_W x) -> AFP_W.hasTrailingPathSeparator x ==> AFP_W.addTrailingPathSeparator x == x) + ,("P.addTrailingPathSeparator \"test/rest\" == \"test/rest/\"", property $ P.addTrailingPathSeparator "test/rest" == "test/rest/") + ,("AFP_P.addTrailingPathSeparator (\"test/rest\") == (\"test/rest/\")", property $ AFP_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") + ,("AFP_P.dropTrailingPathSeparator (\"file/test/\") == (\"file/test\")", property $ AFP_P.dropTrailingPathSeparator ("file/test/") == ("file/test")) + ,("AFP_W.dropTrailingPathSeparator (\"file/test/\") == (\"file/test\")", property $ AFP_W.dropTrailingPathSeparator ("file/test/") == ("file/test")) + ,("P.dropTrailingPathSeparator \"/\" == \"/\"", property $ P.dropTrailingPathSeparator "/" == "/") + ,("W.dropTrailingPathSeparator \"/\" == \"/\"", property $ W.dropTrailingPathSeparator "/" == "/") + ,("AFP_P.dropTrailingPathSeparator (\"/\") == (\"/\")", property $ AFP_P.dropTrailingPathSeparator ("/") == ("/")) + ,("AFP_W.dropTrailingPathSeparator (\"/\") == (\"/\")", property $ AFP_W.dropTrailingPathSeparator ("/") == ("/")) + ,("W.dropTrailingPathSeparator \"\\\\\" == \"\\\\\"", property $ W.dropTrailingPathSeparator "\\" == "\\") + ,("AFP_W.dropTrailingPathSeparator (\"\\\\\") == (\"\\\\\")", property $ AFP_W.dropTrailingPathSeparator ("\\") == ("\\")) + ,("not (P.hasTrailingPathSeparator (P.dropTrailingPathSeparator x)) || P.isDrive x", property $ \(QFilePath x) -> not (P.hasTrailingPathSeparator (P.dropTrailingPathSeparator x)) || P.isDrive x) + ,("not (AFP_P.hasTrailingPathSeparator (AFP_P.dropTrailingPathSeparator x)) || AFP_P.isDrive x", property $ \(QFilePathAFP_P x) -> not (AFP_P.hasTrailingPathSeparator (AFP_P.dropTrailingPathSeparator x)) || AFP_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") + ,("AFP_P.takeDirectory (\"/directory/other.ext\") == (\"/directory\")", property $ AFP_P.takeDirectory ("/directory/other.ext") == ("/directory")) + ,("AFP_W.takeDirectory (\"/directory/other.ext\") == (\"/directory\")", property $ AFP_W.takeDirectory ("/directory/other.ext") == ("/directory")) + ,("isPrefixOf (P.takeDirectory x) x || P.takeDirectory x == \".\"", property $ \(QFilePath x) -> isPrefixOf (P.takeDirectory x) x || P.takeDirectory x == ".") + ,("isPrefixOf (W.takeDirectory x) x || W.takeDirectory x == \".\"", property $ \(QFilePath x) -> isPrefixOf (W.takeDirectory x) x || W.takeDirectory x == ".") + ,("(\\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDirectory x) x || AFP_P.takeDirectory x == (\".\")", property $ \(QFilePathAFP_P x) -> (\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDirectory x) x || AFP_P.takeDirectory x == (".")) + ,("(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDirectory x) x || AFP_W.takeDirectory x == (\".\")", property $ \(QFilePathAFP_W x) -> (\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDirectory x) x || AFP_W.takeDirectory x == (".")) + ,("P.takeDirectory \"foo\" == \".\"", property $ P.takeDirectory "foo" == ".") + ,("W.takeDirectory \"foo\" == \".\"", property $ W.takeDirectory "foo" == ".") + ,("AFP_P.takeDirectory (\"foo\") == (\".\")", property $ AFP_P.takeDirectory ("foo") == (".")) + ,("AFP_W.takeDirectory (\"foo\") == (\".\")", property $ AFP_W.takeDirectory ("foo") == (".")) + ,("P.takeDirectory \"/\" == \"/\"", property $ P.takeDirectory "/" == "/") + ,("W.takeDirectory \"/\" == \"/\"", property $ W.takeDirectory "/" == "/") + ,("AFP_P.takeDirectory (\"/\") == (\"/\")", property $ AFP_P.takeDirectory ("/") == ("/")) + ,("AFP_W.takeDirectory (\"/\") == (\"/\")", property $ AFP_W.takeDirectory ("/") == ("/")) + ,("P.takeDirectory \"/foo\" == \"/\"", property $ P.takeDirectory "/foo" == "/") + ,("W.takeDirectory \"/foo\" == \"/\"", property $ W.takeDirectory "/foo" == "/") + ,("AFP_P.takeDirectory (\"/foo\") == (\"/\")", property $ AFP_P.takeDirectory ("/foo") == ("/")) + ,("AFP_W.takeDirectory (\"/foo\") == (\"/\")", property $ AFP_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") + ,("AFP_P.takeDirectory (\"/foo/bar/baz\") == (\"/foo/bar\")", property $ AFP_P.takeDirectory ("/foo/bar/baz") == ("/foo/bar")) + ,("AFP_W.takeDirectory (\"/foo/bar/baz\") == (\"/foo/bar\")", property $ AFP_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") + ,("AFP_P.takeDirectory (\"/foo/bar/baz/\") == (\"/foo/bar/baz\")", property $ AFP_P.takeDirectory ("/foo/bar/baz/") == ("/foo/bar/baz")) + ,("AFP_W.takeDirectory (\"/foo/bar/baz/\") == (\"/foo/bar/baz\")", property $ AFP_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") + ,("AFP_P.takeDirectory (\"foo/bar/baz\") == (\"foo/bar\")", property $ AFP_P.takeDirectory ("foo/bar/baz") == ("foo/bar")) + ,("AFP_W.takeDirectory (\"foo/bar/baz\") == (\"foo/bar\")", property $ AFP_W.takeDirectory ("foo/bar/baz") == ("foo/bar")) + ,("W.takeDirectory \"foo\\\\bar\" == \"foo\"", property $ W.takeDirectory "foo\\bar" == "foo") + ,("AFP_W.takeDirectory (\"foo\\\\bar\") == (\"foo\")", property $ AFP_W.takeDirectory ("foo\\bar") == ("foo")) + ,("W.takeDirectory \"foo\\\\bar\\\\\\\\\" == \"foo\\\\bar\"", property $ W.takeDirectory "foo\\bar\\\\" == "foo\\bar") + ,("AFP_W.takeDirectory (\"foo\\\\bar\\\\\\\\\") == (\"foo\\\\bar\")", property $ AFP_W.takeDirectory ("foo\\bar\\\\") == ("foo\\bar")) + ,("W.takeDirectory \"C:\\\\\" == \"C:\\\\\"", property $ W.takeDirectory "C:\\" == "C:\\") + ,("AFP_W.takeDirectory (\"C:\\\\\") == (\"C:\\\\\")", property $ AFP_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") + ,("AFP_P.replaceDirectory (\"root/file.ext\") (\"/directory/\") == (\"/directory/file.ext\")", property $ AFP_P.replaceDirectory ("root/file.ext") ("/directory/") == ("/directory/file.ext")) + ,("AFP_W.replaceDirectory (\"root/file.ext\") (\"/directory/\") == (\"/directory/file.ext\")", property $ AFP_W.replaceDirectory ("root/file.ext") ("/directory/") == ("/directory/file.ext")) + ,("P.replaceDirectory x (P.takeDirectory x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> P.replaceDirectory x (P.takeDirectory x) `P.equalFilePath` x) + ,("W.replaceDirectory x (W.takeDirectory x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> W.replaceDirectory x (W.takeDirectory x) `W.equalFilePath` x) + ,("AFP_P.replaceDirectory x (AFP_P.takeDirectory x) `AFP_P.equalFilePath` x", property $ \(QFilePathValidAFP_P x) -> AFP_P.replaceDirectory x (AFP_P.takeDirectory x) `AFP_P.equalFilePath` x) + ,("AFP_W.replaceDirectory x (AFP_W.takeDirectory x) `AFP_W.equalFilePath` x", property $ \(QFilePathValidAFP_W x) -> AFP_W.replaceDirectory x (AFP_W.takeDirectory x) `AFP_W.equalFilePath` x) + ,("\"/directory\" P. \"file.ext\" == \"/directory/file.ext\"", property $ "/directory" P. "file.ext" == "/directory/file.ext") + ,("(\"/directory\") AFP_P. (\"file.ext\") == (\"/directory/file.ext\")", property $ ("/directory") AFP_P. ("file.ext") == ("/directory/file.ext")) + ,("\"/directory\" W. \"file.ext\" == \"/directory\\\\file.ext\"", property $ "/directory" W. "file.ext" == "/directory\\file.ext") + ,("(\"/directory\") AFP_W. (\"file.ext\") == (\"/directory\\\\file.ext\")", property $ ("/directory") AFP_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") + ,("(\"directory\") AFP_P. (\"/file.ext\") == (\"/file.ext\")", property $ ("directory") AFP_P. ("/file.ext") == ("/file.ext")) + ,("(\"directory\") AFP_W. (\"/file.ext\") == (\"/file.ext\")", property $ ("directory") AFP_W. ("/file.ext") == ("/file.ext")) + ,("(P.takeDirectory x P. P.takeFileName x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> (P.takeDirectory x P. P.takeFileName x) `P.equalFilePath` x) + ,("(W.takeDirectory x W. W.takeFileName x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> (W.takeDirectory x W. W.takeFileName x) `W.equalFilePath` x) + ,("(AFP_P.takeDirectory x AFP_P. AFP_P.takeFileName x) `AFP_P.equalFilePath` x", property $ \(QFilePathValidAFP_P x) -> (AFP_P.takeDirectory x AFP_P. AFP_P.takeFileName x) `AFP_P.equalFilePath` x) + ,("(AFP_W.takeDirectory x AFP_W. AFP_W.takeFileName x) `AFP_W.equalFilePath` x", property $ \(QFilePathValidAFP_W x) -> (AFP_W.takeDirectory x AFP_W. AFP_W.takeFileName x) `AFP_W.equalFilePath` x) + ,("\"/\" P. \"test\" == \"/test\"", property $ "/" P. "test" == "/test") + ,("(\"/\") AFP_P. (\"test\") == (\"/test\")", property $ ("/") AFP_P. ("test") == ("/test")) + ,("\"home\" P. \"bob\" == \"home/bob\"", property $ "home" P. "bob" == "home/bob") + ,("(\"home\") AFP_P. (\"bob\") == (\"home/bob\")", property $ ("home") AFP_P. ("bob") == ("home/bob")) + ,("\"x:\" P. \"foo\" == \"x:/foo\"", property $ "x:" P. "foo" == "x:/foo") + ,("(\"x:\") AFP_P. (\"foo\") == (\"x:/foo\")", property $ ("x:") AFP_P. ("foo") == ("x:/foo")) + ,("\"C:\\\\foo\" W. \"bar\" == \"C:\\\\foo\\\\bar\"", property $ "C:\\foo" W. "bar" == "C:\\foo\\bar") + ,("(\"C:\\\\foo\") AFP_W. (\"bar\") == (\"C:\\\\foo\\\\bar\")", property $ ("C:\\foo") AFP_W. ("bar") == ("C:\\foo\\bar")) + ,("\"home\" W. \"bob\" == \"home\\\\bob\"", property $ "home" W. "bob" == "home\\bob") + ,("(\"home\") AFP_W. (\"bob\") == (\"home\\\\bob\")", property $ ("home") AFP_W. ("bob") == ("home\\bob")) + ,("\"home\" P. \"/bob\" == \"/bob\"", property $ "home" P. "/bob" == "/bob") + ,("(\"home\") AFP_P. (\"/bob\") == (\"/bob\")", property $ ("home") AFP_P. ("/bob") == ("/bob")) + ,("\"home\" W. \"C:\\\\bob\" == \"C:\\\\bob\"", property $ "home" W. "C:\\bob" == "C:\\bob") + ,("(\"home\") AFP_W. (\"C:\\\\bob\") == (\"C:\\\\bob\")", property $ ("home") AFP_W. ("C:\\bob") == ("C:\\bob")) + ,("\"home\" W. \"/bob\" == \"/bob\"", property $ "home" W. "/bob" == "/bob") + ,("(\"home\") AFP_W. (\"/bob\") == (\"/bob\")", property $ ("home") AFP_W. ("/bob") == ("/bob")) + ,("\"home\" W. \"\\\\bob\" == \"\\\\bob\"", property $ "home" W. "\\bob" == "\\bob") + ,("(\"home\") AFP_W. (\"\\\\bob\") == (\"\\\\bob\")", property $ ("home") AFP_W. ("\\bob") == ("\\bob")) + ,("\"C:\\\\home\" W. \"\\\\bob\" == \"\\\\bob\"", property $ "C:\\home" W. "\\bob" == "\\bob") + ,("(\"C:\\\\home\") AFP_W. (\"\\\\bob\") == (\"\\\\bob\")", property $ ("C:\\home") AFP_W. ("\\bob") == ("\\bob")) + ,("\"D:\\\\foo\" W. \"C:bar\" == \"C:bar\"", property $ "D:\\foo" W. "C:bar" == "C:bar") + ,("(\"D:\\\\foo\") AFP_W. (\"C:bar\") == (\"C:bar\")", property $ ("D:\\foo") AFP_W. ("C:bar") == ("C:bar")) + ,("\"C:\\\\foo\" W. \"C:bar\" == \"C:bar\"", property $ "C:\\foo" W. "C:bar" == "C:bar") + ,("(\"C:\\\\foo\") AFP_W. (\"C:bar\") == (\"C:bar\")", property $ ("C:\\foo") AFP_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"]) + ,("AFP_P.splitPath (\"/directory/file.ext\") == [(\"/\"), (\"directory/\"), (\"file.ext\")]", property $ AFP_P.splitPath ("/directory/file.ext") == [("/"), ("directory/"), ("file.ext")]) + ,("AFP_W.splitPath (\"/directory/file.ext\") == [(\"/\"), (\"directory/\"), (\"file.ext\")]", property $ AFP_W.splitPath ("/directory/file.ext") == [("/"), ("directory/"), ("file.ext")]) + ,("concat (P.splitPath x) == x", property $ \(QFilePath x) -> concat (P.splitPath x) == x) + ,("concat (W.splitPath x) == x", property $ \(QFilePath x) -> concat (W.splitPath x) == x) + ,("(PS . SBS.concat . fmap getPosixString) (AFP_P.splitPath x) == x", property $ \(QFilePathAFP_P x) -> (PS . SBS.concat . fmap getPosixString) (AFP_P.splitPath x) == x) + ,("(WS . SBS16.concat . fmap getWindowsString) (AFP_W.splitPath x) == x", property $ \(QFilePathAFP_W x) -> (WS . SBS16.concat . fmap getWindowsString) (AFP_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/"]) + ,("AFP_P.splitPath (\"test//item/\") == [(\"test//\"), (\"item/\")]", property $ AFP_P.splitPath ("test//item/") == [("test//"), ("item/")]) + ,("AFP_W.splitPath (\"test//item/\") == [(\"test//\"), (\"item/\")]", property $ AFP_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"]) + ,("AFP_P.splitPath (\"test/item/file\") == [(\"test/\"), (\"item/\"), (\"file\")]", property $ AFP_P.splitPath ("test/item/file") == [("test/"), ("item/"), ("file")]) + ,("AFP_W.splitPath (\"test/item/file\") == [(\"test/\"), (\"item/\"), (\"file\")]", property $ AFP_W.splitPath ("test/item/file") == [("test/"), ("item/"), ("file")]) + ,("P.splitPath \"\" == []", property $ P.splitPath "" == []) + ,("W.splitPath \"\" == []", property $ W.splitPath "" == []) + ,("AFP_P.splitPath (\"\") == []", property $ AFP_P.splitPath ("") == []) + ,("AFP_W.splitPath (\"\") == []", property $ AFP_W.splitPath ("") == []) + ,("W.splitPath \"c:\\\\test\\\\path\" == [\"c:\\\\\", \"test\\\\\", \"path\"]", property $ W.splitPath "c:\\test\\path" == ["c:\\", "test\\", "path"]) + ,("AFP_W.splitPath (\"c:\\\\test\\\\path\") == [(\"c:\\\\\"), (\"test\\\\\"), (\"path\")]", property $ AFP_W.splitPath ("c:\\test\\path") == [("c:\\"), ("test\\"), ("path")]) + ,("P.splitPath \"/file/test\" == [\"/\", \"file/\", \"test\"]", property $ P.splitPath "/file/test" == ["/", "file/", "test"]) + ,("AFP_P.splitPath (\"/file/test\") == [(\"/\"), (\"file/\"), (\"test\")]", property $ AFP_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"]) + ,("AFP_P.splitDirectories (\"/directory/file.ext\") == [(\"/\"), (\"directory\"), (\"file.ext\")]", property $ AFP_P.splitDirectories ("/directory/file.ext") == [("/"), ("directory"), ("file.ext")]) + ,("AFP_W.splitDirectories (\"/directory/file.ext\") == [(\"/\"), (\"directory\"), (\"file.ext\")]", property $ AFP_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"]) + ,("AFP_P.splitDirectories (\"test/file\") == [(\"test\"), (\"file\")]", property $ AFP_P.splitDirectories ("test/file") == [("test"), ("file")]) + ,("AFP_W.splitDirectories (\"test/file\") == [(\"test\"), (\"file\")]", property $ AFP_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"]) + ,("AFP_P.splitDirectories (\"/test/file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_P.splitDirectories ("/test/file") == [("/"), ("test"), ("file")]) + ,("AFP_W.splitDirectories (\"/test/file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("/test/file") == [("/"), ("test"), ("file")]) + ,("W.splitDirectories \"C:\\\\test\\\\file\" == [\"C:\\\\\", \"test\", \"file\"]", property $ W.splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]) + ,("AFP_W.splitDirectories (\"C:\\\\test\\\\file\") == [(\"C:\\\\\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("C:\\test\\file") == [("C:\\"), ("test"), ("file")]) + ,("P.joinPath (P.splitDirectories x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> P.joinPath (P.splitDirectories x) `P.equalFilePath` x) + ,("W.joinPath (W.splitDirectories x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> W.joinPath (W.splitDirectories x) `W.equalFilePath` x) + ,("AFP_P.joinPath (AFP_P.splitDirectories x) `AFP_P.equalFilePath` x", property $ \(QFilePathValidAFP_P x) -> AFP_P.joinPath (AFP_P.splitDirectories x) `AFP_P.equalFilePath` x) + ,("AFP_W.joinPath (AFP_W.splitDirectories x) `AFP_W.equalFilePath` x", property $ \(QFilePathValidAFP_W x) -> AFP_W.joinPath (AFP_W.splitDirectories x) `AFP_W.equalFilePath` x) + ,("P.splitDirectories \"\" == []", property $ P.splitDirectories "" == []) + ,("W.splitDirectories \"\" == []", property $ W.splitDirectories "" == []) + ,("AFP_P.splitDirectories (\"\") == []", property $ AFP_P.splitDirectories ("") == []) + ,("AFP_W.splitDirectories (\"\") == []", property $ AFP_W.splitDirectories ("") == []) + ,("W.splitDirectories \"C:\\\\test\\\\\\\\\\\\file\" == [\"C:\\\\\", \"test\", \"file\"]", property $ W.splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]) + ,("AFP_W.splitDirectories (\"C:\\\\test\\\\\\\\\\\\file\") == [(\"C:\\\\\"), (\"test\"), (\"file\")]", property $ AFP_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"]) + ,("AFP_P.splitDirectories (\"/test///file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_P.splitDirectories ("/test///file") == [("/"), ("test"), ("file")]) + ,("AFP_W.splitDirectories (\"/test///file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("/test///file") == [("/"), ("test"), ("file")]) + ,("P.joinPath z == foldr (P.) \"\" z", property $ \z -> P.joinPath z == foldr (P.) "" z) + ,("W.joinPath z == foldr (W.) \"\" z", property $ \z -> W.joinPath z == foldr (W.) "" z) + ,("AFP_P.joinPath z == foldr (AFP_P.) (\"\") z", property $ \(QFilePathsAFP_P z) -> AFP_P.joinPath z == foldr (AFP_P.) ("") z) + ,("AFP_W.joinPath z == foldr (AFP_W.) (\"\") z", property $ \(QFilePathsAFP_W z) -> AFP_W.joinPath z == foldr (AFP_W.) ("") z) + ,("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") + ,("AFP_P.joinPath [(\"/\"), (\"directory/\"), (\"file.ext\")] == (\"/directory/file.ext\")", property $ AFP_P.joinPath [("/"), ("directory/"), ("file.ext")] == ("/directory/file.ext")) + ,("AFP_W.joinPath [(\"/\"), (\"directory/\"), (\"file.ext\")] == (\"/directory/file.ext\")", property $ AFP_W.joinPath [("/"), ("directory/"), ("file.ext")] == ("/directory/file.ext")) + ,("P.joinPath (P.splitPath x) == x", property $ \(QFilePathValidP x) -> P.joinPath (P.splitPath x) == x) + ,("W.joinPath (W.splitPath x) == x", property $ \(QFilePathValidW x) -> W.joinPath (W.splitPath x) == x) + ,("AFP_P.joinPath (AFP_P.splitPath x) == x", property $ \(QFilePathValidAFP_P x) -> AFP_P.joinPath (AFP_P.splitPath x) == x) + ,("AFP_W.joinPath (AFP_W.splitPath x) == x", property $ \(QFilePathValidAFP_W x) -> AFP_W.joinPath (AFP_W.splitPath x) == x) + ,("P.joinPath [] == \"\"", property $ P.joinPath [] == "") + ,("W.joinPath [] == \"\"", property $ W.joinPath [] == "") + ,("AFP_P.joinPath [] == (\"\")", property $ AFP_P.joinPath [] == ("")) + ,("AFP_W.joinPath [] == (\"\")", property $ AFP_W.joinPath [] == ("")) + ,("P.joinPath [\"test\", \"file\", \"path\"] == \"test/file/path\"", property $ P.joinPath ["test", "file", "path"] == "test/file/path") + ,("AFP_P.joinPath [(\"test\"), (\"file\"), (\"path\")] == (\"test/file/path\")", property $ AFP_P.joinPath [("test"), ("file"), ("path")] == ("test/file/path")) + ,("x == y ==> P.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> x == y ==> P.equalFilePath x y) + ,("x == y ==> W.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> x == y ==> W.equalFilePath x y) + ,("x == y ==> AFP_P.equalFilePath x y", property $ \(QFilePathAFP_P x) (QFilePathAFP_P y) -> x == y ==> AFP_P.equalFilePath x y) + ,("x == y ==> AFP_W.equalFilePath x y", property $ \(QFilePathAFP_W x) (QFilePathAFP_W y) -> x == y ==> AFP_W.equalFilePath x y) + ,("P.normalise x == P.normalise y ==> P.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> P.normalise x == P.normalise y ==> P.equalFilePath x y) + ,("W.normalise x == W.normalise y ==> W.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> W.normalise x == W.normalise y ==> W.equalFilePath x y) + ,("AFP_P.normalise x == AFP_P.normalise y ==> AFP_P.equalFilePath x y", property $ \(QFilePathAFP_P x) (QFilePathAFP_P y) -> AFP_P.normalise x == AFP_P.normalise y ==> AFP_P.equalFilePath x y) + ,("AFP_W.normalise x == AFP_W.normalise y ==> AFP_W.equalFilePath x y", property $ \(QFilePathAFP_W x) (QFilePathAFP_W y) -> AFP_W.normalise x == AFP_W.normalise y ==> AFP_W.equalFilePath x y) + ,("P.equalFilePath \"foo\" \"foo/\"", property $ P.equalFilePath "foo" "foo/") + ,("W.equalFilePath \"foo\" \"foo/\"", property $ W.equalFilePath "foo" "foo/") + ,("AFP_P.equalFilePath (\"foo\") (\"foo/\")", property $ AFP_P.equalFilePath ("foo") ("foo/")) + ,("AFP_W.equalFilePath (\"foo\") (\"foo/\")", property $ AFP_W.equalFilePath ("foo") ("foo/")) + ,("not (P.equalFilePath \"/a/../c\" \"/c\")", property $ not (P.equalFilePath "/a/../c" "/c")) + ,("not (W.equalFilePath \"/a/../c\" \"/c\")", property $ not (W.equalFilePath "/a/../c" "/c")) + ,("not (AFP_P.equalFilePath (\"/a/../c\") (\"/c\"))", property $ not (AFP_P.equalFilePath ("/a/../c") ("/c"))) + ,("not (AFP_W.equalFilePath (\"/a/../c\") (\"/c\"))", property $ not (AFP_W.equalFilePath ("/a/../c") ("/c"))) + ,("not (P.equalFilePath \"foo\" \"/foo\")", property $ not (P.equalFilePath "foo" "/foo")) + ,("not (W.equalFilePath \"foo\" \"/foo\")", property $ not (W.equalFilePath "foo" "/foo")) + ,("not (AFP_P.equalFilePath (\"foo\") (\"/foo\"))", property $ not (AFP_P.equalFilePath ("foo") ("/foo"))) + ,("not (AFP_W.equalFilePath (\"foo\") (\"/foo\"))", property $ not (AFP_W.equalFilePath ("foo") ("/foo"))) + ,("not (P.equalFilePath \"foo\" \"FOO\")", property $ not (P.equalFilePath "foo" "FOO")) + ,("not (AFP_P.equalFilePath (\"foo\") (\"FOO\"))", property $ not (AFP_P.equalFilePath ("foo") ("FOO"))) + ,("W.equalFilePath \"foo\" \"FOO\"", property $ W.equalFilePath "foo" "FOO") + ,("AFP_W.equalFilePath (\"foo\") (\"FOO\")", property $ AFP_W.equalFilePath ("foo") ("FOO")) + ,("not (W.equalFilePath \"C:\" \"C:/\")", property $ not (W.equalFilePath "C:" "C:/")) + ,("not (AFP_W.equalFilePath (\"C:\") (\"C:/\"))", property $ not (AFP_W.equalFilePath ("C:") ("C:/"))) + ,("P.makeRelative \"/directory\" \"/directory/file.ext\" == \"file.ext\"", property $ P.makeRelative "/directory" "/directory/file.ext" == "file.ext") + ,("W.makeRelative \"/directory\" \"/directory/file.ext\" == \"file.ext\"", property $ W.makeRelative "/directory" "/directory/file.ext" == "file.ext") + ,("AFP_P.makeRelative (\"/directory\") (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.makeRelative ("/directory") ("/directory/file.ext") == ("file.ext")) + ,("AFP_W.makeRelative (\"/directory\") (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_W.makeRelative ("/directory") ("/directory/file.ext") == ("file.ext")) + ,("P.makeRelative (P.takeDirectory x) x `P.equalFilePath` P.takeFileName x", property $ \(QFilePathValidP x) -> P.makeRelative (P.takeDirectory x) x `P.equalFilePath` P.takeFileName x) + ,("W.makeRelative (W.takeDirectory x) x `W.equalFilePath` W.takeFileName x", property $ \(QFilePathValidW x) -> W.makeRelative (W.takeDirectory x) x `W.equalFilePath` W.takeFileName x) + ,("AFP_P.makeRelative (AFP_P.takeDirectory x) x `AFP_P.equalFilePath` AFP_P.takeFileName x", property $ \(QFilePathValidAFP_P x) -> AFP_P.makeRelative (AFP_P.takeDirectory x) x `AFP_P.equalFilePath` AFP_P.takeFileName x) + ,("AFP_W.makeRelative (AFP_W.takeDirectory x) x `AFP_W.equalFilePath` AFP_W.takeFileName x", property $ \(QFilePathValidAFP_W x) -> AFP_W.makeRelative (AFP_W.takeDirectory x) x `AFP_W.equalFilePath` AFP_W.takeFileName x) + ,("P.makeRelative x x == \".\"", property $ \(QFilePath x) -> P.makeRelative x x == ".") + ,("W.makeRelative x x == \".\"", property $ \(QFilePath x) -> W.makeRelative x x == ".") + ,("AFP_P.makeRelative x x == (\".\")", property $ \(QFilePathAFP_P x) -> AFP_P.makeRelative x x == (".")) + ,("AFP_W.makeRelative x x == (\".\")", property $ \(QFilePathAFP_W x) -> AFP_W.makeRelative x x == (".")) + ,("P.equalFilePath x y || (P.isRelative x && P.makeRelative y x == x) || P.equalFilePath (y P. P.makeRelative y x) x", property $ \(QFilePathValidP x) (QFilePathValidP y) -> P.equalFilePath x y || (P.isRelative x && P.makeRelative y x == x) || P.equalFilePath (y P. P.makeRelative y x) x) + ,("W.equalFilePath x y || (W.isRelative x && W.makeRelative y x == x) || W.equalFilePath (y W. W.makeRelative y x) x", property $ \(QFilePathValidW x) (QFilePathValidW y) -> W.equalFilePath x y || (W.isRelative x && W.makeRelative y x == x) || W.equalFilePath (y W. W.makeRelative y x) x) + ,("AFP_P.equalFilePath x y || (AFP_P.isRelative x && AFP_P.makeRelative y x == x) || AFP_P.equalFilePath (y AFP_P. AFP_P.makeRelative y x) x", property $ \(QFilePathValidAFP_P x) (QFilePathValidAFP_P y) -> AFP_P.equalFilePath x y || (AFP_P.isRelative x && AFP_P.makeRelative y x == x) || AFP_P.equalFilePath (y AFP_P. AFP_P.makeRelative y x) x) + ,("AFP_W.equalFilePath x y || (AFP_W.isRelative x && AFP_W.makeRelative y x == x) || AFP_W.equalFilePath (y AFP_W. AFP_W.makeRelative y x) x", property $ \(QFilePathValidAFP_W x) (QFilePathValidAFP_W y) -> AFP_W.equalFilePath x y || (AFP_W.isRelative x && AFP_W.makeRelative y x == x) || AFP_W.equalFilePath (y AFP_W. AFP_W.makeRelative y x) x) + ,("W.makeRelative \"C:\\\\Home\" \"c:\\\\home\\\\bob\" == \"bob\"", property $ W.makeRelative "C:\\Home" "c:\\home\\bob" == "bob") + ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"c:\\\\home\\\\bob\") == (\"bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("c:\\home\\bob") == ("bob")) + ,("W.makeRelative \"C:\\\\Home\" \"c:/home/bob\" == \"bob\"", property $ W.makeRelative "C:\\Home" "c:/home/bob" == "bob") + ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"c:/home/bob\") == (\"bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("c:/home/bob") == ("bob")) + ,("W.makeRelative \"C:\\\\Home\" \"D:\\\\Home\\\\Bob\" == \"D:\\\\Home\\\\Bob\"", property $ W.makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob") + ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"D:\\\\Home\\\\Bob\") == (\"D:\\\\Home\\\\Bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("D:\\Home\\Bob") == ("D:\\Home\\Bob")) + ,("W.makeRelative \"C:\\\\Home\" \"C:Home\\\\Bob\" == \"C:Home\\\\Bob\"", property $ W.makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob") + ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"C:Home\\\\Bob\") == (\"C:Home\\\\Bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("C:Home\\Bob") == ("C:Home\\Bob")) + ,("W.makeRelative \"/Home\" \"/home/bob\" == \"bob\"", property $ W.makeRelative "/Home" "/home/bob" == "bob") + ,("AFP_W.makeRelative (\"/Home\") (\"/home/bob\") == (\"bob\")", property $ AFP_W.makeRelative ("/Home") ("/home/bob") == ("bob")) + ,("W.makeRelative \"/\" \"//\" == \"//\"", property $ W.makeRelative "/" "//" == "//") + ,("AFP_W.makeRelative (\"/\") (\"//\") == (\"//\")", property $ AFP_W.makeRelative ("/") ("//") == ("//")) + ,("P.makeRelative \"/Home\" \"/home/bob\" == \"/home/bob\"", property $ P.makeRelative "/Home" "/home/bob" == "/home/bob") + ,("AFP_P.makeRelative (\"/Home\") (\"/home/bob\") == (\"/home/bob\")", property $ AFP_P.makeRelative ("/Home") ("/home/bob") == ("/home/bob")) + ,("P.makeRelative \"/home/\" \"/home/bob/foo/bar\" == \"bob/foo/bar\"", property $ P.makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar") + ,("AFP_P.makeRelative (\"/home/\") (\"/home/bob/foo/bar\") == (\"bob/foo/bar\")", property $ AFP_P.makeRelative ("/home/") ("/home/bob/foo/bar") == ("bob/foo/bar")) + ,("P.makeRelative \"/fred\" \"bob\" == \"bob\"", property $ P.makeRelative "/fred" "bob" == "bob") + ,("AFP_P.makeRelative (\"/fred\") (\"bob\") == (\"bob\")", property $ AFP_P.makeRelative ("/fred") ("bob") == ("bob")) + ,("P.makeRelative \"/file/test\" \"/file/test/fred\" == \"fred\"", property $ P.makeRelative "/file/test" "/file/test/fred" == "fred") + ,("AFP_P.makeRelative (\"/file/test\") (\"/file/test/fred\") == (\"fred\")", property $ AFP_P.makeRelative ("/file/test") ("/file/test/fred") == ("fred")) + ,("P.makeRelative \"/file/test\" \"/file/test/fred/\" == \"fred/\"", property $ P.makeRelative "/file/test" "/file/test/fred/" == "fred/") + ,("AFP_P.makeRelative (\"/file/test\") (\"/file/test/fred/\") == (\"fred/\")", property $ AFP_P.makeRelative ("/file/test") ("/file/test/fred/") == ("fred/")) + ,("P.makeRelative \"some/path\" \"some/path/a/b/c\" == \"a/b/c\"", property $ P.makeRelative "some/path" "some/path/a/b/c" == "a/b/c") + ,("AFP_P.makeRelative (\"some/path\") (\"some/path/a/b/c\") == (\"a/b/c\")", property $ AFP_P.makeRelative ("some/path") ("some/path/a/b/c") == ("a/b/c")) + ,("P.normalise \"/file/\\\\test////\" == \"/file/\\\\test/\"", property $ P.normalise "/file/\\test////" == "/file/\\test/") + ,("AFP_P.normalise (\"/file/\\\\test////\") == (\"/file/\\\\test/\")", property $ AFP_P.normalise ("/file/\\test////") == ("/file/\\test/")) + ,("P.normalise \"/file/./test\" == \"/file/test\"", property $ P.normalise "/file/./test" == "/file/test") + ,("AFP_P.normalise (\"/file/./test\") == (\"/file/test\")", property $ AFP_P.normalise ("/file/./test") == ("/file/test")) + ,("P.normalise \"/test/file/../bob/fred/\" == \"/test/file/../bob/fred/\"", property $ P.normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/") + ,("AFP_P.normalise (\"/test/file/../bob/fred/\") == (\"/test/file/../bob/fred/\")", property $ AFP_P.normalise ("/test/file/../bob/fred/") == ("/test/file/../bob/fred/")) + ,("P.normalise \"../bob/fred/\" == \"../bob/fred/\"", property $ P.normalise "../bob/fred/" == "../bob/fred/") + ,("AFP_P.normalise (\"../bob/fred/\") == (\"../bob/fred/\")", property $ AFP_P.normalise ("../bob/fred/") == ("../bob/fred/")) + ,("P.normalise \"/a/../c\" == \"/a/../c\"", property $ P.normalise "/a/../c" == "/a/../c") + ,("AFP_P.normalise (\"/a/../c\") == (\"/a/../c\")", property $ AFP_P.normalise ("/a/../c") == ("/a/../c")) + ,("P.normalise \"./bob/fred/\" == \"bob/fred/\"", property $ P.normalise "./bob/fred/" == "bob/fred/") + ,("AFP_P.normalise (\"./bob/fred/\") == (\"bob/fred/\")", property $ AFP_P.normalise ("./bob/fred/") == ("bob/fred/")) + ,("W.normalise \"c:\\\\file/bob\\\\\" == \"C:\\\\file\\\\bob\\\\\"", property $ W.normalise "c:\\file/bob\\" == "C:\\file\\bob\\") + ,("AFP_W.normalise (\"c:\\\\file/bob\\\\\") == (\"C:\\\\file\\\\bob\\\\\")", property $ AFP_W.normalise ("c:\\file/bob\\") == ("C:\\file\\bob\\")) + ,("W.normalise \"c:\\\\\" == \"C:\\\\\"", property $ W.normalise "c:\\" == "C:\\") + ,("AFP_W.normalise (\"c:\\\\\") == (\"C:\\\\\")", property $ AFP_W.normalise ("c:\\") == ("C:\\")) + ,("W.normalise \"c:\\\\\\\\\\\\\\\\\" == \"C:\\\\\"", property $ W.normalise "c:\\\\\\\\" == "C:\\") + ,("AFP_W.normalise (\"c:\\\\\\\\\\\\\\\\\") == (\"C:\\\\\")", property $ AFP_W.normalise ("c:\\\\\\\\") == ("C:\\")) + ,("W.normalise \"C:.\\\\\" == \"C:\"", property $ W.normalise "C:.\\" == "C:") + ,("AFP_W.normalise (\"C:.\\\\\") == (\"C:\")", property $ AFP_W.normalise ("C:.\\") == ("C:")) + ,("W.normalise \"\\\\\\\\server\\\\test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "\\\\server\\test" == "\\\\server\\test") + ,("AFP_W.normalise (\"\\\\\\\\server\\\\test\") == (\"\\\\\\\\server\\\\test\")", property $ AFP_W.normalise ("\\\\server\\test") == ("\\\\server\\test")) + ,("W.normalise \"//server/test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "//server/test" == "\\\\server\\test") + ,("AFP_W.normalise (\"//server/test\") == (\"\\\\\\\\server\\\\test\")", property $ AFP_W.normalise ("//server/test") == ("\\\\server\\test")) + ,("W.normalise \"c:/file\" == \"C:\\\\file\"", property $ W.normalise "c:/file" == "C:\\file") + ,("AFP_W.normalise (\"c:/file\") == (\"C:\\\\file\")", property $ AFP_W.normalise ("c:/file") == ("C:\\file")) + ,("W.normalise \"/file\" == \"\\\\file\"", property $ W.normalise "/file" == "\\file") + ,("AFP_W.normalise (\"/file\") == (\"\\\\file\")", property $ AFP_W.normalise ("/file") == ("\\file")) + ,("W.normalise \"\\\\\" == \"\\\\\"", property $ W.normalise "\\" == "\\") + ,("AFP_W.normalise (\"\\\\\") == (\"\\\\\")", property $ AFP_W.normalise ("\\") == ("\\")) + ,("W.normalise \"/./\" == \"\\\\\"", property $ W.normalise "/./" == "\\") + ,("AFP_W.normalise (\"/./\") == (\"\\\\\")", property $ AFP_W.normalise ("/./") == ("\\")) + ,("P.normalise \".\" == \".\"", property $ P.normalise "." == ".") + ,("W.normalise \".\" == \".\"", property $ W.normalise "." == ".") + ,("AFP_P.normalise (\".\") == (\".\")", property $ AFP_P.normalise (".") == (".")) + ,("AFP_W.normalise (\".\") == (\".\")", property $ AFP_W.normalise (".") == (".")) + ,("P.normalise \"./\" == \"./\"", property $ P.normalise "./" == "./") + ,("AFP_P.normalise (\"./\") == (\"./\")", property $ AFP_P.normalise ("./") == ("./")) + ,("P.normalise \"./.\" == \"./\"", property $ P.normalise "./." == "./") + ,("AFP_P.normalise (\"./.\") == (\"./\")", property $ AFP_P.normalise ("./.") == ("./")) + ,("P.normalise \"/./\" == \"/\"", property $ P.normalise "/./" == "/") + ,("AFP_P.normalise (\"/./\") == (\"/\")", property $ AFP_P.normalise ("/./") == ("/")) + ,("P.normalise \"/\" == \"/\"", property $ P.normalise "/" == "/") + ,("AFP_P.normalise (\"/\") == (\"/\")", property $ AFP_P.normalise ("/") == ("/")) + ,("P.normalise \"bob/fred/.\" == \"bob/fred/\"", property $ P.normalise "bob/fred/." == "bob/fred/") + ,("AFP_P.normalise (\"bob/fred/.\") == (\"bob/fred/\")", property $ AFP_P.normalise ("bob/fred/.") == ("bob/fred/")) + ,("P.normalise \"//home\" == \"/home\"", property $ P.normalise "//home" == "/home") + ,("AFP_P.normalise (\"//home\") == (\"/home\")", property $ AFP_P.normalise ("//home") == ("/home")) + ,("P.isValid \"\" == False", property $ P.isValid "" == False) + ,("W.isValid \"\" == False", property $ W.isValid "" == False) + ,("AFP_P.isValid (\"\") == False", property $ AFP_P.isValid ("") == False) + ,("AFP_W.isValid (\"\") == False", property $ AFP_W.isValid ("") == False) + ,("P.isValid \"\\0\" == False", property $ P.isValid "\0" == False) + ,("W.isValid \"\\0\" == False", property $ W.isValid "\0" == False) + ,("AFP_P.isValid (\"\\0\") == False", property $ AFP_P.isValid ("\0") == False) + ,("AFP_W.isValid (\"\\0\") == False", property $ AFP_W.isValid ("\0") == False) + ,("P.isValid \"/random_ path:*\" == True", property $ P.isValid "/random_ path:*" == True) + ,("AFP_P.isValid (\"/random_ path:*\") == True", property $ AFP_P.isValid ("/random_ path:*") == True) + ,("P.isValid x == not (null x)", property $ \(QFilePath x) -> P.isValid x == not (null x)) + ,("AFP_P.isValid x == not ((SBS.null . getPosixString) x)", property $ \(QFilePathAFP_P x) -> AFP_P.isValid x == not ((SBS.null . getPosixString) x)) + ,("W.isValid \"c:\\\\test\" == True", property $ W.isValid "c:\\test" == True) + ,("AFP_W.isValid (\"c:\\\\test\") == True", property $ AFP_W.isValid ("c:\\test") == True) + ,("W.isValid \"c:\\\\test:of_test\" == False", property $ W.isValid "c:\\test:of_test" == False) + ,("AFP_W.isValid (\"c:\\\\test:of_test\") == False", property $ AFP_W.isValid ("c:\\test:of_test") == False) + ,("W.isValid \"test*\" == False", property $ W.isValid "test*" == False) + ,("AFP_W.isValid (\"test*\") == False", property $ AFP_W.isValid ("test*") == False) + ,("W.isValid \"c:\\\\test\\\\nul\" == False", property $ W.isValid "c:\\test\\nul" == False) + ,("AFP_W.isValid (\"c:\\\\test\\\\nul\") == False", property $ AFP_W.isValid ("c:\\test\\nul") == False) + ,("W.isValid \"c:\\\\test\\\\prn.txt\" == False", property $ W.isValid "c:\\test\\prn.txt" == False) + ,("AFP_W.isValid (\"c:\\\\test\\\\prn.txt\") == False", property $ AFP_W.isValid ("c:\\test\\prn.txt") == False) + ,("W.isValid \"c:\\\\nul\\\\file\" == False", property $ W.isValid "c:\\nul\\file" == False) + ,("AFP_W.isValid (\"c:\\\\nul\\\\file\") == False", property $ AFP_W.isValid ("c:\\nul\\file") == False) + ,("W.isValid \"\\\\\\\\\" == False", property $ W.isValid "\\\\" == False) + ,("AFP_W.isValid (\"\\\\\\\\\") == False", property $ AFP_W.isValid ("\\\\") == False) + ,("W.isValid \"\\\\\\\\\\\\foo\" == False", property $ W.isValid "\\\\\\foo" == False) + ,("AFP_W.isValid (\"\\\\\\\\\\\\foo\") == False", property $ AFP_W.isValid ("\\\\\\foo") == False) + ,("W.isValid \"\\\\\\\\?\\\\D:file\" == False", property $ W.isValid "\\\\?\\D:file" == False) + ,("AFP_W.isValid (\"\\\\\\\\?\\\\D:file\") == False", property $ AFP_W.isValid ("\\\\?\\D:file") == False) + ,("W.isValid \"foo\\tbar\" == False", property $ W.isValid "foo\tbar" == False) + ,("AFP_W.isValid (\"foo\\tbar\") == False", property $ AFP_W.isValid ("foo\tbar") == False) + ,("W.isValid \"nul .txt\" == False", property $ W.isValid "nul .txt" == False) + ,("AFP_W.isValid (\"nul .txt\") == False", property $ AFP_W.isValid ("nul .txt") == False) + ,("W.isValid \" nul.txt\" == True", property $ W.isValid " nul.txt" == True) + ,("AFP_W.isValid (\" nul.txt\") == True", property $ AFP_W.isValid (" nul.txt") == True) + ,("P.isValid (P.makeValid x)", property $ \(QFilePath x) -> P.isValid (P.makeValid x)) + ,("W.isValid (W.makeValid x)", property $ \(QFilePath x) -> W.isValid (W.makeValid x)) + ,("AFP_P.isValid (AFP_P.makeValid x)", property $ \(QFilePathAFP_P x) -> AFP_P.isValid (AFP_P.makeValid x)) + ,("AFP_W.isValid (AFP_W.makeValid x)", property $ \(QFilePathAFP_W x) -> AFP_W.isValid (AFP_W.makeValid x)) + ,("P.isValid x ==> P.makeValid x == x", property $ \(QFilePath x) -> P.isValid x ==> P.makeValid x == x) + ,("W.isValid x ==> W.makeValid x == x", property $ \(QFilePath x) -> W.isValid x ==> W.makeValid x == x) + ,("AFP_P.isValid x ==> AFP_P.makeValid x == x", property $ \(QFilePathAFP_P x) -> AFP_P.isValid x ==> AFP_P.makeValid x == x) + ,("AFP_W.isValid x ==> AFP_W.makeValid x == x", property $ \(QFilePathAFP_W x) -> AFP_W.isValid x ==> AFP_W.makeValid x == x) + ,("P.makeValid \"\" == \"_\"", property $ P.makeValid "" == "_") + ,("W.makeValid \"\" == \"_\"", property $ W.makeValid "" == "_") + ,("AFP_P.makeValid (\"\") == (\"_\")", property $ AFP_P.makeValid ("") == ("_")) + ,("AFP_W.makeValid (\"\") == (\"_\")", property $ AFP_W.makeValid ("") == ("_")) + ,("P.makeValid \"file\\0name\" == \"file_name\"", property $ P.makeValid "file\0name" == "file_name") + ,("W.makeValid \"file\\0name\" == \"file_name\"", property $ W.makeValid "file\0name" == "file_name") + ,("AFP_P.makeValid (\"file\\0name\") == (\"file_name\")", property $ AFP_P.makeValid ("file\0name") == ("file_name")) + ,("AFP_W.makeValid (\"file\\0name\") == (\"file_name\")", property $ AFP_W.makeValid ("file\0name") == ("file_name")) + ,("W.makeValid \"c:\\\\already\\\\/valid\" == \"c:\\\\already\\\\/valid\"", property $ W.makeValid "c:\\already\\/valid" == "c:\\already\\/valid") + ,("AFP_W.makeValid (\"c:\\\\already\\\\/valid\") == (\"c:\\\\already\\\\/valid\")", property $ AFP_W.makeValid ("c:\\already\\/valid") == ("c:\\already\\/valid")) + ,("W.makeValid \"c:\\\\test:of_test\" == \"c:\\\\test_of_test\"", property $ W.makeValid "c:\\test:of_test" == "c:\\test_of_test") + ,("AFP_W.makeValid (\"c:\\\\test:of_test\") == (\"c:\\\\test_of_test\")", property $ AFP_W.makeValid ("c:\\test:of_test") == ("c:\\test_of_test")) + ,("W.makeValid \"test*\" == \"test_\"", property $ W.makeValid "test*" == "test_") + ,("AFP_W.makeValid (\"test*\") == (\"test_\")", property $ AFP_W.makeValid ("test*") == ("test_")) + ,("W.makeValid \"c:\\\\test\\\\nul\" == \"c:\\\\test\\\\nul_\"", property $ W.makeValid "c:\\test\\nul" == "c:\\test\\nul_") + ,("AFP_W.makeValid (\"c:\\\\test\\\\nul\") == (\"c:\\\\test\\\\nul_\")", property $ AFP_W.makeValid ("c:\\test\\nul") == ("c:\\test\\nul_")) + ,("W.makeValid \"c:\\\\test\\\\prn.txt\" == \"c:\\\\test\\\\prn_.txt\"", property $ W.makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt") + ,("AFP_W.makeValid (\"c:\\\\test\\\\prn.txt\") == (\"c:\\\\test\\\\prn_.txt\")", property $ AFP_W.makeValid ("c:\\test\\prn.txt") == ("c:\\test\\prn_.txt")) + ,("W.makeValid \"c:\\\\test/prn.txt\" == \"c:\\\\test/prn_.txt\"", property $ W.makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt") + ,("AFP_W.makeValid (\"c:\\\\test/prn.txt\") == (\"c:\\\\test/prn_.txt\")", property $ AFP_W.makeValid ("c:\\test/prn.txt") == ("c:\\test/prn_.txt")) + ,("W.makeValid \"c:\\\\nul\\\\file\" == \"c:\\\\nul_\\\\file\"", property $ W.makeValid "c:\\nul\\file" == "c:\\nul_\\file") + ,("AFP_W.makeValid (\"c:\\\\nul\\\\file\") == (\"c:\\\\nul_\\\\file\")", property $ AFP_W.makeValid ("c:\\nul\\file") == ("c:\\nul_\\file")) + ,("W.makeValid \"\\\\\\\\\\\\foo\" == \"\\\\\\\\drive\"", property $ W.makeValid "\\\\\\foo" == "\\\\drive") + ,("AFP_W.makeValid (\"\\\\\\\\\\\\foo\") == (\"\\\\\\\\drive\")", property $ AFP_W.makeValid ("\\\\\\foo") == ("\\\\drive")) + ,("W.makeValid \"\\\\\\\\?\\\\D:file\" == \"\\\\\\\\?\\\\D:\\\\file\"", property $ W.makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file") + ,("AFP_W.makeValid (\"\\\\\\\\?\\\\D:file\") == (\"\\\\\\\\?\\\\D:\\\\file\")", property $ AFP_W.makeValid ("\\\\?\\D:file") == ("\\\\?\\D:\\file")) + ,("W.makeValid \"nul .txt\" == \"nul _.txt\"", property $ W.makeValid "nul .txt" == "nul _.txt") + ,("AFP_W.makeValid (\"nul .txt\") == (\"nul _.txt\")", property $ AFP_W.makeValid ("nul .txt") == ("nul _.txt")) + ,("W.isRelative \"path\\\\test\" == True", property $ W.isRelative "path\\test" == True) + ,("AFP_W.isRelative (\"path\\\\test\") == True", property $ AFP_W.isRelative ("path\\test") == True) + ,("W.isRelative \"c:\\\\test\" == False", property $ W.isRelative "c:\\test" == False) + ,("AFP_W.isRelative (\"c:\\\\test\") == False", property $ AFP_W.isRelative ("c:\\test") == False) + ,("W.isRelative \"c:test\" == True", property $ W.isRelative "c:test" == True) + ,("AFP_W.isRelative (\"c:test\") == True", property $ AFP_W.isRelative ("c:test") == True) + ,("W.isRelative \"c:\\\\\" == False", property $ W.isRelative "c:\\" == False) + ,("AFP_W.isRelative (\"c:\\\\\") == False", property $ AFP_W.isRelative ("c:\\") == False) + ,("W.isRelative \"c:/\" == False", property $ W.isRelative "c:/" == False) + ,("AFP_W.isRelative (\"c:/\") == False", property $ AFP_W.isRelative ("c:/") == False) + ,("W.isRelative \"c:\" == True", property $ W.isRelative "c:" == True) + ,("AFP_W.isRelative (\"c:\") == True", property $ AFP_W.isRelative ("c:") == True) + ,("W.isRelative \"\\\\\\\\foo\" == False", property $ W.isRelative "\\\\foo" == False) + ,("AFP_W.isRelative (\"\\\\\\\\foo\") == False", property $ AFP_W.isRelative ("\\\\foo") == False) + ,("W.isRelative \"\\\\\\\\?\\\\foo\" == False", property $ W.isRelative "\\\\?\\foo" == False) + ,("AFP_W.isRelative (\"\\\\\\\\?\\\\foo\") == False", property $ AFP_W.isRelative ("\\\\?\\foo") == False) + ,("W.isRelative \"\\\\\\\\?\\\\UNC\\\\foo\" == False", property $ W.isRelative "\\\\?\\UNC\\foo" == False) + ,("AFP_W.isRelative (\"\\\\\\\\?\\\\UNC\\\\foo\") == False", property $ AFP_W.isRelative ("\\\\?\\UNC\\foo") == False) + ,("W.isRelative \"/foo\" == True", property $ W.isRelative "/foo" == True) + ,("AFP_W.isRelative (\"/foo\") == True", property $ AFP_W.isRelative ("/foo") == True) + ,("W.isRelative \"\\\\foo\" == True", property $ W.isRelative "\\foo" == True) + ,("AFP_W.isRelative (\"\\\\foo\") == True", property $ AFP_W.isRelative ("\\foo") == True) + ,("P.isRelative \"test/path\" == True", property $ P.isRelative "test/path" == True) + ,("AFP_P.isRelative (\"test/path\") == True", property $ AFP_P.isRelative ("test/path") == True) + ,("P.isRelative \"/test\" == False", property $ P.isRelative "/test" == False) + ,("AFP_P.isRelative (\"/test\") == False", property $ AFP_P.isRelative ("/test") == False) + ,("P.isRelative \"/\" == False", property $ P.isRelative "/" == False) + ,("AFP_P.isRelative (\"/\") == False", property $ AFP_P.isRelative ("/") == False) + ,("P.isAbsolute x == not (P.isRelative x)", property $ \(QFilePath x) -> P.isAbsolute x == not (P.isRelative x)) + ,("W.isAbsolute x == not (W.isRelative x)", property $ \(QFilePath x) -> W.isAbsolute x == not (W.isRelative x)) + ,("AFP_P.isAbsolute x == not (AFP_P.isRelative x)", property $ \(QFilePathAFP_P x) -> AFP_P.isAbsolute x == not (AFP_P.isRelative x)) + ,("AFP_W.isAbsolute x == not (AFP_W.isRelative x)", property $ \(QFilePathAFP_W x) -> AFP_W.isAbsolute x == not (AFP_W.isRelative x)) + ]