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.OsPath.Encoding.Internal" + ,"import qualified Data.Char as C" + ,"import qualified System.OsPath.Data.ByteString.Short as SBS" + ,"import qualified System.OsPath.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/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,5 @@ -#if __GLASGOW_HASKELL__ >= 704 -{-# LANGUAGE Safe #-} -#endif {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TypeApplications #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows @@ -61,16 +59,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 +110,50 @@ ) where -import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) +{- HLINT ignore "Use fewer imports" -} +import Prelude (Char, Bool(..), Maybe(..), (.), (&&), (<=), not, fst, maybe, (||), (==), ($), otherwise, fmap, mempty, (>=), (/=), (++), snd) +import Data.Semigroup ((<>)) +import qualified Prelude as P import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) +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, takeWhile, take, all, elem, any, head, tail, span) +import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) +import Data.List(stripPrefix, isSuffixOf, uncons) +#define CHAR Char +#define STRING String +#define FILEPATH FilePath +#else +import Prelude (fromIntegral) +import Control.Exception ( SomeException, evaluate, try, displayException ) +import Data.Bifunctor (first) +import Control.DeepSeq (force) +import GHC.IO (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.OsPath.Data.ByteString.Short.Word16 +import System.OsPath.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.OsPath.Data.ByteString.Short +#define CHAR Word8 +#define STRING ShortByteString +#define FILEPATH ShortByteString +#endif +#endif infixr 7 <.>, -<.> @@ -138,51 +184,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 +248,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 +281,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,12 +290,12 @@ -- > 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) +splitExtension :: FILEPATH -> (STRING, STRING) +splitExtension x = if null nameDot + then (x, mempty) + else (dir <> init nameDot, singleton extSeparator <> ext) where - (dir,file) = splitFileName_ x + (dir,file) = splitFileName_ x (nameDot,ext) = breakEnd isExtSeparator file -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. @@ -247,7 +304,7 @@ -- > 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 +312,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 +325,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 +352,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 <> singleton extSeparator <> xs (a,b) = splitDrive file @@ -309,7 +367,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 +379,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 (singleton _period <> 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 +401,22 @@ -- > 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 singleton _period <> 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 +427,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 +445,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 +455,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 +476,54 @@ -- > 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 unpack bs of + (x:c:y:xs) + | c == _colon && isLetter x && isPathSeparator y -> Just $ addSlash (pack [x,_colon]) (pack (y:xs)) + (x:c:xs) + | c == _colon && isLetter x -> Just (pack [x,_colon], pack xs) + _ -> 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 (singleton s1 <> singleton s2 <> 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 +536,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 +559,7 @@ -- > Windows: hasDrive "C:foo" == True -- > hasDrive "foo" == False -- > hasDrive "" == False -hasDrive :: FilePath -> Bool +hasDrive :: FILEPATH -> Bool hasDrive = not . null . takeDrive @@ -502,7 +570,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 +588,31 @@ -- > 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 +splitFileName :: FILEPATH -> (STRING, STRING) +splitFileName x = if null path + then (dotSlash, file) + else (path, file) + where + (path, file) = splitFileName_ x + dotSlash = singleton _period <> 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 +splitFileName_ :: FILEPATH -> (STRING, STRING) +splitFileName_ fp = (drv <> dir, file) + where + (drv, pth) = splitDrive fp + (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 :: FILEPATH -> STRING -> FILEPATH replaceFileName x y = a y where (a,_) = splitFileName_ x -- | Drop the filename. Unlike 'takeDirectory', this function will leave @@ -549,7 +620,7 @@ -- -- > dropFileName "/directory/file.ext" == "/directory/" -- > dropFileName x == fst (splitFileName x) -dropFileName :: FilePath -> FilePath +dropFileName :: FILEPATH -> FILEPATH dropFileName = fst . splitFileName @@ -557,12 +628,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 +645,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 +655,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 +665,16 @@ -- -- > 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 x + | null x = False + | otherwise = isPathSeparator $ head x -- | Add a trailing file path separator if one is not already present. @@ -609,8 +682,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 +692,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 +713,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 <> singleton pathSeparator <> b -- | Combine two paths with a path separator. @@ -707,7 +782,7 @@ -- -- > Windows: "D:\\foo" "C:bar" == "C:bar" -- > Windows: "C:\\foo" "C:bar" == "C:bar" -() :: FilePath -> FilePath -> FilePath +() :: FILEPATH -> FILEPATH -> FILEPATH () = combine @@ -720,13 +795,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 +817,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 +840,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 +855,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 +886,26 @@ -- > 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 | not (null x) && isPathSeparator (head 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 + takeAbs x | not (null x) && isPathSeparator (head x) && not (hasDrive x) = singleton pathSeparator + takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x -- | Normalise a file -- @@ -863,53 +939,71 @@ -- > 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 filepath + && 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] + | otherwise = if isJust $ readDriveLetter x2 + then map toUpper x2 + else 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 +1023,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 +1054,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 <> singleton pathSeparator <> 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 +1098,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 +1107,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,9 +1115,10 @@ -- | @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]) @@ -1045,4 +1142,109 @@ -- 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) + + +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc xs = Just (init xs, last xs) + + +_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 +#ifdef WINDOWS +fromString :: P.String -> STRING +fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do + r <- try @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 <- try @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,1437 @@ +{-# 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.encodeWith + , PS.encodeFS +#if defined(WINDOWS) || defined(POSIX) + , pstr +#else + , osp +#endif + , PS.pack + + -- * Filepath deconstruction + , PS.decodeUtf + , PS.decodeWith + , PS.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 + , decodeFS + , pack + , encodeUtf + , encodeWith + , encodeFS + , unpack + ) +import Data.Bifunctor ( bimap ) +import qualified System.OsPath.Windows.Internal as C +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +import Language.Haskell.TH.Syntax + ( Lift (..), lift ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import Control.Monad ( when ) + +#elif defined(POSIX) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import Control.Monad ( when ) +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +import Language.Haskell.TH.Syntax + ( Lift (..), lift ) + +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import System.OsPath.Types +import System.OsString.Posix as PS + ( unsafeFromChar + , toChar + , decodeUtf + , decodeWith + , decodeFS + , pack + , encodeUtf + , encodeWith + , encodeFS + , unpack + ) +import Data.Bifunctor ( bimap ) +import qualified System.OsPath.Posix.Internal as C + +#else + +import System.OsPath.Internal as PS + ( osp + , decodeUtf + , decodeWith + , decodeFS + , pack + , encodeUtf + , encodeWith + , encodeFS + , 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 + + +------------------------ +-- 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 diff --git a/System/OsPath/Data/ByteString/Short.hs b/System/OsPath/Data/ByteString/Short.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Data/ByteString/Short.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module : System.OsPath.Data.ByteString.Short +-- Copyright : (c) Duncan Coutts 2012-2013, Julian Ospald 2022 +-- License : BSD-style +-- +-- Maintainer : hasufell@posteo.de +-- Stability : stable +-- Portability : ghc only +-- +-- A compact representation suitable for storing short byte strings in memory. +-- +-- In typical use cases it can be imported alongside "Data.ByteString", e.g. +-- +-- > import qualified Data.ByteString as B +-- > import qualified Data.ByteString.Short as B +-- > (ShortByteString, toShort, fromShort) +-- +-- Other 'ShortByteString' operations clash with "Data.ByteString" or "Prelude" +-- functions however, so they should be imported @qualified@ with a different +-- alias e.g. +-- +-- > import qualified Data.ByteString.Short as B.Short +-- +module System.OsPath.Data.ByteString.Short ( + + -- * The @ShortByteString@ type + + ShortByteString(..), + + -- ** Memory overhead + -- | With GHC, the memory overheads are as follows, expressed in words and + -- in bytes (words are 4 and 8 bytes on 32 or 64bit machines respectively). + -- + -- * 'B.ByteString' unshared: 8 words; 32 or 64 bytes. + -- + -- * 'B.ByteString' shared substring: 4 words; 16 or 32 bytes. + -- + -- * 'ShortByteString': 4 words; 16 or 32 bytes. + -- + -- For the string data itself, both 'ShortByteString' and 'B.ByteString' use + -- one byte per element, rounded up to the nearest word. For example, + -- including the overheads, a length 10 'ShortByteString' would take + -- @16 + 12 = 28@ bytes on a 32bit platform and @32 + 16 = 48@ bytes on a + -- 64bit platform. + -- + -- These overheads can all be reduced by 1 word (4 or 8 bytes) when the + -- 'ShortByteString' or 'B.ByteString' is unpacked into another constructor. + -- + -- For example: + -- + -- > data ThingId = ThingId {-# UNPACK #-} !Int + -- > {-# UNPACK #-} !ShortByteString + -- + -- This will take @1 + 1 + 3@ words (the @ThingId@ constructor + + -- unpacked @Int@ + unpacked @ShortByteString@), plus the words for the + -- string data. + + -- ** Heap fragmentation + -- | With GHC, the 'B.ByteString' representation uses /pinned/ memory, + -- meaning it cannot be moved by the GC. This is usually the right thing to + -- do for larger strings, but for small strings using pinned memory can + -- lead to heap fragmentation which wastes space. The 'ShortByteString' + -- type (and the @Text@ type from the @text@ package) use /unpinned/ memory + -- so they do not contribute to heap fragmentation. In addition, with GHC, + -- small unpinned strings are allocated in the same way as normal heap + -- allocations, rather than in a separate pinned area. + + -- * Introducing and eliminating 'ShortByteString's + empty, + singleton, + pack, + unpack, + fromShort, + toShort, + + -- * Basic interface + snoc, + cons, + append, + last, + tail, + uncons, + head, + init, + unsnoc, + null, + length, + + -- * Transforming ShortByteStrings + map, + reverse, + intercalate, + + -- * Reducing 'ShortByteString's (folds) + foldl, + foldl', + foldl1, + foldl1', + + foldr, + foldr', + foldr1, + foldr1', + + -- ** Special folds + all, + any, + concat, + + -- ** Generating and unfolding ByteStrings + replicate, + unfoldr, + unfoldrN, + + -- * Substrings + + -- ** Breaking strings + take, + takeEnd, + takeWhileEnd, + takeWhile, + drop, + dropEnd, + dropWhile, + dropWhileEnd, + breakEnd, + break, + span, + spanEnd, + splitAt, + split, + splitWith, + stripSuffix, + stripPrefix, + + -- * Predicates + isInfixOf, + isPrefixOf, + isSuffixOf, + + -- ** Search for arbitrary substrings + breakSubstring, + + -- * Searching ShortByteStrings + + -- ** Searching by equality + elem, + + -- ** Searching with a predicate + find, + filter, + partition, + + -- * Indexing ShortByteStrings + index, + indexMaybe, + (!?), + elemIndex, + elemIndices, + count, + findIndex, + findIndices, + + -- * Low level conversions + -- ** Packing 'Foreign.C.String.CString's and pointers + packCString, + packCStringLen, + + -- ** Using ShortByteStrings as 'Foreign.C.String.CString's + useAsCString, + useAsCStringLen, + ) where + +import Data.ByteString.Short.Internal diff --git a/System/OsPath/Data/ByteString/Short/Internal.hs b/System/OsPath/Data/ByteString/Short/Internal.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Data/ByteString/Short/Internal.hs @@ -0,0 +1,436 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : System.OsPath.Data.ByteString.Short.Internal +-- Copyright : © 2022 Julian Ospald +-- License : MIT +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Internal low-level utilities mostly for 'System.OsPath.Data.ByteString.Short.Word16', +-- such as byte-array operations and other stuff not meant to be exported from Word16 module. +module System.OsPath.Data.ByteString.Short.Internal where + +import Control.Monad.ST +import Control.Exception (assert, throwIO) +import Data.ByteString.Short.Internal (ShortByteString(..), length) +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup + ( Semigroup((<>)) ) +#endif +#if !MIN_VERSION_bytestring(0,10,9) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.C.String ( CString, CStringLen ) +import Foreign.C.Types ( CSize(..) ) +import Foreign.Storable (pokeByteOff) +#endif +import Foreign.Marshal.Array (withArray0, peekArray0, newArray0, withArrayLen, peekArray) +import GHC.Exts +import GHC.Word +import GHC.ST + ( ST (ST) ) +import GHC.Stack ( HasCallStack ) +import Prelude hiding + ( length ) + +import qualified Data.ByteString.Short.Internal as BS +import qualified Data.Char as C +import qualified Data.List as List + + +_nul :: Word16 +_nul = 0x00 + +isSpace :: Word16 -> Bool +isSpace = C.isSpace . word16ToChar + +-- | Total conversion to char. +word16ToChar :: Word16 -> Char +word16ToChar = C.chr . fromIntegral + +create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString +create len fill = + runST $ do + mba <- newByteArray len + fill mba + BA# ba# <- unsafeFreezeByteArray mba + return (SBS ba#) +{-# INLINE create #-} + + +asBA :: ShortByteString -> BA +asBA (SBS ba#) = BA# ba# + + + +data BA = BA# ByteArray# +data MBA s = MBA# (MutableByteArray# s) + + +newPinnedByteArray :: Int -> ST s (MBA s) +newPinnedByteArray (I# len#) = + ST $ \s -> case newPinnedByteArray# len# s of + (# s', mba# #) -> (# s', MBA# mba# #) + +newByteArray :: Int -> ST s (MBA s) +newByteArray (I# len#) = + ST $ \s -> case newByteArray# len# s of + (# s', mba# #) -> (# s', MBA# mba# #) + +copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s () +copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = + ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of + s' -> (# s', () #) + +unsafeFreezeByteArray :: MBA s -> ST s BA +unsafeFreezeByteArray (MBA# mba#) = + ST $ \s -> case unsafeFreezeByteArray# mba# s of + (# s', ba# #) -> (# s', BA# ba# #) + +copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld () +copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) = + ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of + s' -> (# s', () #) + + +-- this is a copy-paste from bytestring +#if !MIN_VERSION_bytestring(0,10,9) +------------------------------------------------------------------------ +-- Primop replacements + +-- --------------------------------------------------------------------- +-- +-- Standard C functions +-- + +foreign import ccall unsafe "string.h strlen" c_strlen + :: CString -> IO CSize + + +-- --------------------------------------------------------------------- +-- +-- Uses our C code +-- + +-- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The +-- resulting @ShortByteString@ is an immutable copy of the original +-- @CString@, and is managed on the Haskell heap. The original +-- @CString@ must be null terminated. +-- +-- @since 0.10.10.0 +packCString :: CString -> IO ShortByteString +packCString cstr = do + len <- c_strlen cstr + packCStringLen (cstr, fromIntegral len) + +-- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The +-- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@. +-- The @ShortByteString@ is a normal Haskell value and will be managed on the +-- Haskell heap. +-- +-- @since 0.10.10.0 +packCStringLen :: CStringLen -> IO ShortByteString +packCStringLen (cstr, len) | len >= 0 = BS.createFromPtr cstr len +packCStringLen (_, len) = + moduleErrorIO "packCStringLen" ("negative length: " ++ show len) + +-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a +-- null-terminated @CString@. The @CString@ is a copy and will be freed +-- automatically; it must not be stored or used after the +-- subcomputation finishes. +-- +-- @since 0.10.10.0 +useAsCString :: ShortByteString -> (CString -> IO a) -> IO a +useAsCString bs action = + allocaBytes (l+1) $ \buf -> do + BS.copyToPtr bs 0 buf (fromIntegral l) + pokeByteOff buf l (0::Word8) + action buf + where l = length bs + +-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@. +-- As for @useAsCString@ this function makes a copy of the original @ShortByteString@. +-- It must not be stored or used after the subcomputation finishes. +-- +-- @since 0.10.10.0 +useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a +useAsCStringLen bs action = + allocaBytes l $ \buf -> do + BS.copyToPtr bs 0 buf (fromIntegral l) + action (buf, l) + where l = length bs + + +#endif + + +-- | /O(n)./ Construct a new @ShortByteString@ from a @CWString@. The +-- resulting @ShortByteString@ is an immutable copy of the original +-- @CWString@, and is managed on the Haskell heap. The original +-- @CWString@ must be null terminated. +-- +-- @since 0.10.10.0 +packCWString :: Ptr Word16 -> IO ShortByteString +packCWString cwstr = do + cs <- peekArray0 _nul cwstr + return (packWord16 cs) + +-- | /O(n)./ Construct a new @ShortByteString@ from a @CWStringLen@. The +-- resulting @ShortByteString@ is an immutable copy of the original @CWStringLen@. +-- The @ShortByteString@ is a normal Haskell value and will be managed on the +-- Haskell heap. +-- +-- @since 0.10.10.0 +packCWStringLen :: (Ptr Word16, Int) -> IO ShortByteString +packCWStringLen (cp, len) = do + cs <- peekArray len cp + return (packWord16 cs) + + +-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a +-- null-terminated @CWString@. The @CWString@ is a copy and will be freed +-- automatically; it must not be stored or used after the +-- subcomputation finishes. +-- +-- @since 0.10.10.0 +useAsCWString :: ShortByteString -> (Ptr Word16 -> IO a) -> IO a +useAsCWString = withArray0 _nul . unpackWord16 + +-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@. +-- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@. +-- It must not be stored or used after the subcomputation finishes. +-- +-- @since 0.10.10.0 +useAsCWStringLen :: ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a +useAsCWStringLen bs action = withArrayLen (unpackWord16 bs) $ \ len ptr -> action (ptr, len) + +-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@. +-- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@. +-- It must not be stored or used after the subcomputation finishes. +-- +-- @since 0.10.10.0 +newCWString :: ShortByteString -> IO (Ptr Word16) +newCWString = newArray0 _nul . unpackWord16 + + + + + -- --------------------------------------------------------------------- +-- Internal utilities + +moduleErrorIO :: String -> String -> IO a +moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg +{-# NOINLINE moduleErrorIO #-} + +moduleErrorMsg :: String -> String -> String +moduleErrorMsg fun msg = "System.OsPath.Data.ByteString.Short." ++ fun ++ ':':' ':msg + +packWord16 :: [Word16] -> ShortByteString +packWord16 cs = packLenWord16 (List.length cs) cs + +packLenWord16 :: Int -> [Word16] -> ShortByteString +packLenWord16 len ws0 = + create (len * 2) (\mba -> go mba 0 ws0) + where + go :: MBA s -> Int -> [Word16] -> ST s () + go !_ !_ [] = return () + go !mba !i (w:ws) = do + writeWord16Array mba i w + go mba (i+2) ws + + +unpackWord16 :: ShortByteString -> [Word16] +unpackWord16 sbs = go len [] + where + len = length sbs + go !i !acc + | i < 1 = acc + | otherwise = let !w = indexWord16Array (asBA sbs) (i - 2) + in go (i - 2) (w:acc) + +packWord16Rev :: [Word16] -> ShortByteString +packWord16Rev cs = packLenWord16Rev (List.length cs * 2) cs + +packLenWord16Rev :: Int -> [Word16] -> ShortByteString +packLenWord16Rev len ws0 = + create len (\mba -> go mba len ws0) + where + go :: MBA s -> Int -> [Word16] -> ST s () + go !_ !_ [] = return () + go !mba !i (w:ws) = do + writeWord16Array mba (i - 2) w + go mba (i - 2) ws + + +-- | This isn't strictly Word16 array write. Instead it's two consecutive Word8 array +-- writes to avoid endianness issues due to primops doing automatic alignment based +-- on host platform. We want to always write LE to the byte array. +writeWord16Array :: MBA s + -> Int -- ^ Word8 index (not Word16) + -> Word16 + -> ST s () +writeWord16Array (MBA# mba#) (I# i#) (W16# w#) = + case encodeWord16LE# w# of + (# lsb#, msb# #) -> + ST (\s -> case writeWord8Array# mba# i# lsb# s of + s' -> (# s', () #)) >> + ST (\s -> case writeWord8Array# mba# (i# +# 1#) msb# s of + s' -> (# s', () #)) + +-- | This isn't strictly Word16 array read. Instead it's two Word8 array reads +-- to avoid endianness issues due to primops doing automatic alignment based +-- on host platform. We expect the byte array to be LE always. +indexWord16Array :: BA + -> Int -- ^ Word8 index (not Word16) + -> Word16 +indexWord16Array (BA# ba#) (I# i#) = + case (# indexWord8Array# ba# i#, indexWord8Array# ba# (i# +# 1#) #) of + (# lsb#, msb# #) -> W16# (decodeWord16LE# (# lsb#, msb# #)) + +#if !MIN_VERSION_base(4,16,0) + +encodeWord16LE# :: Word# -- ^ Word16 + -> (# Word#, Word# #) -- ^ Word8 (LSB, MSB) +encodeWord16LE# x# = (# x# `and#` int2Word# 0xff# + , x# `and#` int2Word# 0xff00# `shiftRL#` 8# #) + +decodeWord16LE# :: (# Word#, Word# #) -- ^ Word8 (LSB, MSB) + -> Word# -- ^ Word16 +decodeWord16LE# (# lsb#, msb# #) = msb# `shiftL#` 8# `or#` lsb# + +#else + +encodeWord16LE# :: Word16# -- ^ Word16 + -> (# Word8#, Word8# #) -- ^ Word8 (LSB, MSB) +encodeWord16LE# x# = (# word16ToWord8# x# + , word16ToWord8# (x# `uncheckedShiftRLWord16#` 8#) #) + where + word16ToWord8# y = wordToWord8# (word16ToWord# y) + +decodeWord16LE# :: (# Word8#, Word8# #) -- ^ Word8 (LSB, MSB) + -> Word16# -- ^ Word16 +decodeWord16LE# (# lsb#, msb# #) = ((word8ToWord16# msb# `uncheckedShiftLWord16#` 8#) `orWord16#` word8ToWord16# lsb#) + where + word8ToWord16# y = wordToWord16# (word8ToWord# y) + +#endif + +setByteArray :: MBA s -> Int -> Int -> Int -> ST s () +setByteArray (MBA# dst#) (I# off#) (I# len#) (I# c#) = + ST $ \s -> case setByteArray# dst# off# len# c# s of + s' -> (# s', () #) + +copyMutableByteArray :: MBA s -> Int -> MBA s -> Int -> Int -> ST s () +copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = + ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of + s' -> (# s', () #) + +-- | Given the maximum size needed and a function to make the contents +-- of a ShortByteString, createAndTrim makes the 'ShortByteString'. +-- The generating function is required to return the actual final size +-- (<= the maximum size) and the result value. The resulting byte array +-- is realloced to this size. +createAndTrim :: Int -> (forall s. MBA s -> ST s (Int, a)) -> (ShortByteString, a) +createAndTrim l fill = + runST $ do + mba <- newByteArray l + (l', res) <- fill mba + if assert (l' <= l) $ l' >= l + then do + BA# ba# <- unsafeFreezeByteArray mba + return (SBS ba#, res) + else do + mba2 <- newByteArray l' + copyMutableByteArray mba 0 mba2 0 l' + BA# ba# <- unsafeFreezeByteArray mba2 + return (SBS ba#, res) +{-# INLINE createAndTrim #-} + +createAndTrim' :: Int -> (forall s. MBA s -> ST s Int) -> ShortByteString +createAndTrim' l fill = + runST $ do + mba <- newByteArray l + l' <- fill mba + if assert (l' <= l) $ l' >= l + then do + BA# ba# <- unsafeFreezeByteArray mba + return (SBS ba#) + else do + mba2 <- newByteArray l' + copyMutableByteArray mba 0 mba2 0 l' + BA# ba# <- unsafeFreezeByteArray mba2 + return (SBS ba#) +{-# INLINE createAndTrim' #-} + +createAndTrim'' :: Int -> (forall s. MBA s -> MBA s -> ST s (Int, Int)) -> (ShortByteString, ShortByteString) +createAndTrim'' l fill = + runST $ do + mba1 <- newByteArray l + mba2 <- newByteArray l + (l1, l2) <- fill mba1 mba2 + sbs1 <- freeze' l1 mba1 + sbs2 <- freeze' l2 mba2 + pure (sbs1, sbs2) + where + freeze' :: Int -> MBA s -> ST s ShortByteString + freeze' l' mba = + if assert (l' <= l) $ l' >= l + then do + BA# ba# <- unsafeFreezeByteArray mba + return (SBS ba#) + else do + mba2 <- newByteArray l' + copyMutableByteArray mba 0 mba2 0 l' + BA# ba# <- unsafeFreezeByteArray mba2 + return (SBS ba#) +{-# INLINE createAndTrim'' #-} + +-- Returns the index of the first match or the length of the whole +-- bytestring if nothing matched. +findIndexOrLength :: (Word16 -> Bool) -> ShortByteString -> Int +findIndexOrLength k (assertEven -> sbs) = go 0 + where + l = BS.length sbs + ba = asBA sbs + w = indexWord16Array ba + go !n | n >= l = l `div` 2 + | k (w n) = n `div` 2 + | otherwise = go (n + 2) +{-# INLINE findIndexOrLength #-} + + +-- | Returns the length of the substring matching, not the index. +-- If no match, returns 0. +findFromEndUntil :: (Word16 -> Bool) -> ShortByteString -> Int +findFromEndUntil k sbs = go (BS.length sbs - 2) + where + ba = asBA sbs + w = indexWord16Array ba + go !n | n < 0 = 0 + | k (w n) = (n `div` 2) + 1 + | otherwise = go (n - 2) +{-# INLINE findFromEndUntil #-} + + +assertEven :: ShortByteString -> ShortByteString +assertEven sbs@(SBS barr#) + | even (I# (sizeofByteArray# barr#)) = sbs + | otherwise = error ("Uneven number of bytes: " <> show (BS.length sbs) <> ". This is not a Word16 bytestream.") + + +-- Common up near identical calls to `error' to reduce the number +-- constant strings created when compiled: +errorEmptySBS :: HasCallStack => String -> a +errorEmptySBS fun = moduleError fun "empty ShortByteString" +{-# NOINLINE errorEmptySBS #-} + +moduleError :: HasCallStack => String -> String -> a +moduleError fun msg = error (moduleErrorMsg fun msg) +{-# NOINLINE moduleError #-} diff --git a/System/OsPath/Data/ByteString/Short/Word16.hs b/System/OsPath/Data/ByteString/Short/Word16.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Data/ByteString/Short/Word16.hs @@ -0,0 +1,862 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-} + +-- | +-- Module : System.OsPath.Data.ByteString.Short.Word16 +-- Copyright : © 2022 Julian Ospald +-- License : MIT +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- ShortByteStrings encoded as UTF16-LE, suitable for windows FFI calls. +-- +-- Word16s are *always* in BE encoding (both input and output), so e.g. 'pack' +-- takes a list of BE encoded @[Word16]@ and produces a UTF16-LE encoded ShortByteString. +-- +-- Likewise, 'unpack' takes a UTF16-LE encoded ShortByteString and produces a list of BE encoded @[Word16]@. +-- +-- Indices and lengths are always in respect to Word16, not Word8. +-- +-- All functions will error out if the input string is not a valid UTF16 stream (uneven number of bytes). +-- So use this module with caution. +module System.OsPath.Data.ByteString.Short.Word16 ( + -- * The @ShortByteString@ type and representation + ShortByteString(..), + + -- * Introducing and eliminating 'ShortByteString's + empty, + singleton, + pack, + unpack, + fromShort, + toShort, + + -- * Basic interface + snoc, + cons, + append, + last, + tail, + uncons, + head, + init, + unsnoc, + null, + length, + numWord16, + + -- * Transforming ShortByteStrings + map, + reverse, + intercalate, + + -- * Reducing 'ShortByteString's (folds) + foldl, + foldl', + foldl1, + foldl1', + + foldr, + foldr', + foldr1, + foldr1', + + -- ** Special folds + all, + any, + concat, + + -- ** Generating and unfolding ByteStrings + replicate, + unfoldr, + unfoldrN, + + -- * Substrings + + -- ** Breaking strings + take, + takeEnd, + takeWhileEnd, + takeWhile, + drop, + dropEnd, + dropWhile, + dropWhileEnd, + breakEnd, + break, + span, + spanEnd, + splitAt, + split, + splitWith, + stripSuffix, + stripPrefix, + + -- * Predicates + isInfixOf, + isPrefixOf, + isSuffixOf, + + -- ** Search for arbitrary substrings + breakSubstring, + + -- * Searching ShortByteStrings + + -- ** Searching by equality + elem, + + -- ** Searching with a predicate + find, + filter, + partition, + + -- * Indexing ShortByteStrings + index, + indexMaybe, + (!?), + elemIndex, + elemIndices, + count, + findIndex, + findIndices, + + -- ** Encoding validation + -- isValidUtf8, + + -- * Low level conversions + -- ** Packing 'CString's and pointers + packCWString, + packCWStringLen, + newCWString, + + -- ** Using ShortByteStrings as 'CString's + useAsCWString, + useAsCWStringLen + ) +where +import System.OsPath.Data.ByteString.Short ( append, intercalate, concat, stripSuffix, stripPrefix, isInfixOf, isPrefixOf, isSuffixOf, breakSubstring, length, empty, null, ShortByteString(..), fromShort, toShort ) +import System.OsPath.Data.ByteString.Short.Internal +import Data.Bits + ( shiftR ) +import Data.Word +import Prelude hiding + ( all + , any + , reverse + , break + , concat + , drop + , dropWhile + , elem + , filter + , foldl + , foldl1 + , foldr + , foldr1 + , head + , init + , last + , length + , map + , null + , replicate + , span + , splitAt + , tail + , take + , takeWhile + ) +import qualified Data.Foldable as Foldable +import GHC.ST ( ST ) +import GHC.Stack ( HasCallStack ) + +import qualified Data.ByteString.Short.Internal as BS +import qualified Data.List as List + + +-- ----------------------------------------------------------------------------- +-- Introducing and eliminating 'ShortByteString's + +-- | /O(1)/ Convert a 'Word16' into a 'ShortByteString' +singleton :: Word16 -> ShortByteString +singleton = \w -> create 2 (\mba -> writeWord16Array mba 0 w) + + +-- | /O(n)/. Convert a list into a 'ShortByteString' +pack :: [Word16] -> ShortByteString +pack = packWord16 + + +-- | /O(n)/. Convert a 'ShortByteString' into a list. +unpack :: ShortByteString -> [Word16] +unpack = unpackWord16 . assertEven + + +-- --------------------------------------------------------------------- +-- Basic interface + +-- | This is like 'length', but the number of 'Word16', not 'Word8'. +numWord16 :: ShortByteString -> Int +numWord16 = (`shiftR` 1) . BS.length . assertEven + +infixr 5 `cons` --same as list (:) +infixl 5 `snoc` + +-- | /O(n)/ Append a Word16 to the end of a 'ShortByteString' +-- +-- Note: copies the entire byte array +snoc :: ShortByteString -> Word16 -> ShortByteString +snoc = \(assertEven -> sbs) c -> let l = BS.length sbs + nl = l + 2 + in create nl $ \mba -> do + copyByteArray (asBA sbs) 0 mba 0 l + writeWord16Array mba l c + +-- | /O(n)/ 'cons' is analogous to (:) for lists. +-- +-- Note: copies the entire byte array +cons :: Word16 -> ShortByteString -> ShortByteString +cons c = \(assertEven -> sbs) -> let l = BS.length sbs + nl = l + 2 + in create nl $ \mba -> do + writeWord16Array mba 0 c + copyByteArray (asBA sbs) 0 mba 2 l + +-- | /O(1)/ Extract the last element of a ShortByteString, which must be finite and at least one Word16. +-- An exception will be thrown in the case of an empty ShortByteString. +last :: HasCallStack => ShortByteString -> Word16 +last = \(assertEven -> sbs) -> case null sbs of + True -> errorEmptySBS "last" + False -> indexWord16Array (asBA sbs) (BS.length sbs - 2) + +-- | /O(n)/ Extract the elements after the head of a ShortByteString, which must at least one Word16. +-- An exception will be thrown in the case of an empty ShortByteString. +-- +-- Note: copies the entire byte array +tail :: HasCallStack => ShortByteString -> ShortByteString +tail = \(assertEven -> sbs) -> + let l = BS.length sbs + nl = l - 2 + in if + | l <= 0 -> errorEmptySBS "tail" + | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 2 mba 0 nl + +-- | /O(n)/ Extract the head and tail of a ByteString, returning Nothing +-- if it is empty. +uncons :: ShortByteString -> Maybe (Word16, ShortByteString) +uncons = \(assertEven -> sbs) -> + let l = BS.length sbs + nl = l - 2 + in if | l <= 0 -> Nothing + | otherwise -> let h = indexWord16Array (asBA sbs) 0 + t = create nl $ \mba -> copyByteArray (asBA sbs) 2 mba 0 nl + in Just (h, t) + +-- | /O(1)/ Extract the first element of a ShortByteString, which must be at least one Word16. +-- An exception will be thrown in the case of an empty ShortByteString. +head :: HasCallStack => ShortByteString -> Word16 +head = \(assertEven -> sbs) -> case null sbs of + True -> errorEmptySBS "last" + False -> indexWord16Array (asBA sbs) 0 + +-- | /O(n)/ Return all the elements of a 'ShortByteString' except the last one. +-- An exception will be thrown in the case of an empty ShortByteString. +-- +-- Note: copies the entire byte array +init :: HasCallStack => ShortByteString -> ShortByteString +init = \(assertEven -> sbs) -> + let l = BS.length sbs + nl = l - 2 + in if + | l <= 0 -> errorEmptySBS "tail" + | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl + +-- | /O(n)/ Extract the 'init' and 'last' of a ByteString, returning Nothing +-- if it is empty. +unsnoc :: ShortByteString -> Maybe (ShortByteString, Word16) +unsnoc = \(assertEven -> sbs) -> + let l = BS.length sbs + nl = l - 2 + in if | l <= 0 -> Nothing + | otherwise -> let l' = indexWord16Array (asBA sbs) (l - 2) + i = create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl + in Just (i, l') + + +-- --------------------------------------------------------------------- +-- Transformations + +-- | /O(n)/ 'map' @f xs@ is the ShortByteString obtained by applying @f@ to each +-- element of @xs@. +map :: (Word16 -> Word16) -> ShortByteString -> ShortByteString +map f = \(assertEven -> sbs) -> + let l = BS.length sbs + ba = asBA sbs + in create l (\mba -> go ba mba 0 l) + where + go :: BA -> MBA s -> Int -> Int -> ST s () + go !ba !mba !i !l + | i >= l = return () + | otherwise = do + let w = indexWord16Array ba i + writeWord16Array mba i (f w) + go ba mba (i+2) l + +-- TODO: implement more efficiently +-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. +reverse :: ShortByteString -> ShortByteString +reverse = \(assertEven -> sbs) -> + let l = BS.length sbs + ba = asBA sbs + in create l (\mba -> go ba mba 0 l) + where + go :: BA -> MBA s -> Int -> Int -> ST s () + go !ba !mba !i !l + | i >= l = return () + | otherwise = do + let w = indexWord16Array ba i + writeWord16Array mba (l - 2 - i) w + go ba mba (i+2) l + + +-- --------------------------------------------------------------------- +-- Special folds + +-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'all' determines +-- if all elements of the 'ShortByteString' satisfy the predicate. +all :: (Word16 -> Bool) -> ShortByteString -> Bool +all k = \(assertEven -> sbs) -> + let l = BS.length sbs + ba = asBA sbs + w = indexWord16Array ba + go !n | n >= l = True + | otherwise = k (w n) && go (n + 2) + in go 0 + + +-- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if +-- any element of the 'ByteString' satisfies the predicate. +any :: (Word16 -> Bool) -> ShortByteString -> Bool +any k = \(assertEven -> sbs) -> + let l = BS.length sbs + ba = asBA sbs + w = indexWord16Array ba + go !n | n >= l = False + | otherwise = k (w n) || go (n + 2) + in go 0 + + +-- --------------------------------------------------------------------- +-- Unfolds and replicates + + +-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@ +-- the value of every element. The following holds: +-- +-- > replicate w c = unfoldr w (\u -> Just (u,u)) c +replicate :: Int -> Word16 -> ShortByteString +replicate w c + | w <= 0 = empty + -- can't use setByteArray here, because we write UTF-16LE + | otherwise = create (w * 2) (`go` 0) + where + go mba ix + | ix < 0 || ix >= w * 2 = pure () + | otherwise = writeWord16Array mba ix c >> go mba (ix + 2) + +-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr' +-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a +-- ShortByteString from a seed value. The function takes the element and +-- returns 'Nothing' if it is done producing the ShortByteString or returns +-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string, +-- and @b@ is the seed value for further production. +-- +-- This function is not efficient/safe. It will build a list of @[Word16]@ +-- and run the generator until it returns `Nothing`, otherwise recurse infinitely, +-- then finally create a 'ShortByteString'. +-- +-- Examples: +-- +-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0 +-- > == pack [0, 1, 2, 3, 4, 5] +-- +unfoldr :: (a -> Maybe (Word16, a)) -> a -> ShortByteString +unfoldr f x0 = packWord16Rev $ go x0 mempty + where + go x words' = case f x of + Nothing -> words' + Just (w, x') -> go x' (w:words') + +-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ShortByteString from a seed +-- value. However, the length of the result is limited by the first +-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr' +-- when the maximum length of the result is known. +-- +-- The following equation relates 'unfoldrN' and 'unfoldr': +-- +-- > fst (unfoldrN n f s) == take n (unfoldr f s) +-- +unfoldrN :: forall a. + Int -- ^ number of 'Word16' + -> (a -> Maybe (Word16, a)) + -> a + -> (ShortByteString, Maybe a) +unfoldrN i f = \x0 -> + if | i < 0 -> (empty, Just x0) + | otherwise -> createAndTrim (i * 2) $ \mba -> go mba x0 0 + + where + go :: forall s. MBA s -> a -> Int -> ST s (Int, Maybe a) + go !mba !x !n = go' x n + where + go' :: a -> Int -> ST s (Int, Maybe a) + go' !x' !n' + | n' == i * 2 = return (n', Just x') + | otherwise = case f x' of + Nothing -> return (n', Nothing) + Just (w, x'') -> do + writeWord16Array mba n' w + go' x'' (n'+2) + + +-- -------------------------------------------------------------------- +-- Predicates + + + +-- --------------------------------------------------------------------- +-- Substrings + +-- | /O(n)/ 'take' @n@, applied to a ShortByteString @xs@, returns the prefix +-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. +-- +-- Note: copies the entire byte array +take :: Int -- ^ number of Word16 + -> ShortByteString + -> ShortByteString +take = \n (assertEven -> sbs) -> + let sl = numWord16 sbs + len8 = n * 2 + in if | n >= sl -> sbs + | n <= 0 -> empty + | otherwise -> + create len8 $ \mba -> copyByteArray (asBA sbs) 0 mba 0 len8 + + +-- | /O(1)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@. +-- Takes @n@ elements from end of bytestring. +-- +-- >>> takeEnd 3 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL" +-- "e\NULf\NULg\NUL" +-- >>> takeEnd 0 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL" +-- "" +-- >>> takeEnd 4 "a\NULb\NULc\NUL" +-- "a\NULb\NULc\NUL" +takeEnd :: Int -- ^ number of 'Word16' + -> ShortByteString + -> ShortByteString +takeEnd n = \(assertEven -> sbs) -> + let sl = BS.length sbs + n2 = n * 2 + in if | n2 >= sl -> sbs + | n2 <= 0 -> empty + | otherwise -> create n2 $ \mba -> copyByteArray (asBA sbs) (max 0 (sl - n2)) mba 0 n2 + +-- | Similar to 'P.takeWhile', +-- returns the longest (possibly empty) prefix of elements +-- satisfying the predicate. +takeWhile :: (Word16 -> Bool) -> ShortByteString -> ShortByteString +takeWhile f ps = take (findIndexOrLength (not . f) ps) ps + +-- | Returns the longest (possibly empty) suffix of elements +-- satisfying the predicate. +-- +-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@. +takeWhileEnd :: (Word16 -> Bool) -> ShortByteString -> ShortByteString +takeWhileEnd f ps = drop (findFromEndUntil (not . f) ps) ps + + +-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or @[]@ if @n > 'length' xs@. +-- +-- Note: copies the entire byte array +drop :: Int -- ^ number of 'Word16' + -> ShortByteString + -> ShortByteString +drop = \n' (assertEven -> sbs) -> + let len = BS.length sbs + n = n' * 2 + in if | n <= 0 -> sbs + | n >= len -> empty + | otherwise -> + let newLen = len - n + in create newLen $ \mba -> copyByteArray (asBA sbs) n mba 0 newLen + +-- | /O(1)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@. +-- Drops @n@ elements from end of bytestring. +-- +-- >>> dropEnd 3 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL" +-- "a\NULb\NULc\NULd\NUL" +-- >>> dropEnd 0 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL" +-- "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL" +-- >>> dropEnd 4 "a\NULb\NULc\NUL" +-- "" +dropEnd :: Int -- ^ number of 'Word16' + -> ShortByteString + -> ShortByteString +dropEnd n' = \(assertEven -> sbs) -> + let sl = BS.length sbs + nl = sl - n + n = n' * 2 + in if | n >= sl -> empty + | n <= 0 -> sbs + | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl + +-- | Similar to 'P.dropWhile', +-- drops the longest (possibly empty) prefix of elements +-- satisfying the predicate and returns the remainder. +-- +-- Note: copies the entire byte array +dropWhile :: (Word16 -> Bool) -> ShortByteString -> ShortByteString +dropWhile f = \(assertEven -> ps) -> drop (findIndexOrLength (not . f) ps) ps + +-- | Similar to 'P.dropWhileEnd', +-- drops the longest (possibly empty) suffix of elements +-- satisfying the predicate and returns the remainder. +-- +-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@. +-- +-- @since 0.10.12.0 +dropWhileEnd :: (Word16 -> Bool) -> ShortByteString -> ShortByteString +dropWhileEnd f = \(assertEven -> ps) -> take (findFromEndUntil (not . f) ps) ps + +-- | Returns the longest (possibly empty) suffix of elements which __do not__ +-- satisfy the predicate and the remainder of the string. +-- +-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@. +breakEnd :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) +breakEnd p = \(assertEven -> sbs) -> splitAt (findFromEndUntil p sbs) sbs + +-- | Similar to 'P.break', +-- returns the longest (possibly empty) prefix of elements which __do not__ +-- satisfy the predicate and the remainder of the string. +-- +-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@. +break :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) +break = \p (assertEven -> ps) -> case findIndexOrLength p ps of n -> splitAt n ps + +-- | Similar to 'P.span', +-- returns the longest (possibly empty) prefix of elements +-- satisfying the predicate and the remainder of the string. +-- +-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@. +-- +span :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) +{- HLINT ignore "Use span" -} +span p = break (not . p) . assertEven + +-- | Returns the longest (possibly empty) suffix of elements +-- satisfying the predicate and the remainder of the string. +-- +-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@. +-- +-- We have +-- +-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z") +-- +-- and +-- +-- > spanEnd (not . isSpace) ps +-- > == +-- > let (x, y) = span (not . isSpace) (reverse ps) in (reverse y, reverse x) +-- +spanEnd :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) +spanEnd p = \(assertEven -> ps) -> splitAt (findFromEndUntil (not.p) ps) ps + +-- | /O(n)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. +-- +-- Note: copies the substrings +splitAt :: Int -- ^ number of Word16 + -> ShortByteString + -> (ShortByteString, ShortByteString) +splitAt n' = \(assertEven -> sbs) -> if + | n <= 0 -> (empty, sbs) + | otherwise -> + let slen = BS.length sbs + in if | n >= BS.length sbs -> (sbs, empty) + | otherwise -> + let llen = min slen (max 0 n) + rlen = max 0 (slen - max 0 n) + lsbs = create llen $ \mba -> copyByteArray (asBA sbs) 0 mba 0 llen + rsbs = create rlen $ \mba -> copyByteArray (asBA sbs) n mba 0 rlen + in (lsbs, rsbs) + where + n = n' * 2 + +-- | /O(n)/ Break a 'ShortByteString' into pieces separated by the byte +-- argument, consuming the delimiter. I.e. +-- +-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10 +-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97 +-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120 +-- > split undefined "" == [] -- and not [""] +-- +-- and +-- +-- > intercalate [c] . split c == id +-- > split == splitWith . (==) +-- +-- Note: copies the substrings +split :: Word16 -> ShortByteString -> [ShortByteString] +split w = splitWith (== w) . assertEven + + +-- | /O(n)/ Splits a 'ShortByteString' into components delimited by +-- separators, where the predicate returns True for a separator element. +-- The resulting components do not contain the separators. Two adjacent +-- separators result in an empty component in the output. eg. +-- +-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97 +-- > splitWith undefined "" == [] -- and not [""] +-- +splitWith :: (Word16 -> Bool) -> ShortByteString -> [ShortByteString] +splitWith p = \(assertEven -> sbs) -> if + | BS.null sbs -> [] + | otherwise -> go sbs + where + go sbs' + | BS.null sbs' = [mempty] + | otherwise = + case break p sbs' of + (a, b) + | BS.null b -> [a] + | otherwise -> a : go (tail b) + + +-- --------------------------------------------------------------------- +-- Reducing 'ByteString's + +-- | 'foldl', applied to a binary operator, a starting value (typically +-- the left-identity of the operator), and a ShortByteString, reduces the +-- ShortByteString using the binary operator, from left to right. +-- +foldl :: (a -> Word16 -> a) -> a -> ShortByteString -> a +foldl f v = List.foldl f v . unpack . assertEven + +-- | 'foldl'' is like 'foldl', but strict in the accumulator. +-- +foldl' :: (a -> Word16 -> a) -> a -> ShortByteString -> a +foldl' f v = List.foldl' f v . unpack . assertEven + +-- | 'foldr', applied to a binary operator, a starting value +-- (typically the right-identity of the operator), and a ShortByteString, +-- reduces the ShortByteString using the binary operator, from right to left. +foldr :: (Word16 -> a -> a) -> a -> ShortByteString -> a +foldr f v = List.foldr f v . unpack . assertEven + +-- | 'foldr'' is like 'foldr', but strict in the accumulator. +foldr' :: (Word16 -> a -> a) -> a -> ShortByteString -> a +foldr' k v = Foldable.foldr' k v . unpack . assertEven + +-- | 'foldl1' is a variant of 'foldl' that has no starting value +-- argument, and thus must be applied to non-empty 'ShortByteString's. +-- An exception will be thrown in the case of an empty ShortByteString. +foldl1 :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16 +foldl1 k = List.foldl1 k . unpack . assertEven + +-- | 'foldl1'' is like 'foldl1', but strict in the accumulator. +-- An exception will be thrown in the case of an empty ShortByteString. +foldl1' :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16 +foldl1' k = List.foldl1' k . unpack . assertEven + +-- | 'foldr1' is a variant of 'foldr' that has no starting value argument, +-- and thus must be applied to non-empty 'ShortByteString's +-- An exception will be thrown in the case of an empty ShortByteString. +foldr1 :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16 +foldr1 k = List.foldr1 k . unpack . assertEven + +-- | 'foldr1'' is a variant of 'foldr1', but is strict in the +-- accumulator. +foldr1' :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16 +foldr1' k = \(assertEven -> sbs) -> if null sbs then errorEmptySBS "foldr1'" else foldr' k (last sbs) (init sbs) + + +-- -------------------------------------------------------------------- +-- Searching ShortByteString + +-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0. +index :: HasCallStack + => ShortByteString + -> Int -- ^ number of 'Word16' + -> Word16 +index = \(assertEven -> sbs) i -> if + | i >= 0 && i < numWord16 sbs -> unsafeIndex sbs i + | otherwise -> indexError sbs i + +-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if: +-- +-- > 0 <= n < length bs +-- +-- @since 0.11.0.0 +indexMaybe :: ShortByteString + -> Int -- ^ number of 'Word16' + -> Maybe Word16 +indexMaybe = \(assertEven -> sbs) i -> if + | i >= 0 && i < numWord16 sbs -> Just $! unsafeIndex sbs i + | otherwise -> Nothing +{-# INLINE indexMaybe #-} + +unsafeIndex :: ShortByteString + -> Int -- ^ number of 'Word16' + -> Word16 +unsafeIndex sbs i = indexWord16Array (asBA sbs) (i * 2) + +indexError :: HasCallStack => ShortByteString -> Int -> a +indexError sbs i = + moduleError "index" $ "error in array index: " ++ show i + ++ " not in range [0.." ++ show (numWord16 sbs) ++ "]" + +-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if: +-- +-- > 0 <= n < length bs +-- +-- @since 0.11.0.0 +(!?) :: ShortByteString + -> Int -- ^ number of 'Word16' + -> Maybe Word16 +(!?) = indexMaybe +{-# INLINE (!?) #-} + +-- | /O(n)/ 'elem' is the 'ShortByteString' membership predicate. +elem :: Word16 -> ShortByteString -> Bool +elem c = \(assertEven -> sbs) -> case elemIndex c sbs of Nothing -> False ; _ -> True + +-- | /O(n)/ 'filter', applied to a predicate and a ByteString, +-- returns a ByteString containing those characters that satisfy the +-- predicate. +filter :: (Word16 -> Bool) -> ShortByteString -> ShortByteString +filter k = \(assertEven -> sbs) -> + let l = BS.length sbs + in if | l <= 0 -> sbs + | otherwise -> createAndTrim' l $ \mba -> go mba (asBA sbs) l + where + go :: forall s. MBA s -- mutable output bytestring + -> BA -- input bytestring + -> Int -- length of input bytestring + -> ST s Int + go !mba ba !l = go' 0 0 + where + go' :: Int -- bytes read + -> Int -- bytes written + -> ST s Int + go' !br !bw + | br >= l = return bw + | otherwise = do + let w = indexWord16Array ba br + if k w + then do + writeWord16Array mba bw w + go' (br+2) (bw+2) + else + go' (br+2) bw + +-- | /O(n)/ The 'find' function takes a predicate and a ByteString, +-- and returns the first element in matching the predicate, or 'Nothing' +-- if there is no such element. +-- +-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing +-- +find :: (Word16 -> Bool) -> ShortByteString -> Maybe Word16 +find f = \(assertEven -> sbs) -> case findIndex f sbs of + Just n -> Just (sbs `index` n) + _ -> Nothing + +-- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns +-- the pair of ByteStrings with elements which do and do not satisfy the +-- predicate, respectively; i.e., +-- +-- > partition p bs == (filter p xs, filter (not . p) xs) +-- +partition :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) +partition k = \(assertEven -> sbs) -> + let l = BS.length sbs + in if | l <= 0 -> (sbs, sbs) + | otherwise -> createAndTrim'' l $ \mba1 mba2 -> go mba1 mba2 (asBA sbs) l + where + go :: forall s. + MBA s -- mutable output bytestring1 + -> MBA s -- mutable output bytestring2 + -> BA -- input bytestring + -> Int -- length of input bytestring + -> ST s (Int, Int) -- (length mba1, length mba2) + go !mba1 !mba2 ba !l = go' 0 0 + where + go' :: Int -- bytes read + -> Int -- bytes written to bytestring 1 + -> ST s (Int, Int) -- (length mba1, length mba2) + go' !br !bw1 + | br >= l = return (bw1, br - bw1) + | otherwise = do + let w = indexWord16Array ba br + if k w + then do + writeWord16Array mba1 bw1 w + go' (br+2) (bw1+2) + else do + writeWord16Array mba2 (br - bw1) w + go' (br+2) bw1 + +-- -------------------------------------------------------------------- +-- Indexing ShortByteString + +-- | /O(n)/ The 'elemIndex' function returns the index of the first +-- element in the given 'ShortByteString' which is equal to the query +-- element, or 'Nothing' if there is no such element. +elemIndex :: Word16 + -> ShortByteString + -> Maybe Int -- ^ number of 'Word16' +{- HLINT ignore "Use elemIndex" -} +elemIndex k = findIndex (==k) . assertEven + +-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning +-- the indices of all elements equal to the query element, in ascending order. +elemIndices :: Word16 -> ShortByteString -> [Int] +{- HLINT ignore "Use elemIndices" -} +elemIndices k = findIndices (==k) . assertEven + +-- | count returns the number of times its argument appears in the ShortByteString +count :: Word16 -> ShortByteString -> Int +count w = List.length . elemIndices w . assertEven + +-- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and +-- returns the index of the first element in the ByteString +-- satisfying the predicate. +findIndex :: (Word16 -> Bool) -> ShortByteString -> Maybe Int +findIndex k = \(assertEven -> sbs) -> + let l = BS.length sbs + ba = asBA sbs + w = indexWord16Array ba + go !n | n >= l = Nothing + | k (w n) = Just (n `shiftR` 1) + | otherwise = go (n + 2) + in go 0 + +-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the +-- indices of all elements satisfying the predicate, in ascending order. +findIndices :: (Word16 -> Bool) -> ShortByteString -> [Int] +findIndices k = \(assertEven -> sbs) -> + let l = BS.length sbs + ba = asBA sbs + w = indexWord16Array ba + go !n | n >= l = [] + | k (w n) = (n `shiftR` 1) : go (n + 2) + | otherwise = go (n + 2) + in go 0 + 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.OsPath.Encoding.Internal diff --git a/System/OsPath/Encoding/Internal.hs b/System/OsPath/Encoding/Internal.hs new file mode 100644 --- /dev/null +++ b/System/OsPath/Encoding/Internal.hs @@ -0,0 +1,349 @@ +{-# LANGUAGE NoImplicitPrelude + , BangPatterns + , TypeApplications + , MultiWayIf + #-} +{-# OPTIONS_GHC -funbox-strict-fields #-} + + +module System.OsPath.Encoding.Internal where + +import qualified System.OsPath.Data.ByteString.Short as BS8 +import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16 + +import GHC.Base +import GHC.Real +import GHC.Num +-- import GHC.IO +import GHC.IO.Buffer +import GHC.IO.Encoding.Failure +import GHC.IO.Encoding.Types +import Data.Bits +import Control.Exception (SomeException, try, Exception (displayException), evaluate) +import qualified GHC.Foreign as GHC +import Data.Either (Either) +import GHC.IO (unsafePerformIO) +import Control.DeepSeq (force, NFData (rnf)) +import Data.Bifunctor (first) +import Data.Data (Typeable) +import GHC.Show (Show (show)) +import Numeric (showHex) +import Foreign.C (CStringLen) +import Data.Char (chr) +import Foreign +import Prelude (FilePath) +import GHC.IO.Encoding (getFileSystemEncoding) + +-- ----------------------------------------------------------------------------- +-- UCS-2 LE +-- + +ucs2le :: TextEncoding +ucs2le = mkUcs2le ErrorOnCodingFailure + +mkUcs2le :: CodingFailureMode -> TextEncoding +mkUcs2le cfm = TextEncoding { textEncodingName = "UCS-2LE", + mkTextDecoder = ucs2le_DF cfm, + mkTextEncoder = ucs2le_EF cfm } + +ucs2le_DF :: CodingFailureMode -> IO (TextDecoder ()) +ucs2le_DF cfm = + return (BufferCodec { + encode = ucs2le_decode, + recover = recoverDecode cfm, + close = return (), + getState = return (), + setState = const $ return () + }) + +ucs2le_EF :: CodingFailureMode -> IO (TextEncoder ()) +ucs2le_EF cfm = + return (BufferCodec { + encode = ucs2le_encode, + recover = recoverEncode cfm, + close = return (), + getState = return (), + setState = const $ return () + }) + + +ucs2le_decode :: DecodeBuffer +ucs2le_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } + output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + = let + loop !ir !ow + | ow >= os = done OutputUnderflow ir ow + | ir >= iw = done InputUnderflow ir ow + | ir + 1 == iw = done InputUnderflow ir ow + | otherwise = do + c0 <- readWord8Buf iraw ir + c1 <- readWord8Buf iraw (ir+1) + let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 + ow' <- writeCharBuf oraw ow (unsafeChr x1) + loop (ir+2) ow' + + -- lambda-lifted, to avoid thunks being built in the inner-loop: + done why !ir !ow = return (why, + if ir == iw then input{ bufL=0, bufR=0 } + else input{ bufL=ir }, + output{ bufR=ow }) + in + loop ir0 ow0 + + +ucs2le_encode :: EncodeBuffer +ucs2le_encode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } + output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + = let + done why !ir !ow = return (why, + if ir == iw then input{ bufL=0, bufR=0 } + else input{ bufL=ir }, + output{ bufR=ow }) + loop !ir !ow + | ir >= iw = done InputUnderflow ir ow + | os - ow < 2 = done OutputUnderflow ir ow + | otherwise = do + (c,ir') <- readCharBuf iraw ir + case ord c of + x | x < 0x10000 -> do + writeWord8Buf oraw ow (fromIntegral x) + writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8)) + loop ir' (ow+2) + | otherwise -> done InvalidSequence ir ow + in + loop ir0 ow0 + +-- ----------------------------------------------------------------------------- +-- UTF-16b +-- + +-- | Mimics the base encoding for filesystem operations. This should be total on all inputs (word16 byte arrays). +-- +-- Note that this has a subtle difference to 'encodeWithBaseWindows'/'decodeWithBaseWindows': it doesn't care for +-- the @0x0000@ end marker and will as such produce different results. Use @takeWhile (/= '\NUL')@ on the input +-- to recover this behavior. +utf16le_b :: TextEncoding +utf16le_b = mkUTF16le_b ErrorOnCodingFailure + +mkUTF16le_b :: CodingFailureMode -> TextEncoding +mkUTF16le_b cfm = TextEncoding { textEncodingName = "UTF-16LE_b", + mkTextDecoder = utf16le_b_DF cfm, + mkTextEncoder = utf16le_b_EF cfm } + +utf16le_b_DF :: CodingFailureMode -> IO (TextDecoder ()) +utf16le_b_DF cfm = + return (BufferCodec { + encode = utf16le_b_decode, + recover = recoverDecode cfm, + close = return (), + getState = return (), + setState = const $ return () + }) + +utf16le_b_EF :: CodingFailureMode -> IO (TextEncoder ()) +utf16le_b_EF cfm = + return (BufferCodec { + encode = utf16le_b_encode, + recover = recoverEncode cfm, + close = return (), + getState = return (), + setState = const $ return () + }) + + +utf16le_b_decode :: DecodeBuffer +utf16le_b_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } + output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + = let + loop !ir !ow + | ow >= os = done OutputUnderflow ir ow + | ir >= iw = done InputUnderflow ir ow + | ir + 1 == iw = done InputUnderflow ir ow + | otherwise = do + c0 <- readWord8Buf iraw ir + c1 <- readWord8Buf iraw (ir+1) + let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 + if | iw - ir >= 4 -> do + c2 <- readWord8Buf iraw (ir+2) + c3 <- readWord8Buf iraw (ir+3) + let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 + if | 0xd800 <= x1 && x1 <= 0xdbff + , 0xdc00 <= x2 && x2 <= 0xdfff -> do + ow' <- writeCharBuf oraw ow (unsafeChr ((x1 - 0xd800)*0x400 + (x2 - 0xdc00) + 0x10000)) + loop (ir+4) ow' + | otherwise -> do + ow' <- writeCharBuf oraw ow (unsafeChr x1) + loop (ir+2) ow' + | iw - ir >= 2 -> do + ow' <- writeCharBuf oraw ow (unsafeChr x1) + loop (ir+2) ow' + | otherwise -> done InputUnderflow ir ow + + -- lambda-lifted, to avoid thunks being built in the inner-loop: + done why !ir !ow = return (why, + if ir == iw then input{ bufL=0, bufR=0 } + else input{ bufL=ir }, + output{ bufR=ow }) + in + loop ir0 ow0 + + +utf16le_b_encode :: EncodeBuffer +utf16le_b_encode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } + output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + = let + done why !ir !ow = return (why, + if ir == iw then input{ bufL=0, bufR=0 } + else input{ bufL=ir }, + output{ bufR=ow }) + loop !ir !ow + | ir >= iw = done InputUnderflow ir ow + | os - ow < 2 = done OutputUnderflow ir ow + | otherwise = do + (c,ir') <- readCharBuf iraw ir + case ord c of + x | x < 0x10000 -> do + writeWord8Buf oraw ow (fromIntegral x) + writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8)) + loop ir' (ow+2) + | otherwise -> + if os - ow < 4 then done OutputUnderflow ir ow else do + let x' = x - 0x10000 + w1 = x' `div` 0x400 + 0xd800 + w2 = x' `mod` 0x400 + 0xdc00 + writeWord8Buf oraw ow (fromIntegral w1) + writeWord8Buf oraw (ow+1) (fromIntegral (w1 `shiftR` 8)) + writeWord8Buf oraw (ow+2) (fromIntegral w2) + writeWord8Buf oraw (ow+3) (fromIntegral (w2 `shiftR` 8)) + loop ir' (ow+4) + in + loop ir0 ow0 + +-- ----------------------------------------------------------------------------- +-- Windows encoding (ripped off from base) +-- + +cWcharsToChars_UCS2 :: [Word16] -> [Char] +cWcharsToChars_UCS2 = map (chr . fromIntegral) + + +-- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding. + +-- coding errors generate Chars in the surrogate range +cWcharsToChars :: [Word16] -> [Char] +cWcharsToChars = map chr . fromUTF16 . map fromIntegral + where + fromUTF16 :: [Int] -> [Int] + fromUTF16 (c1:c2:wcs) + | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff = + ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs + fromUTF16 (c:wcs) = c : fromUTF16 wcs + fromUTF16 [] = [] + +charsToCWchars :: [Char] -> [Word16] +charsToCWchars = foldr (utf16Char . ord) [] + where + utf16Char :: Int -> [Word16] -> [Word16] + utf16Char c wcs + | c < 0x10000 = fromIntegral c : wcs + | otherwise = let c' = c - 0x10000 in + fromIntegral (c' `div` 0x400 + 0xd800) : + fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs + +-- ----------------------------------------------------------------------------- + +-- ----------------------------------------------------------------------------- +-- FFI +-- + +withFilePathWin :: FilePath -> (Int -> Ptr Word16 -> IO a) -> IO a +withFilePathWin = withArrayLen . charsToCWchars + +peekFilePathWin :: (Ptr Word16, Int) -> IO FilePath +peekFilePathWin (cp, l) = do + cs <- peekArray l cp + return (cWcharsToChars cs) + +withFilePathPosix :: FilePath -> (CStringLen -> IO a) -> IO a +withFilePathPosix fp f = getFileSystemEncoding >>= \enc -> GHC.withCStringLen enc fp f + +peekFilePathPosix :: CStringLen -> IO FilePath +peekFilePathPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp + +-- | Decode with the given 'TextEncoding'. +decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String +decodeWithTE enc ba = unsafePerformIO $ do + r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen enc fp + evaluate $ force $ first (flip EncodingError Nothing . displayException) r + +-- | Encode with the given 'TextEncoding'. +encodeWithTE :: TextEncoding -> String -> Either EncodingException BS8.ShortByteString +encodeWithTE enc str = unsafePerformIO $ do + r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr + evaluate $ force $ first (flip EncodingError Nothing . displayException) r + +-- ----------------------------------------------------------------------------- +-- Encoders / decoders +-- + +-- | This mimics the filepath decoder base uses on unix, +-- with the small distinction that we're not truncating at NUL bytes (because we're not at +-- the outer FFI layer). +decodeWithBasePosix :: BS8.ShortByteString -> IO String +decodeWithBasePosix ba = BS8.useAsCStringLen ba $ \fp -> peekFilePathPosix fp + +-- | This mimics the filepath dencoder base uses on unix, +-- with the small distinction that we're not truncating at NUL bytes (because we're not at +-- the outer FFI layer). +encodeWithBasePosix :: String -> IO BS8.ShortByteString +encodeWithBasePosix str = withFilePathPosix str $ \cstr -> BS8.packCStringLen cstr + +-- | This mimics the filepath decoder base uses on windows, +-- with the small distinction that we're not truncating at NUL bytes (because we're not at +-- the outer FFI layer). +decodeWithBaseWindows :: BS16.ShortByteString -> IO String +decodeWithBaseWindows ba = BS16.useAsCWStringLen ba $ \fp -> peekFilePathWin fp + +-- | This mimics the filepath dencoder base uses on windows, +-- with the small distinction that we're not truncating at NUL bytes (because we're not at +-- the outer FFI layer). +encodeWithBaseWindows :: String -> IO BS16.ShortByteString +encodeWithBaseWindows str = withFilePathWin str $ \l cstr -> BS16.packCWStringLen (cstr, l) + + +-- ----------------------------------------------------------------------------- +-- Types +-- + +data EncodingException = + EncodingError String (Maybe Word8) + -- ^ Could not decode a byte sequence because it was invalid under + -- the given encoding, or ran out of input in mid-decode. + deriving (Eq, Typeable) + + +showEncodingException :: EncodingException -> String +showEncodingException (EncodingError desc (Just w)) + = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc) +showEncodingException (EncodingError desc Nothing) + = "Cannot decode input: " ++ desc + +instance Show EncodingException where + show = showEncodingException + +instance Exception EncodingException + +instance NFData EncodingException where + rnf (EncodingError desc w) = rnf desc `seq` rnf w + + +-- ----------------------------------------------------------------------------- +-- Words +-- + +wNUL :: Word16 +wNUL = 0x00 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,156 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnliftedFFITypes #-} + +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 ) +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +import Language.Haskell.TH.Syntax + ( Lift (..), lift ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) + +import System.OsString.Internal.Types +import System.OsPath.Encoding +import Control.Monad (when) +import System.IO + ( TextEncoding ) + +#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 + + + +-- | 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 a 'EncodingException' if encoding fails. +encodeUtf :: MonadThrow m => FilePath -> m OsPath +encodeUtf = OS.encodeUtf + +-- | Encode a 'FilePath' with the specified encoding. +encodeWith :: TextEncoding -- ^ unix text encoding + -> TextEncoding -- ^ windows text encoding + -> 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 + + + +-- | QuasiQuote an 'OsPath'. This accepts Unicode characters +-- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid' +-- on the input. +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 = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression 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 = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } +#endif + + +-- | 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,27 @@ +{-# LANGUAGE CPP #-} + +#undef WINDOWS +#define POSIX +#define IS_WINDOWS False +#define FILEPATH_NAME PosixPath +#define OSSTRING_NAME PosixString +#define WORD_NAME PosixChar + +#include "Common.hs" + +-- | 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 = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } 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,28 @@ +{-# LANGUAGE CPP #-} + +#undef POSIX +#define IS_WINDOWS True +#define WINDOWS +#define FILEPATH_NAME WindowsPath +#define OSSTRING_NAME WindowsString +#define WORD_NAME WindowsChar + +#include "Common.hs" + + +-- | 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 = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } 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/System/OsString.hs b/System/OsString.hs new file mode 100644 --- /dev/null +++ b/System/OsString.hs @@ -0,0 +1,60 @@ +-- | +-- Module : OsString +-- Copyright : © 2021 Julian Ospald +-- License : MIT +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- An implementation of platform specific short 'OsString', which is: +-- +-- 1. on windows wide char bytes (@[Word16]@) +-- 2. on unix char bytes (@[Word8]@) +-- +-- It captures the notion of syscall specific encoding (or the lack thereof) to avoid roundtrip issues +-- and memory fragmentation by using unpinned byte arrays. Bytes are not touched or interpreted. +module System.OsString + ( + -- * String types + OsString + + -- * OsString construction + , encodeUtf + , encodeWith + , encodeFS + , osstr + , pack + + -- * OsString deconstruction + , decodeUtf + , decodeWith + , decodeFS + , unpack + + -- * Word types + , OsChar + + -- * Word construction + , unsafeFromChar + + -- * Word deconstruction + , toChar + ) +where + +import System.OsString.Internal + ( unsafeFromChar + , toChar + , encodeUtf + , encodeWith + , encodeFS + , osstr + , pack + , decodeUtf + , decodeWith + , decodeFS + , unpack + ) +import System.OsString.Internal.Types + ( OsString, OsChar ) diff --git a/System/OsString/Common.hs b/System/OsString/Common.hs new file mode 100644 --- /dev/null +++ b/System/OsString/Common.hs @@ -0,0 +1,315 @@ +{- HLINT ignore "Unused LANGUAGE pragma" -} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PatternSynonyms #-} +-- This template expects CPP definitions for: +-- MODULE_NAME = Posix | Windows +-- IS_WINDOWS = False | True +-- +#if defined(WINDOWS) +#define WINDOWS_DOC +#else +#define POSIX_DOC +#endif + +module System.OsString.MODULE_NAME + ( + -- * Types +#ifdef WINDOWS + WindowsString + , WindowsChar +#else + PosixString + , PosixChar +#endif + + -- * String construction + , encodeUtf + , encodeWith + , encodeFS + , fromBytes + , pstr + , pack + + -- * String deconstruction + , decodeUtf + , decodeWith + , decodeFS + , unpack + + -- * Word construction + , unsafeFromChar + + -- * Word deconstruction + , toChar + ) +where + + + +import System.OsString.Internal.Types ( +#ifdef WINDOWS + WindowsString(..), WindowsChar(..) +#else + PosixString(..), PosixChar(..) +#endif + ) + +import Data.Char +import Control.Monad.Catch + ( MonadThrow, throwM ) +import Data.ByteString.Internal + ( ByteString ) +import Control.Exception + ( SomeException, try, displayException ) +import Control.DeepSeq ( force ) +import Data.Bifunctor ( first ) +import GHC.IO + ( evaluate, unsafePerformIO ) +import qualified GHC.Foreign as GHC +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +import Language.Haskell.TH.Syntax + ( Lift (..), lift ) + + +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +#ifdef WINDOWS +import System.OsPath.Encoding +import System.IO + ( TextEncoding, utf16le ) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16 +import qualified System.OsPath.Data.ByteString.Short as BS8 +#else +import System.OsPath.Encoding +import System.IO + ( TextEncoding, utf8 ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import qualified System.OsPath.Data.ByteString.Short as BS +#endif + + + +#ifdef WINDOWS_DOC +-- | Partial unicode friendly encoding. +-- +-- This encodes as UTF16-LE (strictly), which is a pretty good guess. +-- +-- Throws an 'EncodingException' if encoding fails. +#else +-- | Partial unicode friendly encoding. +-- +-- This encodes as UTF8 (strictly), which is a good guess. +-- +-- Throws an 'EncodingException' if encoding fails. +#endif +encodeUtf :: MonadThrow m => String -> m PLATFORM_STRING +#ifdef WINDOWS +encodeUtf = either throwM pure . encodeWith utf16le +#else +encodeUtf = either throwM pure . encodeWith utf8 +#endif + +-- | Encode a 'String' with the specified encoding. +encodeWith :: TextEncoding + -> String + -> Either EncodingException PLATFORM_STRING +encodeWith enc str = unsafePerformIO $ do +#ifdef WINDOWS + r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> WindowsString <$> BS8.packCStringLen cstr + evaluate $ force $ first (flip EncodingError Nothing . displayException) r +#else + r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BS.packCStringLen cstr + evaluate $ force $ first (flip EncodingError Nothing . displayException) r +#endif + +#ifdef WINDOWS_DOC +-- | This mimics the behavior of the base library when doing filesystem +-- operations, which does permissive UTF-16 encoding, where coding errors generate +-- Chars in the surrogate range. +-- +-- The reason this is in IO is because it unifies with the Posix counterpart, +-- which does require IO. This is safe to 'unsafePerformIO'/'unsafeDupablePerformIO'. +#else +-- | This mimics the behavior of the base library when doing filesystem +-- operations, which uses shady PEP 383 style encoding (based on the current locale, +-- but PEP 383 only works properly on UTF-8 encodings, so good luck). +-- +-- 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). +#endif +encodeFS :: String -> IO PLATFORM_STRING +#ifdef WINDOWS +encodeFS = fmap WindowsString . encodeWithBaseWindows +#else +encodeFS = fmap PosixString . encodeWithBasePosix +#endif + + +#ifdef WINDOWS_DOC +-- | Partial unicode friendly decoding. +-- +-- This decodes as UTF16-LE (strictly), which is a pretty good. +-- +-- Throws a 'EncodingException' if decoding fails. +#else +-- | Partial unicode friendly decoding. +-- +-- This decodes as UTF8 (strictly), which is a good guess. Note that +-- filenames on unix are encoding agnostic char arrays. +-- +-- Throws a 'EncodingException' if decoding fails. +#endif +decodeUtf :: MonadThrow m => PLATFORM_STRING -> m String +#ifdef WINDOWS +decodeUtf = either throwM pure . decodeWith utf16le +#else +decodeUtf = either throwM pure . decodeWith utf8 +#endif + +#ifdef WINDOWS +-- | Decode a 'WindowsString' with the specified encoding. +-- +-- The String is forced into memory to catch all exceptions. +decodeWith :: TextEncoding + -> PLATFORM_STRING + -> Either EncodingException String +decodeWith winEnc (WindowsString ba) = unsafePerformIO $ do + r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen winEnc fp + evaluate $ force $ first (flip EncodingError Nothing . displayException) r +#else +-- | Decode a 'PosixString' with the specified encoding. +-- +-- The String is forced into memory to catch all exceptions. +decodeWith :: TextEncoding + -> PLATFORM_STRING + -> Either EncodingException String +decodeWith unixEnc (PosixString ba) = unsafePerformIO $ do + r <- try @SomeException $ BS.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp + evaluate $ force $ first (flip EncodingError Nothing . displayException) r +#endif + + +#ifdef WINDOWS_DOC +-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem +-- operations, which does permissive UTF-16 encoding, where coding errors generate +-- Chars in the surrogate range. +-- +-- The reason this is in IO is because it unifies with the Posix counterpart, +-- which does require IO. 'unsafePerformIO'/'unsafeDupablePerformIO' are safe, however. +#else +-- | This mimics the behavior of the base library when doing filesystem +-- operations, which uses shady PEP 383 style encoding (based on the current locale, +-- but PEP 383 only works properly on UTF-8 encodings, so good luck). +-- +-- 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). +#endif +decodeFS :: PLATFORM_STRING -> IO String +#ifdef WINDOWS +decodeFS (WindowsString ba) = decodeWithBaseWindows ba +#else +decodeFS (PosixString ba) = decodeWithBasePosix ba +#endif + + +#ifdef WINDOWS_DOC +-- | Constructs a platform string from a ByteString. +-- +-- This ensures valid UCS-2LE. +-- Note that this doesn't expand Word8 to Word16 on windows, so you may get invalid UTF-16. +-- +-- Throws 'EncodingException' on invalid UCS-2LE (although unlikely). +#else +-- | Constructs a platform string from a ByteString. +-- +-- This is a no-op. +#endif +fromBytes :: MonadThrow m + => ByteString + -> m PLATFORM_STRING +#ifdef WINDOWS +fromBytes bs = + let ws = WindowsString . BS16.toShort $ bs + in either throwM (const . pure $ ws) $ decodeWith ucs2le ws +#else +fromBytes = pure . PosixString . BS.toShort +#endif + + +#ifdef WINDOWS_DOC +-- | QuasiQuote a 'WindowsString'. This accepts Unicode characters +-- and encodes as UTF-16LE on windows. +#else +-- | QuasiQuote a 'PosixString'. This accepts Unicode characters +-- and encodes as UTF-8 on unix. +#endif +pstr :: QuasiQuoter +pstr = + QuasiQuoter +#ifdef WINDOWS + { quoteExp = \s -> do + ps <- either (fail . show) pure $ encodeWith (mkUTF16le ErrorOnCodingFailure) s + lift ps + , quotePat = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } +#else + { quoteExp = \s -> do + ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) s + lift ps + , quotePat = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } +#endif + + +-- | Unpack a platform string to a list of platform words. +unpack :: PLATFORM_STRING -> [PLATFORM_WORD] +#ifdef WINDOWS +unpack (WindowsString ba) = WindowsChar <$> BS16.unpack ba +#else +unpack (PosixString ba) = PosixChar <$> BS.unpack ba +#endif + + +-- | Pack a list of platform words to a platform string. +-- +-- Note that using this in conjunction with 'unsafeFromChar' to +-- convert from @[Char]@ to platform string is probably not what +-- you want, because it will truncate unicode code points. +pack :: [PLATFORM_WORD] -> PLATFORM_STRING +#ifdef WINDOWS +pack = WindowsString . BS16.pack . fmap (\(WindowsChar w) -> w) +#else +pack = PosixString . BS.pack . fmap (\(PosixChar w) -> w) +#endif + + +#ifdef WINDOWS +-- | Truncates to 2 octets. +unsafeFromChar :: Char -> PLATFORM_WORD +unsafeFromChar = WindowsChar . fromIntegral . fromEnum +#else +-- | Truncates to 1 octet. +unsafeFromChar :: Char -> PLATFORM_WORD +unsafeFromChar = PosixChar . fromIntegral . fromEnum +#endif + +-- | Converts back to a unicode codepoint (total). +toChar :: PLATFORM_WORD -> Char +#ifdef WINDOWS +toChar (WindowsChar w) = chr $ fromIntegral w +#else +toChar (PosixChar w) = chr $ fromIntegral w +#endif diff --git a/System/OsString/Internal.hs b/System/OsString/Internal.hs new file mode 100644 --- /dev/null +++ b/System/OsString/Internal.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module System.OsString.Internal where + +import System.OsString.Internal.Types + +import Control.Monad.Catch + ( MonadThrow ) +import Data.ByteString + ( ByteString ) +import Data.Char +import Language.Haskell.TH.Quote + ( QuasiQuoter (..) ) +import Language.Haskell.TH.Syntax + ( Lift (..), lift ) +import System.IO + ( TextEncoding ) + +import System.OsPath.Encoding ( EncodingException(..) ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import qualified System.OsString.Windows as PF +#else +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import qualified System.OsString.Posix as PF +#endif + + + + +-- | 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 a 'EncodingException' if encoding fails. +encodeUtf :: MonadThrow m => String -> m OsString +encodeUtf = fmap OsString . PF.encodeUtf + +-- | Encode an 'OsString' given the platform specific encodings. +encodeWith :: TextEncoding -- ^ unix text encoding + -> TextEncoding -- ^ windows text encoding + -> String + -> Either EncodingException OsString +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +encodeWith _ winEnc str = OsString <$> PF.encodeWith winEnc str +#else +encodeWith unixEnc _ str = OsString <$> PF.encodeWith unixEnc str +#endif + +-- | 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 :: String -> IO OsString +encodeFS = fmap OsString . PF.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. Note that +-- filenames on unix are encoding agnostic char arrays. +-- +-- Throws a 'EncodingException' if decoding fails. +decodeUtf :: MonadThrow m => OsString -> m String +decodeUtf (OsString x) = PF.decodeUtf x + +-- | Decode an 'OsString' with the specified encoding. +-- +-- The String is forced into memory to catch all exceptions. +decodeWith :: TextEncoding -- ^ unix text encoding + -> TextEncoding -- ^ windows text encoding + -> OsString + -> Either EncodingException String +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +decodeWith _ winEnc (OsString x) = PF.decodeWith winEnc x +#else +decodeWith unixEnc _ (OsString x) = PF.decodeWith unixEnc x +#endif + + +-- | 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 :: OsString -> IO String +decodeFS (OsString x) = PF.decodeFS x + + +-- | Constructs an @OsString@ 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 OsString +fromBytes = fmap OsString . PF.fromBytes + + +-- | QuasiQuote an 'OsString'. This accepts Unicode characters +-- and encodes as UTF-8 on unix and UTF-16 on windows. +osstr :: QuasiQuoter +osstr = + QuasiQuoter +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + { quoteExp = \s -> do + osp <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s + lift osp + , quotePat = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } +#else + { quoteExp = \s -> do + osp <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s + lift osp + , quotePat = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } +#endif + + +-- | Unpack an 'OsString' to a list of 'OsChar'. +unpack :: OsString -> [OsChar] +unpack (OsString x) = OsChar <$> PF.unpack x + + +-- | Pack a list of 'OsChar' to an 'OsString' +-- +-- Note that using this in conjunction with 'unsafeFromChar' to +-- convert from @[Char]@ to 'OsString' is probably not what +-- you want, because it will truncate unicode code points. +pack :: [OsChar] -> OsString +pack = OsString . PF.pack . fmap (\(OsChar x) -> x) + + +-- | Truncates on unix to 1 and on Windows to 2 octets. +unsafeFromChar :: Char -> OsChar +unsafeFromChar = OsChar . PF.unsafeFromChar + +-- | Converts back to a unicode codepoint (total). +toChar :: OsChar -> Char +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +toChar (OsChar (WindowsChar w)) = chr $ fromIntegral w +#else +toChar (OsChar (PosixChar w)) = chr $ fromIntegral w +#endif + diff --git a/System/OsString/Internal/Types.hs b/System/OsString/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/System/OsString/Internal/Types.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PatternSynonyms #-} + +module System.OsString.Internal.Types + ( + WindowsString(..) + , pattern WS + , unWS + , PosixString(..) + , unPS + , pattern PS + , PlatformString + , WindowsChar(..) + , unWW + , pattern WW + , PosixChar(..) + , unPW + , pattern PW + , PlatformChar + , OsString(..) + , OsChar(..) + ) +where + + +import Control.DeepSeq +import Data.Data +import Data.Word +import Language.Haskell.TH.Syntax + ( Lift (..), lift ) +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif +import GHC.Generics (Generic) + +import System.OsPath.Encoding.Internal +import qualified System.OsPath.Data.ByteString.Short as BS +import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16 +#if MIN_VERSION_template_haskell(2,16,0) +import qualified Language.Haskell.TH.Syntax as TH +#endif + +-- Using unpinned bytearrays to avoid Heap fragmentation and +-- which are reasonably cheap to pass to FFI calls +-- wrapped with typeclass-friendly types allowing to avoid CPP +-- +-- Note that, while unpinned bytearrays incur a memcpy on each +-- FFI call, this overhead is generally much preferable to +-- the memory fragmentation of pinned bytearrays + +-- | Commonly used windows string as wide character bytes. +newtype WindowsString = WindowsString { getWindowsString :: BS.ShortByteString } + deriving (Eq, Ord, Semigroup, Monoid, Typeable, Generic, NFData) + +-- | Decodes as UCS-2. +instance Show WindowsString where + -- cWcharsToChars_UCS2 is total + show = show . cWcharsToChars_UCS2 . BS16.unpack . getWindowsString + +-- | Just a short bidirectional synonym for 'WindowsString' constructor. +pattern WS :: BS.ShortByteString -> WindowsString +pattern WS { unWS } <- WindowsString unWS where + WS a = WindowsString a +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE WS #-} +#endif + + +instance Lift WindowsString where + lift (WindowsString bs) + = [| WindowsString (BS.pack $(lift $ BS.unpack bs)) :: WindowsString |] +#if MIN_VERSION_template_haskell(2,17,0) + liftTyped = TH.unsafeCodeCoerce . TH.lift +#elif MIN_VERSION_template_haskell(2,16,0) + liftTyped = TH.unsafeTExpCoerce . TH.lift +#endif + +-- | Commonly used Posix string as uninterpreted @char[]@ +-- array. +newtype PosixString = PosixString { getPosixString :: BS.ShortByteString } + deriving (Eq, Ord, Semigroup, Monoid, Typeable, Generic, NFData) + +-- | Prints the raw bytes without decoding. +instance Show PosixString where + show (PosixString ps) = show ps + +-- | Just a short bidirectional synonym for 'PosixString' constructor. +pattern PS :: BS.ShortByteString -> PosixString +pattern PS { unPS } <- PosixString unPS where + PS a = PosixString a +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE PS #-} +#endif + +instance Lift PosixString where + lift (PosixString bs) + = [| PosixString (BS.pack $(lift $ BS.unpack bs)) :: PosixString |] +#if MIN_VERSION_template_haskell(2,17,0) + liftTyped = TH.unsafeCodeCoerce . TH.lift +#elif MIN_VERSION_template_haskell(2,16,0) + liftTyped = TH.unsafeTExpCoerce . TH.lift +#endif + + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +type PlatformString = WindowsString +#else +type PlatformString = PosixString +#endif + +newtype WindowsChar = WindowsChar { getWindowsChar :: Word16 } + deriving (Eq, Ord, Typeable, Generic, NFData) + +instance Show WindowsChar where + show (WindowsChar wc) = show wc + +newtype PosixChar = PosixChar { getPosixChar :: Word8 } + deriving (Eq, Ord, Typeable, Generic, NFData) + +instance Show PosixChar where + show (PosixChar pc) = show pc + +-- | Just a short bidirectional synonym for 'WindowsChar' constructor. +pattern WW :: Word16 -> WindowsChar +pattern WW { unWW } <- WindowsChar unWW where + WW a = WindowsChar a +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE WW #-} +#endif + +-- | Just a short bidirectional synonym for 'PosixChar' constructor. +pattern PW :: Word8 -> PosixChar +pattern PW { unPW } <- PosixChar unPW where + PW a = PosixChar a +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE PW #-} +#endif + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +type PlatformChar = WindowsChar +#else +type PlatformChar = PosixChar +#endif + + +-- | Newtype representing short operating system specific strings. +-- +-- Internally this is either 'WindowsString' or 'PosixString', +-- depending on the platform. Both use unpinned +-- 'ShortByteString' for efficiency. +-- +-- The constructor is only exported via "System.OsString.Internal.Types", since +-- dealing with the internals isn't generally recommended, but supported +-- in case you need to write platform specific code. +newtype OsString = OsString { getOsString :: PlatformString } + deriving (Typeable, Generic, NFData) + +-- | On windows, decodes as UCS-2. On unix prints the raw bytes without decoding. +instance Show OsString where + show (OsString os) = show os + +-- | Byte equality of the internal representation. +instance Eq OsString where + (OsString a) == (OsString b) = a == b + +-- | Byte ordering of the internal representation. +instance Ord OsString where + compare (OsString a) (OsString b) = compare a b + + +-- | \"String-Concatenation\" for 'OsString'. This is __not__ the same +-- as '()'. +instance Monoid OsString where +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + mempty = OsString (WindowsString BS.empty) +#if MIN_VERSION_base(4,16,0) + mappend = (<>) +#else + mappend (OsString (WindowsString a)) (OsString (WindowsString b)) + = OsString (WindowsString (mappend a b)) +#endif +#else + mempty = OsString (PosixString BS.empty) +#if MIN_VERSION_base(4,16,0) + mappend = (<>) +#else + mappend (OsString (PosixString a)) (OsString (PosixString b)) + = OsString (PosixString (mappend a b)) +#endif +#endif +#if MIN_VERSION_base(4,11,0) +instance Semigroup OsString where +#if MIN_VERSION_base(4,16,0) +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + (<>) (OsString (WindowsString a)) (OsString (WindowsString b)) + = OsString (WindowsString (mappend a b)) +#else + (<>) (OsString (PosixString a)) (OsString (PosixString b)) + = OsString (PosixString (mappend a b)) +#endif +#else + (<>) = mappend +#endif +#endif + + +instance Lift OsString where +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + lift (OsString (WindowsString bs)) + = [| OsString (WindowsString (BS.pack $(lift $ BS.unpack bs))) :: OsString |] +#else + lift (OsString (PosixString bs)) + = [| OsString (PosixString (BS.pack $(lift $ BS.unpack bs))) :: OsString |] +#endif +#if MIN_VERSION_template_haskell(2,17,0) + liftTyped = TH.unsafeCodeCoerce . TH.lift +#elif MIN_VERSION_template_haskell(2,16,0) + liftTyped = TH.unsafeTExpCoerce . TH.lift +#endif + + +-- | Newtype representing a code unit. +-- +-- On Windows, this is restricted to two-octet codepoints 'Word16', +-- on POSIX one-octet ('Word8'). +newtype OsChar = OsChar { getOsChar :: PlatformChar } + deriving (Typeable, Generic, NFData) + +instance Show OsChar where + show (OsChar pc) = show pc + +-- | Byte equality of the internal representation. +instance Eq OsChar where + (OsChar a) == (OsChar b) = a == b + +-- | Byte ordering of the internal representation. +instance Ord OsChar where + compare (OsChar a) (OsChar b) = compare a b + diff --git a/System/OsString/Posix.hs b/System/OsString/Posix.hs new file mode 100644 --- /dev/null +++ b/System/OsString/Posix.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +#undef WINDOWS +#define MODULE_NAME Posix +#define PLATFORM_STRING PosixString +#define PLATFORM_WORD PosixChar +#define IS_WINDOWS False +#include "Common.hs" diff --git a/System/OsString/Windows.hs b/System/OsString/Windows.hs new file mode 100644 --- /dev/null +++ b/System/OsString/Windows.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE CPP #-} +#undef POSIX +#define MODULE_NAME Windows +#define PLATFORM_STRING WindowsString +#define PLATFORM_WORD WindowsChar +#define IS_WINDOWS True +#define WINDOWS +#include "Common.hs" +#undef MODULE_NAME +#undef FILEPATH_NAME +#undef OSSTRING_NAME +#undef IS_WINDOWS +#undef WINDOWS diff --git a/bench/BenchFilePath.hs b/bench/BenchFilePath.hs new file mode 100644 --- /dev/null +++ b/bench/BenchFilePath.hs @@ -0,0 +1,311 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuasiQuotes #-} + +module Main where + +import System.OsPath.Types +import System.OsPath.Encoding ( ucs2le ) +import System.Environment +import qualified System.OsString.Internal.Types as OST +import qualified Data.ByteString.Short as SBS + +import TastyBench +import Data.List +import Data.Maybe +import GHC.IO.Encoding + +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 + + +data Config = Config { + format :: Format + , stdev :: Double + , timeout :: Integer + } + +data Format = Print + | CSV + deriving (Read, Show) + +defaultConfig :: Config +defaultConfig = Config defaultFormat defaultStdev defaultTimeout + +defaultFormat :: Format +defaultFormat = Print + +defaultStdev :: Double +defaultStdev = 0.02 + +defaultTimeout :: Integer +defaultTimeout = 800000 + +parseConfig :: [String] -> Config +parseConfig [] = defaultConfig +parseConfig xs = + let format' = maybe defaultFormat (read . fromJust . stripPrefix "--format=" ) $ find ("--format=" `isPrefixOf`) xs + stdev' = maybe defaultStdev (read . fromJust . stripPrefix "--stdev=" ) $ find ("--stdev=" `isPrefixOf`) xs + timeout' = maybe defaultTimeout (read . fromJust . stripPrefix "--timeout=") $ find ("--timeout=" `isPrefixOf`) xs + in Config format' stdev' timeout' + + +main :: IO () +main = do + setLocaleEncoding utf8 + args <- getArgs + let config = parseConfig args + benchGroup config + [ ("filepath (string)", + [("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) + ] + ) + + , ("filepath (AFPP)", + [ ("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) + ] + ) + + , ("encoding/decoding", + [ ("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|] + + +benchGroup :: Config -> [(String, [(String, Benchmarkable)])] -> IO () +benchGroup _ [] = pure () +benchGroup format ((name, benchs):xs) = do + putStrLn name + bench format benchs + benchGroup format xs + +bench :: Config -> [(String, Benchmarkable)] -> IO () +bench _ [] = pure () +bench config@Config{..} (x:xs) = do + let (name, benchmarkable) = x + case format of + CSV -> putStr (name ++ ",") + Print -> putStr (" " ++ name ++ ": ") + est <- measureUntil CpuTime False (Timeout timeout "") (RelStDev stdev) benchmarkable + case format of + CSV -> putStr $ csvEstimate est + Print -> putStr $ "\n " ++ prettyEstimate est + putStr "\n" + bench config xs + diff --git a/bench/TastyBench.hs b/bench/TastyBench.hs new file mode 100644 --- /dev/null +++ b/bench/TastyBench.hs @@ -0,0 +1,526 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module TastyBench where + +import Prelude hiding (Int, Integer) +import qualified Prelude +import Control.DeepSeq (NFData, force) +import Control.Exception (evaluate) +import Data.Data (Typeable) +import Data.Word (Word64) +#if !MIN_VERSION_base(4,10,0) +import Data.Int ( Int64 ) +#endif +#if MIN_VERSION_base(4,6,0) +import GHC.Stats +#endif +import System.CPUTime +import System.IO +import System.IO.Unsafe +import System.Mem +import Text.Printf (printf) + + +data Timeout + = Timeout + Prelude.Integer -- ^ number of microseconds (e. g., 200000) + String -- ^ textual representation (e. g., @"0.2s"@) + | NoTimeout + deriving (Show) + + +-- | In addition to @--stdev@ command-line option, +-- one can adjust target relative standard deviation +-- for individual benchmarks and groups of benchmarks +-- using 'adjustOption' and 'localOption'. +-- +-- E. g., set target relative standard deviation to 2% as follows: +-- +-- > import Test.Tasty (localOption) +-- > localOption (RelStDev 0.02) (bgroup [...]) +-- +-- If you set 'RelStDev' to infinity, +-- a benchmark will be executed +-- only once and its standard deviation will be recorded as zero. +-- This is rather a blunt approach, but it might be a necessary evil +-- for extremely long benchmarks. If you wish to run all benchmarks +-- only once, use command-line option @--stdev@ @Infinity@. +-- +-- @since 0.2 +newtype RelStDev = RelStDev Double + deriving (Show, Read, Typeable) + +-- | Whether to measure CPU time or wall-clock time. +-- Normally 'CpuTime' is a better option (and default), +-- but consider switching to 'WallTime' +-- to measure multithreaded algorithms or time spent in external processes. +-- +-- One can switch the default measurement mode globally +-- using @--time-mode@ command-line option, +-- but it is usually better to adjust the mode locally: +-- +-- > import Test.Tasty (localOption) +-- > localOption WallTime (bgroup [...]) +-- +-- @since 0.3.2 +data TimeMode = CpuTime + -- ^ Measure CPU time. + deriving (Typeable) + +-- | Something that can be benchmarked, produced by 'nf', 'whnf', 'nfIO', 'whnfIO', +-- 'nfAppIO', 'whnfAppIO' below. +-- +-- Drop-in replacement for @Criterion.@'Criterion.Benchmarkable' and +-- @Gauge.@'Gauge.Benchmarkable'. +-- +-- @since 0.1 +newtype Benchmarkable = + -- | @since 0.3 + Benchmarkable + { unBenchmarkable :: Word64 -> IO () -- ^ Run benchmark given number of times. + } deriving (Typeable) + + +data Measurement = Measurement + { measTime :: !Word64 -- ^ time in picoseconds + , measAllocs :: !Word64 -- ^ allocations in bytes + , measCopied :: !Word64 -- ^ copied bytes + , measMaxMem :: !Word64 -- ^ max memory in use + } deriving (Show, Read) + +data Estimate = Estimate + { estMean :: !Measurement + , estStdev :: !Word64 -- ^ stdev in picoseconds + } deriving (Show, Read) + + +predict + :: Measurement -- ^ time for one run + -> Measurement -- ^ time for two runs + -> Estimate +predict (Measurement t1 a1 c1 m1) (Measurement t2 a2 c2 m2) = Estimate + { estMean = Measurement t (fit a1 a2) (fit c1 c2) (max m1 m2) + , estStdev = truncate (sqrt d :: Double) + } + where + fit x1 x2 = x1 `quot` 5 + 2 * (x2 `quot` 5) + t = fit t1 t2 + sqr x = x * x + d = sqr (word64ToDouble t1 - word64ToDouble t) + + sqr (word64ToDouble t2 - 2 * word64ToDouble t) + +predictPerturbed :: Measurement -> Measurement -> Estimate +predictPerturbed t1 t2 = Estimate + { estMean = estMean (predict t1 t2) + , estStdev = max + (estStdev (predict (lo t1) (hi t2))) + (estStdev (predict (hi t1) (lo t2))) + } + where + prec = max (fromInteger cpuTimePrecision) 1000000000 -- 1 ms + hi meas = meas { measTime = measTime meas + prec } + lo meas = meas { measTime = measTime meas - prec } + +hasGCStats :: Bool +#if MIN_VERSION_base(4,10,0) +hasGCStats = unsafePerformIO getRTSStatsEnabled +#elif MIN_VERSION_base(4,6,0) +hasGCStats = unsafePerformIO getGCStatsEnabled +#else +hasGCStats = False +#endif + +getAllocsAndCopied :: IO (Word64, Word64, Word64) +getAllocsAndCopied = do + if not hasGCStats then pure (0, 0, 0) else +#if MIN_VERSION_base(4,10,0) + (\s -> (allocated_bytes s, copied_bytes s, max_mem_in_use_bytes s)) <$> getRTSStats +#elif MIN_VERSION_base(4,6,0) + (\s -> (int64ToWord64 $ bytesAllocated s, int64ToWord64 $ bytesCopied s, int64ToWord64 $ peakMegabytesAllocated s * 1024 * 1024)) <$> getGCStats +#else + pure (0, 0, 0) +#endif + +getTimePicoSecs :: TimeMode -> IO Word64 +getTimePicoSecs timeMode = case timeMode of + CpuTime -> fromInteger <$> getCPUTime + +measure :: TimeMode -> Word64 -> Benchmarkable -> IO Measurement +measure timeMode n (Benchmarkable act) = do + let getTimePicoSecs' = getTimePicoSecs timeMode + performGC + startTime <- getTimePicoSecs' + (startAllocs, startCopied, startMaxMemInUse) <- getAllocsAndCopied + act n + endTime <- getTimePicoSecs' + (endAllocs, endCopied, endMaxMemInUse) <- getAllocsAndCopied + let meas = Measurement + { measTime = endTime - startTime + , measAllocs = endAllocs - startAllocs + , measCopied = endCopied - startCopied + , measMaxMem = max endMaxMemInUse startMaxMemInUse + } + pure meas + +measureUntil :: TimeMode -> Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate +measureUntil timeMode _ _ (RelStDev targetRelStDev) b + | isInfinite targetRelStDev, targetRelStDev > 0 = do + t1 <- measure timeMode 1 b + pure $ Estimate { estMean = t1, estStdev = 0 } +measureUntil timeMode warnIfNoTimeout timeout (RelStDev targetRelStDev) b = do + t1 <- measure' 1 b + go 1 t1 0 + where + measure' = measure timeMode + + go :: Word64 -> Measurement -> Word64 -> IO Estimate + go n t1 sumOfTs = do + t2 <- measure' (2 * n) b + + let Estimate (Measurement meanN allocN copiedN maxMemN) stdevN = predictPerturbed t1 t2 + isTimeoutSoon = case timeout of + NoTimeout -> False + -- multiplying by 12/10 helps to avoid accidental timeouts + Timeout micros _ -> (sumOfTs' + 3 * measTime t2) `quot` (1000000 * 10 `quot` 12) >= fromInteger micros + isStDevInTargetRange = stdevN < truncate (max 0 targetRelStDev * word64ToDouble meanN) + scale = (`quot` n) + sumOfTs' = sumOfTs + measTime t1 + + case timeout of + NoTimeout | warnIfNoTimeout, sumOfTs' + measTime t2 > 100 * 1000000000000 + -> hPutStrLn stderr "This benchmark takes more than 100 seconds. Consider setting --timeout, if this is unexpected (or to silence this warning)." + _ -> pure () + + if isStDevInTargetRange || isTimeoutSoon + then pure $ Estimate + { estMean = Measurement (scale meanN) (scale allocN) (scale copiedN) maxMemN + , estStdev = scale stdevN } + else go (2 * n) t2 sumOfTs' + +-- | An internal routine to measure CPU execution time in seconds +-- for a given timeout (put 'NoTimeout', or 'mkTimeout' 100000000 for 100 seconds) +-- and a target relative standard deviation +-- (put 'RelStDev' 0.05 for 5% or 'RelStDev' (1/0) to run only one iteration). +-- +-- 'Timeout' takes soft priority over 'RelStDev': this function prefers +-- to finish in time even if at cost of precision. However, timeout is guidance +-- not guarantee: 'measureCpuTime' can take longer, if there is not enough time +-- to run at least thrice or an iteration takes unusually long. +-- +-- @since 0.3 +measureCpuTime :: Timeout -> RelStDev -> Benchmarkable -> IO Double +measureCpuTime + = ((fmap ((/ 1e12) . word64ToDouble . measTime . estMean) .) .) + . measureUntil CpuTime False + + + +funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable +funcToBench frc = (Benchmarkable .) . benchLoop + where + -- Here we rely on the fact that GHC (unless spurred by + -- -fstatic-argument-transformation) is not smart enough: + -- it does not notice that `f` and `x` arguments are loop invariant + -- and could be floated, and the whole `f x` expression shared. + -- If we create a closure with `f` and `x` bound in the environment, + -- then GHC is smart enough to share computation of `f x`. + -- + -- For perspective, gauge and criterion < 1.4 mark similar functions as INLINE, + -- while criterion >= 1.4 switches to NOINLINE. + -- If we mark `benchLoop` NOINLINE then benchmark results are slightly larger + -- (noticeable in bench-fibo), because the loop body is slightly bigger, + -- since GHC does not unbox numbers or inline `Eq @Word64` dictionary. + -- + -- This function is called `benchLoop` instead of, say, `go`, + -- so it is easier to spot in Core dumps. + benchLoop f x n + | n == 0 = pure () + | otherwise = do + _ <- evaluate (frc (f x)) + benchLoop f x (n - 1) +{-# INLINE funcToBench #-} + +-- | 'nf' @f@ @x@ measures time to compute +-- a normal form (by means of 'force') of an application of @f@ to @x@. +-- This does not include time to evaluate @f@ or @x@ themselves. +-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. +-- +-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate +-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may +-- be an infinite structure. Thus @x@ will be evaluated in course of the first +-- application of @f@. This noisy measurement is to be discarded soon, +-- but if @x@ is not a primitive data type, consider forcing its evaluation +-- separately, e. g., via 'env' or 'withResource'. +-- +-- Here is a textbook anti-pattern: 'nf' 'sum' @[1..1000000]@. +-- Since an input list is shared by multiple invocations of 'sum', +-- it will be allocated in memory in full, putting immense pressure +-- on garbage collector. Also no list fusion will happen. +-- A better approach is 'nf' (@\\n@ @->@ 'sum' @[1..n]@) @1000000@. +-- +-- If you are measuring an inlinable function, +-- it is prudent to ensure that its invocation is fully saturated, +-- otherwise inlining will not happen. That's why one can often +-- see 'nf' (@\\n@ @->@ @f@ @n@) @x@ instead of 'nf' @f@ @x@. +-- Same applies to rewrite rules. +-- +-- While @tasty-bench@ is capable to perform micro- and even nanobenchmarks, +-- such measurements are noisy and involve an overhead. Results are more reliable +-- when @f@ @x@ takes at least several milliseconds. +-- +-- Note that forcing a normal form requires an additional +-- traverse of the structure. In certain scenarios (imagine benchmarking 'tail'), +-- especially when 'NFData' instance is badly written, +-- this traversal may take non-negligible time and affect results. +-- +-- Drop-in replacement for @Criterion.@'Criterion.nf' and +-- @Gauge.@'Gauge.nf'. +-- +-- @since 0.1 +nf :: NFData b => (a -> b) -> a -> Benchmarkable +nf = funcToBench force +{-# INLINE nf #-} + +-- | 'whnf' @f@ @x@ measures time to compute +-- a weak head normal form of an application of @f@ to @x@. +-- This does not include time to evaluate @f@ or @x@ themselves. +-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. +-- +-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate +-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may +-- be an infinite structure. Thus @x@ will be evaluated in course of the first +-- application of @f@. This noisy measurement is to be discarded soon, +-- but if @x@ is not a primitive data type, consider forcing its evaluation +-- separately, e. g., via 'env' or 'withResource'. +-- +-- Computing only a weak head normal form is +-- rarely what intuitively is meant by "evaluation". +-- Beware that many educational materials contain examples with 'whnf': +-- this is a wrong default. +-- Unless you understand precisely, what is measured, +-- it is recommended to use 'nf' instead. +-- +-- Here is a textbook anti-pattern: 'whnf' ('Data.List.replicate' @1000000@) @1@. +-- This will succeed in a matter of nanoseconds, because weak head +-- normal form forces only the first element of the list. +-- +-- Drop-in replacement for @Criterion.@'Criterion.whnf' and @Gauge.@'Gauge.whnf'. +-- +-- @since 0.1 +whnf :: (a -> b) -> a -> Benchmarkable +whnf = funcToBench id +{-# INLINE whnf #-} + +ioToBench :: (b -> c) -> IO b -> Benchmarkable +ioToBench frc act = Benchmarkable go + where + go n + | n == 0 = pure () + | otherwise = do + val <- act + _ <- evaluate (frc val) + go (n - 1) +{-# INLINE ioToBench #-} + +-- | 'nfIO' @x@ measures time to evaluate side-effects of @x@ +-- and compute its normal form (by means of 'force'). +-- +-- Pure subexpression of an effectful computation @x@ +-- may be evaluated only once and get cached. +-- To avoid surprising results it is usually preferable +-- to use 'nfAppIO' instead. +-- +-- Note that forcing a normal form requires an additional +-- traverse of the structure. In certain scenarios, +-- especially when 'NFData' instance is badly written, +-- this traversal may take non-negligible time and affect results. +-- +-- A typical use case is 'nfIO' ('readFile' @"foo.txt"@). +-- However, if your goal is not to benchmark I\/O per se, +-- but just read input data from a file, it is cleaner to +-- use 'env' or 'withResource'. +-- +-- Drop-in replacement for @Criterion.@'Criterion.nfIO' and @Gauge.@'Gauge.nfIO'. +-- +-- @since 0.1 +nfIO :: NFData a => IO a -> Benchmarkable +nfIO = ioToBench force +{-# INLINE nfIO #-} + +-- | 'whnfIO' @x@ measures time to evaluate side-effects of @x@ +-- and compute its weak head normal form. +-- +-- Pure subexpression of an effectful computation @x@ +-- may be evaluated only once and get cached. +-- To avoid surprising results it is usually preferable +-- to use 'whnfAppIO' instead. +-- +-- Computing only a weak head normal form is +-- rarely what intuitively is meant by "evaluation". +-- Unless you understand precisely, what is measured, +-- it is recommended to use 'nfIO' instead. +-- +-- Lazy I\/O is treacherous. +-- If your goal is not to benchmark I\/O per se, +-- but just read input data from a file, it is cleaner to +-- use 'env' or 'withResource'. +-- +-- Drop-in replacement for @Criterion.@'Criterion.whnfIO' and @Gauge.@'Gauge.whnfIO'. +-- +-- @since 0.1 +whnfIO :: IO a -> Benchmarkable +whnfIO = ioToBench id +{-# INLINE whnfIO #-} + +ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Benchmarkable +ioFuncToBench frc = (Benchmarkable .) . go + where + go f x n + | n == 0 = pure () + | otherwise = do + val <- f x + _ <- evaluate (frc val) + go f x (n - 1) +{-# INLINE ioFuncToBench #-} + +-- | 'nfAppIO' @f@ @x@ measures time to evaluate side-effects of +-- an application of @f@ to @x@. +-- and compute its normal form (by means of 'force'). +-- This does not include time to evaluate @f@ or @x@ themselves. +-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. +-- +-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate +-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may +-- be an infinite structure. Thus @x@ will be evaluated in course of the first +-- application of @f@. This noisy measurement is to be discarded soon, +-- but if @x@ is not a primitive data type, consider forcing its evaluation +-- separately, e. g., via 'env' or 'withResource'. +-- +-- Note that forcing a normal form requires an additional +-- traverse of the structure. In certain scenarios, +-- especially when 'NFData' instance is badly written, +-- this traversal may take non-negligible time and affect results. +-- +-- A typical use case is 'nfAppIO' 'readFile' @"foo.txt"@. +-- However, if your goal is not to benchmark I\/O per se, +-- but just read input data from a file, it is cleaner to +-- use 'env' or 'withResource'. +-- +-- Drop-in replacement for @Criterion.@'Criterion.nfAppIO' and @Gauge.@'Gauge.nfAppIO'. +-- +-- @since 0.1 +nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable +nfAppIO = ioFuncToBench force +{-# INLINE nfAppIO #-} + +-- | 'whnfAppIO' @f@ @x@ measures time to evaluate side-effects of +-- an application of @f@ to @x@. +-- and compute its weak head normal form. +-- This does not include time to evaluate @f@ or @x@ themselves. +-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. +-- +-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate +-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may +-- be an infinite structure. Thus @x@ will be evaluated in course of the first +-- application of @f@. This noisy measurement is to be discarded soon, +-- but if @x@ is not a primitive data type, consider forcing its evaluation +-- separately, e. g., via 'env' or 'withResource'. +-- +-- Computing only a weak head normal form is +-- rarely what intuitively is meant by "evaluation". +-- Unless you understand precisely, what is measured, +-- it is recommended to use 'nfAppIO' instead. +-- +-- Lazy I\/O is treacherous. +-- If your goal is not to benchmark I\/O per se, +-- but just read input data from a file, it is cleaner to +-- use 'env' or 'withResource'. +-- +-- Drop-in replacement for @Criterion.@'Criterion.whnfAppIO' and @Gauge.@'Gauge.whnfAppIO'. +-- +-- @since 0.1 +whnfAppIO :: (a -> IO b) -> a -> Benchmarkable +whnfAppIO = ioFuncToBench id +{-# INLINE whnfAppIO #-} + + +word64ToDouble :: Word64 -> Double +word64ToDouble = fromIntegral + +#if !MIN_VERSION_base(4,10,0) && MIN_VERSION_base(4,6,0) +int64ToWord64 :: Int64 -> Word64 +int64ToWord64 = fromIntegral +#endif + +prettyEstimate :: Estimate -> String +prettyEstimate (Estimate m stdev) = + showPicos4 (measTime m) + ++ (if stdev == 0 then " " else " ± " ++ showPicos3 (2 * stdev)) + +-- | Show picoseconds, fitting number in 4 characters. +showPicos4 :: Word64 -> String +showPicos4 i + | t < 995 = printf "%3.0f ps" t + | t < 995e1 = printf "%4.2f ns" (t / 1e3) + | t < 995e2 = printf "%4.1f ns" (t / 1e3) + | t < 995e3 = printf "%3.0f ns" (t / 1e3) + | t < 995e4 = printf "%4.2f μs" (t / 1e6) + | t < 995e5 = printf "%4.1f μs" (t / 1e6) + | t < 995e6 = printf "%3.0f μs" (t / 1e6) + | t < 995e7 = printf "%4.2f ms" (t / 1e9) + | t < 995e8 = printf "%4.1f ms" (t / 1e9) + | t < 995e9 = printf "%3.0f ms" (t / 1e9) + | otherwise = printf "%4.3f s" (t / 1e12) + where + t = word64ToDouble i + +-- | Show picoseconds, fitting number in 3 characters. +showPicos3 :: Word64 -> String +showPicos3 i + | t < 995 = printf "%3.0f ps" t + | t < 995e1 = printf "%3.1f ns" (t / 1e3) + | t < 995e3 = printf "%3.0f ns" (t / 1e3) + | t < 995e4 = printf "%3.1f μs" (t / 1e6) + | t < 995e6 = printf "%3.0f μs" (t / 1e6) + | t < 995e7 = printf "%3.1f ms" (t / 1e9) + | t < 995e9 = printf "%3.0f ms" (t / 1e9) + | otherwise = printf "%4.2f s" (t / 1e12) + where + t = word64ToDouble i + +prettyEstimateWithGC :: Estimate -> String +prettyEstimateWithGC (Estimate m stdev) = + showPicos4 (measTime m) + ++ (if stdev == 0 then ", " else " ± " ++ showPicos3 (2 * stdev) ++ ", ") + ++ showBytes (measAllocs m) ++ " allocated, " + ++ showBytes (measCopied m) ++ " copied, " + ++ showBytes (measMaxMem m) ++ " peak memory" + +csvEstimate :: Estimate -> String +csvEstimate (Estimate m stdev) = show (measTime m) ++ "," ++ show (2 * stdev) + +csvEstimateWithGC :: Estimate -> String +csvEstimateWithGC (Estimate m stdev) = show (measTime m) ++ "," ++ show (2 * stdev) + ++ "," ++ show (measAllocs m) ++ "," ++ show (measCopied m) ++ "," ++ show (measMaxMem m) + +showBytes :: Word64 -> String +showBytes i + | t < 1000 = printf "%3.0f B " t + | t < 10189 = printf "%3.1f KB" (t / 1024) + | t < 1023488 = printf "%3.0f KB" (t / 1024) + | t < 10433332 = printf "%3.1f MB" (t / 1048576) + | t < 1048051712 = printf "%3.0f MB" (t / 1048576) + | t < 10683731149 = printf "%3.1f GB" (t / 1073741824) + | t < 1073204953088 = printf "%3.0f GB" (t / 1073741824) + | t < 10940140696372 = printf "%3.1f TB" (t / 1099511627776) + | t < 1098961871962112 = printf "%3.0f TB" (t / 1099511627776) + | t < 11202704073084108 = printf "%3.1f PB" (t / 1125899906842624) + | t < 1125336956889202624 = printf "%3.0f PB" (t / 1125899906842624) + | t < 11471568970838126592 = printf "%3.1f EB" (t / 1152921504606846976) + | otherwise = printf "%3.0f EB" (t / 1152921504606846976) + where + t = word64ToDouble i diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -2,6 +2,11 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ +## 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. + ## 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,203 @@ -cabal-version: 1.18 -name: filepath -version: 1.4.2.2 +cabal-version: 2.2 +name: filepath +version: 1.4.100.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, Julain Ospald 2021-2022 +bug-reports: https://gitlab.haskell.org/haskell/filepath/-/issues +homepage: + https://gitlab.haskell.org/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.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.3 + 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 + . + "System.OsString" is like "System.OsPath", but more general purpose. Refer to the documentation of + those modules for more information. extra-source-files: - System/FilePath/Internal.hs - Makefile + Generate.hs + Makefile + System/FilePath/Internal.hs + System/OsPath/Common.hs + System/OsString/Common.hs + tests/bytestring-tests/Properties/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://gitlab.haskell.org/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.Data.ByteString.Short + System.OsPath.Data.ByteString.Short.Internal + System.OsPath.Data.ByteString.Short.Word16 + System.OsPath.Encoding + System.OsPath.Encoding.Internal + System.OsPath.Internal + System.OsPath.Posix + System.OsPath.Posix.Internal + System.OsPath.Types + System.OsPath.Windows + System.OsPath.Windows.Internal + System.OsString + System.OsString.Internal + System.OsString.Internal.Types + System.OsString.Posix + System.OsString.Windows - 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.9 && <4.18 + , bytestring >=0.11.3.0 + , deepseq + , exceptions + , template-haskell + 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 + , QuickCheck >=2.7 && <2.15 + + 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 + + build-depends: + , base + , bytestring >=0.11.3.0 + , filepath + , QuickCheck >=2.7 && <2.15 + +test-suite bytestring-tests + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests tests/bytestring-tests + other-modules: + Properties.ShortByteString + Properties.ShortByteString.Word16 + TestUtil + + build-depends: + , base + , bytestring >=0.11.3.0 + , filepath + , QuickCheck >=2.7 && <2.15 + +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 + EncodingSpec + OsPathSpec + TestUtil + + build-depends: + , base + , bytestring >=0.11.3.0 + , checkers ^>=0.5.6 + , deepseq + , filepath + , QuickCheck >=2.7 && <2.15 + +benchmark bench-filepath + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: BenchFilePath.hs + hs-source-dirs: bench + other-modules: TastyBench + build-depends: + , base + , bytestring >=0.11.3.0 + , deepseq + , filepath + + if impl(ghc >=8.10) + ghc-options: "-with-rtsopts=-A32m --nonmoving-gc" + + else + 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,39 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module TestUtil( - (==>), QFilePath(..), QFilePathValidW(..), QFilePathValidP(..), + module TestUtil, module Test.QuickCheck, module Data.List, module Data.Maybe ) where import Test.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.OsPath.Encoding.Internal +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import GHC.IO.Encoding.Failure +import System.Environment + infixr 0 ==> +(==>) :: Bool -> Bool -> Bool a ==> b = not a || b @@ -50,3 +70,119 @@ | 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 + +runTests :: [(String, Property)] -> IO () +runTests tests = do + args <- getArgs + let count = case args of i:_ -> read i; _ -> 10000 + let testNum = case args of + _:i:_ + | let num = read i + , num < 0 -> drop (negate num) tests + | let num = read i + , num > 0 -> take num tests + | otherwise -> [] + _ -> tests + putStrLn $ "Testing with " ++ show count ++ " repetitions" + let total' = length testNum + let showOutput x = show x{output=""} ++ "\n" ++ output x + bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(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 @Integer [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/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,81 @@ +{-# 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.QuickCheck + +import Test.QuickCheck.Checkers + + + +instance Arbitrary OsString where + arbitrary = fmap fromJust $ encodeUtf <$> listOf filepathChar + +instance EqProp OsString where + (=-=) = eq + +instance Arbitrary PosixString where + arbitrary = fmap fromJust $ Posix.encodeUtf <$> listOf filepathChar + +instance EqProp PosixString where + (=-=) = eq + +instance Arbitrary WindowsString where + arbitrary = fmap fromJust $ Windows.encodeUtf <$> listOf filepathChar + +instance EqProp WindowsString where + (=-=) = eq + + +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/EncodingSpec.hs b/tests/abstract-filepath/EncodingSpec.hs new file mode 100644 --- /dev/null +++ b/tests/abstract-filepath/EncodingSpec.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeApplications #-} + +module EncodingSpec where + +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS + +import Arbitrary +import Test.QuickCheck + +import Data.Either ( isRight ) +import qualified System.OsPath.Data.ByteString.Short as BS8 +import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16 +import System.OsPath.Encoding.Internal +import GHC.IO (unsafePerformIO) +import GHC.IO.Encoding ( setFileSystemEncoding ) +import System.IO + ( utf16le ) +import Control.Exception +import Control.DeepSeq +import Data.Bifunctor ( first ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) + + +tests :: [(String, Property)] +tests = + [ ("ucs2le_decode . ucs2le_encode == id", + property $ \(padEven -> ba) -> + let decoded = decodeWithTE ucs2le (BS8.toShort ba) + encoded = encodeWithTE ucs2le =<< decoded + in (BS8.fromShort <$> encoded) === Right ba) + , ("utf16 doesn't handle invalid surrogate pairs", + property $ + let str = [toEnum 55296, toEnum 55297] + encoded = encodeWithTE utf16le str + decoded = decodeWithTE utf16le =<< encoded + in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing)) + , ("ucs2 handles invalid surrogate pairs", + property $ + let str = [toEnum 55296, toEnum 55297] + encoded = encodeWithTE ucs2le str + decoded = decodeWithTE ucs2le =<< encoded + in decoded === Right str) + , ("can roundtrip arbitrary bytes through utf-8 (with RoundtripFailure)", + property $ + \bs -> + let decoded = decodeWithTE (mkUTF8 RoundtripFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF8 RoundtripFailure) =<< decoded + in (either (const 0) BS8.length encoded, encoded) === (BS8.length (BS8.toShort bs), Right (BS8.toShort bs))) + + , ("can decode arbitrary strings through utf-8 (with RoundtripFailure)", + property $ + \(NonNullSurrogateString str) -> + let encoded = encodeWithTE (mkUTF8 RoundtripFailure) str + decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded + in expectFailure $ (either (const 0) length decoded, decoded) === (length str, Right str)) + + , ("utf-8 roundtrip encode cannot deal with some surrogates", + property $ + let str = [toEnum 0xDFF0, toEnum 0xDFF2] + encoded = encodeWithTE (mkUTF8 RoundtripFailure) str + decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded + in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing)) + + , ("cannot roundtrip arbitrary bytes through utf-16 (with RoundtripFailure)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le RoundtripFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le RoundtripFailure) =<< decoded + in expectFailure $ (either (const 0) BS8.length encoded, encoded) === (BS8.length (BS8.toShort bs), Right (BS8.toShort bs))) + , ("encodeWithTE/decodeWithTE ErrorOnCodingFailure fails (utf16le)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le ErrorOnCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le ErrorOnCodingFailure) =<< decoded + in expectFailure $ (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithTE/decodeWithTE ErrorOnCodingFailure fails (utf8)", + property $ + \bs -> + let decoded = decodeWithTE (mkUTF8 ErrorOnCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF8 ErrorOnCodingFailure) =<< decoded + in expectFailure $ (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithTE/decodeWithTE TransliterateCodingFailure never fails (utf16le)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le TransliterateCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le TransliterateCodingFailure) =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithTE/decodeWithTE TransliterateCodingFailure never fails (utf8)", + property $ + \bs -> + let decoded = decodeWithTE (mkUTF8 TransliterateCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF8 TransliterateCodingFailure) =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithBaseWindows/decodeWithBaseWindows never fails (utf16le)", + property $ + \(padEven -> bs) -> + let decoded = decodeW' (BS8.toShort bs) + encoded = encodeW' =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithBasePosix/decodeWithBasePosix never fails (utf8b)", + property $ + \bs -> ioProperty $ do + setFileSystemEncoding (mkUTF8 TransliterateCodingFailure) + let decoded = decodeP' (BS8.toShort bs) + encoded = encodeP' =<< decoded + pure $ (isRight encoded, isRight decoded) === (True, True)) + + , ("decodeWithBaseWindows == utf16le_b", + property $ + \(BS8.toShort . padEven -> bs) -> + let decoded = decodeW' bs + decoded' = first displayException $ decodeWithTE (mkUTF16le_b ErrorOnCodingFailure) bs + in decoded === decoded') + + , ("encodeWithBaseWindows == utf16le_b", + property $ + \(NonNullSurrogateString str) -> + let decoded = encodeW' str + decoded' = first displayException $ encodeWithTE (mkUTF16le_b ErrorOnCodingFailure) str + in decoded === decoded') + + , ("encodeWithTE/decodeWithTE never fails (utf16le_b)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le_b ErrorOnCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le_b ErrorOnCodingFailure) =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + ] + + +padEven :: ByteString -> ByteString +padEven bs + | even (BS.length bs) = bs + | otherwise = bs `BS.append` BS.pack [70] + + +decodeP' :: BS8.ShortByteString -> Either String String +decodeP' ba = unsafePerformIO $ do + r <- try @SomeException $ decodeWithBasePosix ba + evaluate $ force $ first displayException r + +encodeP' :: String -> Either String BS8.ShortByteString +encodeP' str = unsafePerformIO $ do + r <- try @SomeException $ encodeWithBasePosix str + evaluate $ force $ first displayException r + +decodeW' :: BS16.ShortByteString -> Either String String +decodeW' ba = unsafePerformIO $ do + r <- try @SomeException $ decodeWithBaseWindows ba + evaluate $ force $ first displayException r + +encodeW' :: String -> Either String BS8.ShortByteString +encodeW' str = unsafePerformIO $ do + r <- try @SomeException $ encodeWithBaseWindows str + evaluate $ force $ first displayException r + 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,259 @@ +{-# 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.OsPath.Data.ByteString.Short ( toShort ) +import System.OsString.Posix as PosixS +import System.OsString.Windows as WindowsS + +import Control.Exception +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import Test.QuickCheck +import Test.QuickCheck.Checkers +import qualified Test.QuickCheck.Classes 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.OsPath.Data.ByteString.Short.Word16 as BS16 +import qualified System.OsPath.Data.ByteString.Short as SBS +import Data.Char ( ord ) + +import Arbitrary + + +fromRight :: b -> Either a b -> b +fromRight _ (Right b) = b +fromRight b _ = b + + +tests :: [(String, Property)] +tests = + [ ("OSP.encodeUtf . OSP.decodeUtf == id", + property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str) + + , ("decodeUtf . encodeUtf == id (Posix)", + property $ \(NonNullString str) -> (Posix.decodeUtf . fromJust . Posix.encodeUtf) str == Just str) + , ("decodeUtf . encodeUtf == id (Windows)", + property $ \(NonNullString str) -> (Windows.decodeUtf . fromJust . Windows.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)) + , ("encodeWith ucs2le . decodeWith ucs2le == id (Windows)", + property $ \(padEven -> bs) -> (Windows.encodeWith ucs2le . (\(Right r) -> r) . Windows.decodeWith ucs2le . OS.WS . toShort) bs + === Right (OS.WS . toShort $ bs)) + + , ("decodeFS . encodeFS == id (Posix)", + 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) + ) + , ("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 (Windows)", + 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 + ) + ) + + , ("fromPlatformString* functions are equivalent under ASCII (Posix)", + 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 (Windows)", + 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 + ) + ) + + , ("toPlatformString* functions are equivalent under ASCII (Posix)", + 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* (Posix)", + 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 toPlatformString* (WindowsString)", + 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* (Posix)", + 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 + ) + ) + , ("Unit test fromPlatformString* (WindowsString)", + 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 + ) + ) + , ("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 + ) + , ("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 + ) + , ("QuasiQuoter (WindowsPath)", + property $ do + let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f] + let expected = [Windows.pstr|ABcK_|] + bs === expected + ) + , ("QuasiQuoter (PosixPath)", + property $ do + let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f] + let expected = [Posix.pstr|ABcK_|] + bs === expected + ) + + , ("pack . unpack == id (Windows)", + property $ \ws@(WindowsString _) -> + Windows.pack (Windows.unpack ws) === ws + ) + , ("pack . unpack == id (Posix)", + property $ \ws@(PosixString _) -> + Posix.pack (Posix.unpack ws) === ws + ) + , ("pack . unpack == id (OsPath)", + property $ \ws@(OsString _) -> + OSP.pack (OSP.unpack ws) === ws + ) + + + ] ++ testBatch (QC.ord (\(a :: OsPath) -> pure a)) + ++ testBatch (QC.monoid (undefined :: OsPath)) + + ++ testBatch (QC.ord (\(a :: OsString) -> pure a)) + ++ testBatch (QC.monoid (undefined :: OsString)) + + ++ testBatch (QC.ord (\(a :: WindowsString) -> pure a)) + ++ testBatch (QC.monoid (undefined :: WindowsString)) + + ++ testBatch (QC.ord (\(a :: PosixString) -> pure a)) + ++ testBatch (QC.monoid (undefined :: PosixString)) + + ++ testBatch (QC.ord (\(a :: PlatformString) -> pure a)) + ++ testBatch (QC.monoid (undefined :: PlatformString)) + +-- | Allows to insert a 'TestBatch' into a Spec. +testBatch :: TestBatch -> [(String, Property)] +testBatch (_, tests') = tests' + + +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,8 @@ +module Main (main) where + +import qualified OsPathSpec +import qualified EncodingSpec +import TestUtil + +main :: IO () +main = runTests (EncodingSpec.tests ++ OsPathSpec.tests) diff --git a/tests/bytestring-tests/Main.hs b/tests/bytestring-tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/bytestring-tests/Main.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeApplications #-} + +module Main (main) where + +import qualified Properties.ShortByteString as PropSBS +import qualified Properties.ShortByteString.Word16 as PropSBSW16 +import TestUtil + +main :: IO () +main = runTests (PropSBS.tests ++ PropSBSW16.tests) diff --git a/tests/bytestring-tests/Properties/Common.hs b/tests/bytestring-tests/Properties/Common.hs new file mode 100644 --- /dev/null +++ b/tests/bytestring-tests/Properties/Common.hs @@ -0,0 +1,418 @@ +-- | +-- Module : Properties.ShortByteString +-- Copyright : (c) Andrew Lelechenko 2021 +-- License : BSD-style + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- We are happy to sacrifice optimizations in exchange for faster compilation, +-- but need to test rewrite rules. As one can check using -ddump-rule-firings, +-- rewrite rules do not fire in -O0 mode, so we use -O1, but disable almost all +-- optimizations. It roughly halves compilation time. +{-# OPTIONS_GHC -O1 -fenable-rewrite-rules + -fmax-simplifier-iterations=1 -fsimplifier-phases=0 + -fno-call-arity -fno-case-merge -fno-cmm-elim-common-blocks -fno-cmm-sink + -fno-cpr-anal -fno-cse -fno-do-eta-reduction -fno-float-in -fno-full-laziness + -fno-loopification -fno-specialise -fno-strictness #-} + +#ifdef WORD16 +module Properties.ShortByteString.Word16 (tests) where +import System.OsPath.Data.ByteString.Short.Internal (_nul, isSpace) +import qualified System.OsPath.Data.ByteString.Short.Word16 as B +#else +module Properties.ShortByteString (tests) where +import qualified System.OsPath.Data.ByteString.Short as B +import qualified Data.Char as C +#endif +import Data.ByteString.Short (ShortByteString) + +import Data.Word + +import Control.Arrow +import Data.Foldable +import Data.List as L +import Data.Semigroup +import Data.Tuple +import Test.QuickCheck +import Test.QuickCheck.Monadic ( monadicIO, run ) +import Text.Show.Functions () + +#ifdef WORD16 +numWord :: ShortByteString -> Int +numWord = B.numWord16 + +toElem :: Word16 -> Word16 +toElem = id + +swapW :: Word16 -> Word16 +swapW = byteSwap16 + +sizedByteString :: Int -> Gen ShortByteString +sizedByteString n = do m <- choose(0, n) + fmap B.pack $ vectorOf m arbitrary + +instance Arbitrary ShortByteString where + arbitrary = do + bs <- sized sizedByteString + n <- choose (0, 2) + return (B.drop n bs) -- to give us some with non-0 offset + +instance CoArbitrary ShortByteString where + coarbitrary s = coarbitrary (B.unpack s) + +#else +_nul :: Word8 +_nul = 0x00 + +isSpace :: Word8 -> Bool +isSpace = C.isSpace . word8ToChar + +-- | Total conversion to char. +word8ToChar :: Word8 -> Char +word8ToChar = C.chr . fromIntegral + +numWord :: ShortByteString -> Int +numWord = B.length + +toElem :: Word8 -> Word8 +toElem = id + +swapW :: Word8 -> Word8 +swapW = id + + +sizedByteString :: Int -> Gen ShortByteString +sizedByteString n = do m <- choose(0, n) + fmap B.pack $ vectorOf m arbitrary + +instance Arbitrary ShortByteString where + arbitrary = do + bs <- sized sizedByteString + n <- choose (0, 2) + return (B.drop n bs) -- to give us some with non-0 offset + shrink = map B.pack . shrink . B.unpack + +instance CoArbitrary ShortByteString where + coarbitrary s = coarbitrary (B.unpack s) + +#endif + + +tests :: [(String, Property)] +tests = + [ ("pack . unpack", + property $ \x -> x === B.pack (B.unpack x)) + , ("unpack . pack" , + property $ \(map toElem -> xs) -> xs === B.unpack (B.pack xs)) + , ("read . show" , + property $ \x -> (x :: ShortByteString) === read (show x)) + + , ("==" , + property $ \x y -> (x == y) === (B.unpack x == B.unpack y)) + , ("== refl" , + property $ \x -> (x :: ShortByteString) == x) + , ("== symm", + property $ \x y -> ((x :: ShortByteString) == y) === (y == x)) + , ("== pack unpack", + property $ \x -> x == B.pack (B.unpack x)) + + , ("compare", + property $ \x y -> compare x y === compare (swapW <$> B.unpack x) (swapW <$> B.unpack y)) + , ("compare EQ", + property $ \x -> compare (x :: ShortByteString) x == EQ) + , ("compare GT", + property $ \x (toElem -> c) -> compare (B.snoc x c) x == GT) + , ("compare LT", + property $ \x (toElem -> c) -> compare x (B.snoc x c) == LT) + , ("compare GT empty", + property $ \x -> not (B.null x) ==> compare x B.empty == GT) + , ("compare LT empty", + property $ \x -> not (B.null x) ==> compare B.empty x == LT) + , ("compare GT concat", + property $ \x y -> not (B.null y) ==> compare (x <> y) x == GT) + , ("compare char" , + property $ \(toElem -> c) (toElem -> d) -> compare (swapW c) (swapW d) == compare (B.singleton c) (B.singleton d)) + , ("compare unsigned", + once $ compare (B.singleton 255) (B.singleton 127) == GT) + + , ("null" , + property $ \x -> B.null x === null (B.unpack x)) + , ("empty 0" , + once $ numWord B.empty === 0) + , ("empty []", + once $ B.unpack B.empty === []) + , ("mempty 0", + once $ numWord mempty === 0) + , ("mempty []", + once $ B.unpack mempty === []) + + , ("mconcat" , + property $ \xs -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)) + , ("mconcat [x,x]" , + property $ \x -> B.unpack (mconcat [x, x]) === mconcat [B.unpack x, B.unpack x]) + , ("mconcat [x,[]]" , + property $ \x -> B.unpack (mconcat [x, B.empty]) === mconcat [B.unpack x, []]) + + , ("null" , + property $ \x -> B.null x === null (B.unpack x)) + , ("reverse" , + property $ \x -> B.unpack (B.reverse x) === reverse (B.unpack x)) + , ("all" , + property $ \f x -> B.all f x === all f (B.unpack x)) + , ("all ==" , + property $ \(toElem -> c) x -> B.all (== c) x === all (== c) (B.unpack x)) + , ("any" , + property $ \f x -> B.any f x === any f (B.unpack x)) + , ("any ==" , + property $ \(toElem -> c) x -> B.any (== c) x === any (== c) (B.unpack x)) + , ("mappend" , + property $ \x y -> B.unpack (mappend x y) === B.unpack x `mappend` B.unpack y) + , ("<>" , + property $ \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y) + , ("stimes" , + property $ \(Positive n) x -> stimes (n :: Int) (x :: ShortByteString) === mtimesDefault n x) + + , ("break" , + property $ \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)) + , ("break ==" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (== c) x) === break (== c) (B.unpack x)) + , ("break /=" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (/= c) x) === break (/= c) (B.unpack x)) + , ("break span" , + property $ \f x -> B.break f x === B.span (not . f) x) + , ("breakEnd" , + property $ \f x -> B.breakEnd f x === swap ((B.reverse *** B.reverse) (B.break f (B.reverse x)))) + , ("breakEnd" , + property $ \f x -> B.breakEnd f x === B.spanEnd (not . f) x) + , ("break isSpace" , + property $ \x -> (B.unpack *** B.unpack) (B.break isSpace x) === break isSpace (B.unpack x)) + + , ("singleton" , + property $ \(toElem -> c) -> B.unpack (B.singleton c) === [c]) + , ("cons" , + property $ \(toElem -> c) x -> B.unpack (B.cons c x) === c : B.unpack x) + , ("cons []" , + property $ \(toElem -> c) -> B.unpack (B.cons c B.empty) === [c]) + , ("uncons" , + property $ \x -> fmap (second B.unpack) (B.uncons x) === L.uncons (B.unpack x)) + , ("snoc" , + property $ \(toElem -> c) x -> B.unpack (B.snoc x c) === B.unpack x ++ [c]) + , ("snoc []" , + property $ \(toElem -> c) -> B.unpack (B.snoc B.empty c) === [c]) + , ("unsnoc" , + property $ \x -> fmap (first B.unpack) (B.unsnoc x) === unsnoc (B.unpack x)) + + , ("drop" , + property $ \n x -> B.unpack (B.drop n x) === drop (fromIntegral n) (B.unpack x)) + , ("drop 10" , + property $ \x -> B.unpack (B.drop 10 x) === drop 10 (B.unpack x)) + , ("dropWhile" , + property $ \f x -> B.unpack (B.dropWhile f x) === dropWhile f (B.unpack x)) + , ("dropWhile ==" , + property $ \(toElem -> c) x -> B.unpack (B.dropWhile (== c) x) === dropWhile (== c) (B.unpack x)) + , ("dropWhile /=" , + property $ \(toElem -> c) x -> B.unpack (B.dropWhile (/= c) x) === dropWhile (/= c) (B.unpack x)) + , ("dropWhile isSpace" , + property $ \x -> B.unpack (B.dropWhile isSpace x) === dropWhile isSpace (B.unpack x)) + + , ("take" , + property $ \n x -> B.unpack (B.take n x) === take (fromIntegral n) (B.unpack x)) + , ("take 10" , + property $ \x -> B.unpack (B.take 10 x) === take 10 (B.unpack x)) + , ("takeWhile" , + property $ \f x -> B.unpack (B.takeWhile f x) === takeWhile f (B.unpack x)) + , ("takeWhile ==" , + property $ \(toElem -> c) x -> B.unpack (B.takeWhile (== c) x) === takeWhile (== c) (B.unpack x)) + , ("takeWhile /=" , + property $ \(toElem -> c) x -> B.unpack (B.takeWhile (/= c) x) === takeWhile (/= c) (B.unpack x)) + + , ("takeWhile isSpace" , + property $ \x -> B.unpack (B.takeWhile isSpace x) === takeWhile isSpace (B.unpack x)) + + , ("dropEnd" , + property $ \n x -> B.dropEnd n x === B.take (numWord x - n) x) + , ("dropWhileEnd" , + property $ \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x))) + , ("takeEnd" , + property $ \n x -> B.takeEnd n x === B.drop (numWord x - n) x) + , ("takeWhileEnd" , + property $ \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x))) + + , ("length" , + property $ \x -> numWord x === fromIntegral (length (B.unpack x))) + , ("count" , + property $ \(toElem -> c) x -> B.count c x === fromIntegral (length (elemIndices c (B.unpack x)))) + , ("filter" , + property $ \f x -> B.unpack (B.filter f x) === filter f (B.unpack x)) + , ("filter compose" , + property $ \f g x -> B.filter f (B.filter g x) === B.filter (\c -> f c && g c) x) + , ("filter ==" , + property $ \(toElem -> c) x -> B.unpack (B.filter (== c) x) === filter (== c) (B.unpack x)) + , ("filter /=" , + property $ \(toElem -> c) x -> B.unpack (B.filter (/= c) x) === filter (/= c) (B.unpack x)) + , ("partition" , + property $ \f x -> (B.unpack *** B.unpack) (B.partition f x) === partition f (B.unpack x)) + + , ("find" , + property $ \f x -> B.find f x === find f (B.unpack x)) + , ("findIndex" , + property $ \f x -> B.findIndex f x === fmap fromIntegral (findIndex f (B.unpack x))) + , ("findIndices" , + property $ \f x -> B.findIndices f x === fmap fromIntegral (findIndices f (B.unpack x))) + , ("findIndices ==" , + property $ \(toElem -> c) x -> B.findIndices (== c) x === fmap fromIntegral (findIndices (== c) (B.unpack x))) + + , ("elem" , + property $ \(toElem -> c) x -> B.elem c x === elem c (B.unpack x)) + , ("not elem" , + property $ \(toElem -> c) x -> not (B.elem c x) === notElem c (B.unpack x)) + , ("elemIndex" , + property $ \(toElem -> c) x -> B.elemIndex c x === fmap fromIntegral (elemIndex c (B.unpack x))) + , ("elemIndices" , + property $ \(toElem -> c) x -> B.elemIndices c x === fmap fromIntegral (elemIndices c (B.unpack x))) + + + , ("map" , + property $ \f x -> B.unpack (B.map (toElem . f) x) === map (toElem . f) (B.unpack x)) + , ("map compose" , + property $ \f g x -> B.map (toElem . f) (B.map (toElem . g) x) === B.map (toElem . f . toElem . g) x) + , ("replicate" , + property $ \n (toElem -> c) -> B.unpack (B.replicate (fromIntegral n) c) === replicate n c) + , ("replicate 0" , + property $ \(toElem -> c) -> B.unpack (B.replicate 0 c) === replicate 0 c) + + , ("span" , + property $ \f x -> (B.unpack *** B.unpack) (B.span f x) === span f (B.unpack x)) + , ("span ==" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (== c) x) === span (== c) (B.unpack x)) + , ("span /=" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (/= c) x) === span (/= c) (B.unpack x)) + , ("spanEnd" , + property $ \f x -> B.spanEnd f x === swap ((B.reverse *** B.reverse) (B.span f (B.reverse x)))) + , ("split" , + property $ \(toElem -> c) x -> map B.unpack (B.split c x) === split c (B.unpack x)) + , ("split empty" , + property $ \(toElem -> c) -> B.split c B.empty === []) + , ("splitWith" , + property $ \f x -> map B.unpack (B.splitWith f x) === splitWith f (B.unpack x)) + , ("splitWith split" , + property $ \(toElem -> c) x -> B.splitWith (== c) x === B.split c x) + , ("splitWith empty" , + property $ \f -> B.splitWith f B.empty === []) + , ("splitWith length" , + property $ \f x -> let splits = B.splitWith f x; l1 = fromIntegral (length splits); l2 = numWord (B.filter f x) in + (l1 == l2 || l1 == l2 + 1) && sum (map numWord splits) + l2 == numWord x) + , ("splitAt" , + property $ \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === splitAt (fromIntegral n) (B.unpack x)) + + , ("head" , + property $ \x -> not (B.null x) ==> B.head x == head (B.unpack x)) + , ("last" , + property $ \x -> not (B.null x) ==> B.last x == last (B.unpack x)) + , ("tail" , + property $ \x -> not (B.null x) ==> B.unpack (B.tail x) == tail (B.unpack x)) + , ("tail length" , + property $ \x -> not (B.null x) ==> numWord x == 1 + numWord (B.tail x)) + , ("init" , + property $ \x -> not (B.null x) ==> B.unpack (B.init x) == init (B.unpack x)) + , ("init length" , + property $ \x -> not (B.null x) ==> numWord x == 1 + numWord (B.init x)) + + , ("foldl" , + property $ \f (toElem -> c) x -> B.foldl ((toElem .) . f) c x === foldl ((toElem .) . f) c (B.unpack x)) + , ("foldl'" , + property $ \f (toElem -> c) x -> B.foldl' ((toElem .) . f) c x === foldl' ((toElem .) . f) c (B.unpack x)) + , ("foldr" , + property $ \f (toElem -> c) x -> B.foldr ((toElem .) . f) c x === foldr ((toElem .) . f) c (B.unpack x)) + , ("foldr'" , + property $ \f (toElem -> c) x -> B.foldr' ((toElem .) . f) c x === foldr' ((toElem .) . f) c (B.unpack x)) + + , ("foldl cons" , + property $ \x -> B.foldl (flip B.cons) B.empty x === B.reverse x) + , ("foldr cons" , + property $ \x -> B.foldr B.cons B.empty x === x) + , ("foldl special" , + property $ \x (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) === + foldl (\acc t -> if t == c then acc else t : acc) [] (B.unpack x)) + , ("foldr special" , + property $ \x (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) === + foldr (\t acc -> if t == c then acc else t : acc) [] (B.unpack x)) + + , ("foldl1" , + property $ \f x -> not (B.null x) ==> B.foldl1 ((toElem .) . f) x == foldl1 ((toElem .) . f) (B.unpack x)) + , ("foldl1'" , + property $ \f x -> not (B.null x) ==> B.foldl1' ((toElem .) . f) x == foldl1' ((toElem .) . f) (B.unpack x)) + , ("foldr1" , + property $ \f x -> not (B.null x) ==> B.foldr1 ((toElem .) . f) x == foldr1 ((toElem .) . f) (B.unpack x)) + , ("foldr1'", -- there is not Data.List.foldr1' + property $ \f x -> not (B.null x) ==> B.foldr1' ((toElem .) . f) x == foldr1 ((toElem .) . f) (B.unpack x)) + + , ("foldl1 const" , + property $ \x -> not (B.null x) ==> B.foldl1 const x == B.head x) + , ("foldl1 flip const" , + property $ \x -> not (B.null x) ==> B.foldl1 (flip const) x == B.last x) + , ("foldr1 const" , + property $ \x -> not (B.null x) ==> B.foldr1 const x == B.head x) + , ("foldr1 flip const" , + property $ \x -> not (B.null x) ==> B.foldr1 (flip const) x == B.last x) + , ("foldl1 max" , + property $ \x -> not (B.null x) ==> B.foldl1 max x == B.foldl max minBound x) + , ("foldr1 max" , + property $ \x -> not (B.null x) ==> B.foldr1 max x == B.foldr max minBound x) + + , ("index" , + property $ \(NonNegative n) x -> fromIntegral n < numWord x ==> B.index x (fromIntegral n) == B.unpack x !! n) + , ("indexMaybe" , + property $ \(NonNegative n) x -> fromIntegral n < numWord x ==> B.indexMaybe x (fromIntegral n) == Just (B.unpack x !! n)) + , ("indexMaybe Nothing" , + property $ \n x -> (n :: Int) < 0 || fromIntegral n >= numWord x ==> B.indexMaybe x (fromIntegral n) == Nothing) + , ("!?" , + property $ \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)) + + , ("unfoldrN" , + property $ \n f (toElem -> c) -> B.unpack (fst (B.unfoldrN n (fmap (first toElem) . f) c)) === + take (fromIntegral n) (unfoldr (fmap (first toElem) . f) c)) + , ("unfoldrN replicate" , + property $ \n (toElem -> c) -> fst (B.unfoldrN n (\t -> Just (t, t)) c) === B.replicate n c) + , ("unfoldr" , + property $ \n a (toElem -> c) -> B.unpack (B.unfoldr (\x -> if x <= 100 * n then Just (c, x + 1 :: Int) else Nothing) a) === + unfoldr (\x -> if x <= 100 * n then Just (c, x + 1) else Nothing) a) + + --, ("unfoldr" , + -- property $ \n f (toElem -> a) -> B.unpack (B.take (fromIntegral n) (B.unfoldr (fmap (first toElem) . f) a)) === + -- take n (unfoldr (fmap (first toElem) . f) a)) + -- +#ifdef WORD16 + , ("useAsCWString str packCWString == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCWString x B.packCWString >>= \x' -> pure (x == x'))) + , ("useAsCWStringLen str packCWStringLen == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCWStringLen x B.packCWStringLen >>= \x' -> pure (x == x'))) +#else + , ("useAsCString str packCString == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCString x B.packCString >>= \x' -> pure (x == x'))) + , ("useAsCStringLen str packCStringLen == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCStringLen x B.packCStringLen >>= \x' -> pure (x == x'))) +#endif + ] + +split :: Eq a => a -> [a] -> [[a]] +split c = splitWith (== c) + +splitWith :: (a -> Bool) -> [a] -> [[a]] +splitWith _ [] = [] +splitWith f ys = go [] ys + where + go acc [] = [reverse acc] + go acc (x : xs) + | f x = reverse acc : go [] xs + | otherwise = go (x : acc) xs + +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc xs = Just (init xs, last xs) diff --git a/tests/bytestring-tests/Properties/ShortByteString.hs b/tests/bytestring-tests/Properties/ShortByteString.hs new file mode 100644 --- /dev/null +++ b/tests/bytestring-tests/Properties/ShortByteString.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE CPP #-} +#undef WORD16 +#include "Common.hs" diff --git a/tests/bytestring-tests/Properties/ShortByteString/Word16.hs b/tests/bytestring-tests/Properties/ShortByteString/Word16.hs new file mode 100644 --- /dev/null +++ b/tests/bytestring-tests/Properties/ShortByteString/Word16.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE CPP #-} +#define WORD16 +#include "../Common.hs" 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,427 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} + +module Main where + +import Test.QuickCheck hiding ((==>)) +import TestUtil +import Prelude as P + +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 = runTests equivalentTests + + +equivalentTests :: [(String, Property)] +equivalentTests = + [ + ( "pathSeparator (windows)" + , property $ W.pathSeparator == LW.pathSeparator + ) + , + ( "pathSeparators (windows)" + , property $ W.pathSeparators == LW.pathSeparators + ) + , + ( "isPathSeparator (windows)" + , property $ \p -> W.isPathSeparator p == LW.isPathSeparator p + ) + , + ( "searchPathSeparator (windows)" + , property $ W.searchPathSeparator == LW.searchPathSeparator + ) + , + ( "isSearchPathSeparator (windows)" + , property $ \p -> W.isSearchPathSeparator p == LW.isSearchPathSeparator p + ) + , + ( "extSeparator (windows)" + , property $ W.extSeparator == LW.extSeparator + ) + , + ( "isExtSeparator (windows)" + , property $ \p -> W.isExtSeparator p == LW.isExtSeparator p + ) + , + ( "splitSearchPath (windows)" + , property $ \p -> W.splitSearchPath p == LW.splitSearchPath p + ) + , + ( "splitExtension (windows)" + , property $ \p -> W.splitExtension p == LW.splitExtension p + ) + , + ( "takeExtension (windows)" + , property $ \p -> W.takeExtension p == LW.takeExtension p + ) + , + ( "replaceExtension (windows)" + , property $ \p s -> W.replaceExtension p s == LW.replaceExtension p s + ) + , + ( "dropExtension (windows)" + , property $ \p -> W.dropExtension p == LW.dropExtension p + ) + , + ( "addExtension (windows)" + , property $ \p s -> W.addExtension p s == LW.addExtension p s + ) + , + ( "hasExtension (windows)" + , property $ \p -> W.hasExtension p == LW.hasExtension p + ) + , + ( "splitExtensions (windows)" + , property $ \p -> W.splitExtensions p == LW.splitExtensions p + ) + , + ( "dropExtensions (windows)" + , property $ \p -> W.dropExtensions p == LW.dropExtensions p + ) + , + ( "takeExtensions (windows)" + , property $ \p -> W.takeExtensions p == LW.takeExtensions p + ) + , + ( "replaceExtensions (windows)" + , property $ \p s -> W.replaceExtensions p s == LW.replaceExtensions p s + ) + , + ( "isExtensionOf (windows)" + , property $ \p s -> W.isExtensionOf p s == LW.isExtensionOf p s + ) + , + ( "stripExtension (windows)" + , property $ \p s -> W.stripExtension p s == LW.stripExtension p s + ) + , + ( "splitFileName (windows)" + , property $ \p -> W.splitFileName p == LW.splitFileName p + ) + , + ( "takeFileName (windows)" + , property $ \p -> W.takeFileName p == LW.takeFileName p + ) + , + ( "replaceFileName (windows)" + , property $ \p s -> W.replaceFileName p s == LW.replaceFileName p s + ) + , + ( "dropFileName (windows)" + , property $ \p -> W.dropFileName p == LW.dropFileName p + ) + , + ( "takeBaseName (windows)" + , property $ \p -> W.takeBaseName p == LW.takeBaseName p + ) + , + ( "replaceBaseName (windows)" + , property $ \p s -> W.replaceBaseName p s == LW.replaceBaseName p s + ) + , + ( "takeDirectory (windows)" + , property $ \p -> W.takeDirectory p == LW.takeDirectory p + ) + , + ( "replaceDirectory (windows)" + , property $ \p s -> W.replaceDirectory p s == LW.replaceDirectory p s + ) + , + ( "combine (windows)" + , property $ \p s -> W.combine p s == LW.combine p s + ) + , + ( "splitPath (windows)" + , property $ \p -> W.splitPath p == LW.splitPath p + ) + , + ( "joinPath (windows)" + , property $ \p -> W.joinPath p == LW.joinPath p + ) + , + ( "splitDirectories (windows)" + , property $ \p -> W.splitDirectories p == LW.splitDirectories p + ) + , + ( "splitDirectories (windows)" + , property $ \p -> W.splitDirectories p == LW.splitDirectories p + ) + , + ( "splitDrive (windows)" + , property $ \p -> W.splitDrive p == LW.splitDrive p + ) + , + ( "joinDrive (windows)" + , property $ \p s -> W.joinDrive p s == LW.joinDrive p s + ) + , + ( "takeDrive (windows)" + , property $ \p -> W.takeDrive p == LW.takeDrive p + ) + , + ( "hasDrive (windows)" + , property $ \p -> W.hasDrive p == LW.hasDrive p + ) + , + ( "dropDrive (windows)" + , property $ \p -> W.dropDrive p == LW.dropDrive p + ) + , + ( "isDrive (windows)" + , property $ \p -> W.isDrive p == LW.isDrive p + ) + , + ( "hasTrailingPathSeparator (windows)" + , property $ \p -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p + ) + , + ( "addTrailingPathSeparator (windows)" + , property $ \p -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p + ) + , + ( "dropTrailingPathSeparator (windows)" + , property $ \p -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p + ) + , + ( "normalise (windows)" + , property $ \p -> W.normalise p == LW.normalise p + ) + , + ( "equalFilePath (windows)" + , property $ \p s -> W.equalFilePath p s == LW.equalFilePath p s + ) + , + ( "makeRelative (windows)" + , property $ \p s -> W.makeRelative p s == LW.makeRelative p s + ) + , + ( "isRelative (windows)" + , property $ \p -> W.isRelative p == LW.isRelative p + ) + , + ( "isAbsolute (windows)" + , property $ \p -> W.isAbsolute p == LW.isAbsolute p + ) + , + ( "isValid (windows)" + , property $ \p -> W.isValid p == LW.isValid p + ) + , + ( "makeValid (windows)" + , property $ \p -> W.makeValid p == LW.makeValid p + ) + , + ( "pathSeparator (posix)" + , property $ P.pathSeparator == LP.pathSeparator + ) + , + ( "pathSeparators (posix)" + , property $ P.pathSeparators == LP.pathSeparators + ) + , + ( "isPathSeparator (posix)" + , property $ \p -> P.isPathSeparator p == LP.isPathSeparator p + ) + , + ( "searchPathSeparator (posix)" + , property $ P.searchPathSeparator == LP.searchPathSeparator + ) + , + ( "isSearchPathSeparator (posix)" + , property $ \p -> P.isSearchPathSeparator p == LP.isSearchPathSeparator p + ) + , + ( "extSeparator (posix)" + , property $ P.extSeparator == LP.extSeparator + ) + , + ( "isExtSeparator (posix)" + , property $ \p -> P.isExtSeparator p == LP.isExtSeparator p + ) + , + ( "splitSearchPath (posix)" + , property $ \p -> P.splitSearchPath p == LP.splitSearchPath p + ) + , + ( "splitExtension (posix)" + , property $ \p -> P.splitExtension p == LP.splitExtension p + ) + , + ( "takeExtension (posix)" + , property $ \p -> P.takeExtension p == LP.takeExtension p + ) + , + ( "replaceExtension (posix)" + , property $ \p s -> P.replaceExtension p s == LP.replaceExtension p s + ) + , + ( "dropExtension (posix)" + , property $ \p -> P.dropExtension p == LP.dropExtension p + ) + , + ( "addExtension (posix)" + , property $ \p s -> P.addExtension p s == LP.addExtension p s + ) + , + ( "hasExtension (posix)" + , property $ \p -> P.hasExtension p == LP.hasExtension p + ) + , + ( "splitExtensions (posix)" + , property $ \p -> P.splitExtensions p == LP.splitExtensions p + ) + , + ( "dropExtensions (posix)" + , property $ \p -> P.dropExtensions p == LP.dropExtensions p + ) + , + ( "takeExtensions (posix)" + , property $ \p -> P.takeExtensions p == LP.takeExtensions p + ) + , + ( "replaceExtensions (posix)" + , property $ \p s -> P.replaceExtensions p s == LP.replaceExtensions p s + ) + , + ( "isExtensionOf (posix)" + , property $ \p s -> P.isExtensionOf p s == LP.isExtensionOf p s + ) + , + ( "stripExtension (posix)" + , property $ \p s -> P.stripExtension p s == LP.stripExtension p s + ) + , + ( "splitFileName (posix)" + , property $ \p -> P.splitFileName p == LP.splitFileName p + ) + , + ( "takeFileName (posix)" + , property $ \p -> P.takeFileName p == LP.takeFileName p + ) + , + ( "replaceFileName (posix)" + , property $ \p s -> P.replaceFileName p s == LP.replaceFileName p s + ) + , + ( "dropFileName (posix)" + , property $ \p -> P.dropFileName p == LP.dropFileName p + ) + , + ( "takeBaseName (posix)" + , property $ \p -> P.takeBaseName p == LP.takeBaseName p + ) + , + ( "replaceBaseName (posix)" + , property $ \p s -> P.replaceBaseName p s == LP.replaceBaseName p s + ) + , + ( "takeDirectory (posix)" + , property $ \p -> P.takeDirectory p == LP.takeDirectory p + ) + , + ( "replaceDirectory (posix)" + , property $ \p s -> P.replaceDirectory p s == LP.replaceDirectory p s + ) + , + ( "combine (posix)" + , property $ \p s -> P.combine p s == LP.combine p s + ) + , + ( "splitPath (posix)" + , property $ \p -> P.splitPath p == LP.splitPath p + ) + , + ( "joinPath (posix)" + , property $ \p -> P.joinPath p == LP.joinPath p + ) + , + ( "splitDirectories (posix)" + , property $ \p -> P.splitDirectories p == LP.splitDirectories p + ) + , + ( "splitDirectories (posix)" + , property $ \p -> P.splitDirectories p == LP.splitDirectories p + ) + , + ( "splitDrive (posix)" + , property $ \p -> P.splitDrive p == LP.splitDrive p + ) + , + ( "joinDrive (posix)" + , property $ \p s -> P.joinDrive p s == LP.joinDrive p s + ) + , + ( "takeDrive (posix)" + , property $ \p -> P.takeDrive p == LP.takeDrive p + ) + , + ( "hasDrive (posix)" + , property $ \p -> P.hasDrive p == LP.hasDrive p + ) + , + ( "dropDrive (posix)" + , property $ \p -> P.dropDrive p == LP.dropDrive p + ) + , + ( "isDrive (posix)" + , property $ \p -> P.isDrive p == LP.isDrive p + ) + , + ( "hasTrailingPathSeparator (posix)" + , property $ \p -> P.hasTrailingPathSeparator p == LP.hasTrailingPathSeparator p + ) + , + ( "addTrailingPathSeparator (posix)" + , property $ \p -> P.addTrailingPathSeparator p == LP.addTrailingPathSeparator p + ) + , + ( "dropTrailingPathSeparator (posix)" + , property $ \p -> P.dropTrailingPathSeparator p == LP.dropTrailingPathSeparator p + ) + , + ( "normalise (posix)" + , property $ \p -> P.normalise p == LP.normalise p + ) + , + ( "equalFilePath (posix)" + , property $ \p s -> P.equalFilePath p s == LP.equalFilePath p s + ) + , + ( "makeRelative (posix)" + , property $ \p s -> P.makeRelative p s == LP.makeRelative p s + ) + , + ( "isRelative (posix)" + , property $ \p -> P.isRelative p == LP.isRelative p + ) + , + ( "isAbsolute (posix)" + , property $ \p -> P.isAbsolute p == LP.isAbsolute p + ) + , + ( "isValid (posix)" + , property $ \p -> P.isValid p == LP.isValid p + ) + , + ( "makeValid (posix)" + , 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,39 @@ +{-# LANGUAGE TypeApplications #-} + +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 + let testNum = case args of + _:i:_ + | let num = read i + , num < 0 -> drop (negate num) tests + | let num = read i + , num > 0 -> take num tests + | otherwise -> [] + _ -> tests + putStrLn $ "Testing with " ++ show count ++ " repetitions" + let total' = length testNum + let showOutput x = show x{output=""} ++ "\n" ++ output x + bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(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 @Integer [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/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,949 @@ +-- 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.OsPath.Encoding.Internal +import qualified Data.Char as C +import qualified System.OsPath.Data.ByteString.Short as SBS +import qualified System.OsPath.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.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"))) + ,("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:"), (""))) + ,("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)) + ,("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 \"\\\\\\\\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)) + ]