packages feed

filepath 1.4.2.1 → 1.4.2.2

raw patch · 12 files changed

+2322/−45 lines, 12 filesdep ~QuickCheckdep ~basenew-uploaderPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

+ System.FilePath: (-<.>) :: FilePath -> String -> FilePath
+ System.FilePath: (<.>) :: FilePath -> String -> FilePath
+ System.FilePath: (</>) :: FilePath -> FilePath -> FilePath
+ System.FilePath: addExtension :: FilePath -> String -> FilePath
+ System.FilePath: addTrailingPathSeparator :: FilePath -> FilePath
+ System.FilePath: combine :: FilePath -> FilePath -> FilePath
+ System.FilePath: dropDrive :: FilePath -> FilePath
+ System.FilePath: dropExtension :: FilePath -> FilePath
+ System.FilePath: dropExtensions :: FilePath -> FilePath
+ System.FilePath: dropFileName :: FilePath -> FilePath
+ System.FilePath: dropTrailingPathSeparator :: FilePath -> FilePath
+ System.FilePath: equalFilePath :: FilePath -> FilePath -> Bool
+ System.FilePath: extSeparator :: Char
+ System.FilePath: getSearchPath :: IO [FilePath]
+ System.FilePath: hasDrive :: FilePath -> Bool
+ System.FilePath: hasExtension :: FilePath -> Bool
+ System.FilePath: hasTrailingPathSeparator :: FilePath -> Bool
+ System.FilePath: infixr 5 </>
+ System.FilePath: infixr 7 <.>
+ System.FilePath: isAbsolute :: FilePath -> Bool
+ System.FilePath: isDrive :: FilePath -> Bool
+ System.FilePath: isExtSeparator :: Char -> Bool
+ System.FilePath: isExtensionOf :: String -> FilePath -> Bool
+ System.FilePath: isPathSeparator :: Char -> Bool
+ System.FilePath: isRelative :: FilePath -> Bool
+ System.FilePath: isSearchPathSeparator :: Char -> Bool
+ System.FilePath: isValid :: FilePath -> Bool
+ System.FilePath: joinDrive :: FilePath -> FilePath -> FilePath
+ System.FilePath: joinPath :: [FilePath] -> FilePath
+ System.FilePath: makeRelative :: FilePath -> FilePath -> FilePath
+ System.FilePath: makeValid :: FilePath -> FilePath
+ System.FilePath: normalise :: FilePath -> FilePath
+ System.FilePath: pathSeparator :: Char
+ System.FilePath: pathSeparators :: [Char]
+ System.FilePath: replaceBaseName :: FilePath -> String -> FilePath
+ System.FilePath: replaceDirectory :: FilePath -> String -> FilePath
+ System.FilePath: replaceExtension :: FilePath -> String -> FilePath
+ System.FilePath: replaceExtensions :: FilePath -> String -> FilePath
+ System.FilePath: replaceFileName :: FilePath -> String -> FilePath
+ System.FilePath: searchPathSeparator :: Char
+ System.FilePath: splitDirectories :: FilePath -> [FilePath]
+ System.FilePath: splitDrive :: FilePath -> (FilePath, FilePath)
+ System.FilePath: splitExtension :: FilePath -> (String, String)
+ System.FilePath: splitExtensions :: FilePath -> (FilePath, String)
+ System.FilePath: splitFileName :: FilePath -> (String, String)
+ System.FilePath: splitPath :: FilePath -> [FilePath]
+ System.FilePath: splitSearchPath :: String -> [FilePath]
+ System.FilePath: stripExtension :: String -> FilePath -> Maybe FilePath
+ System.FilePath: takeBaseName :: FilePath -> String
+ System.FilePath: takeDirectory :: FilePath -> FilePath
+ System.FilePath: takeDrive :: FilePath -> FilePath
+ System.FilePath: takeExtension :: FilePath -> String
+ System.FilePath: takeExtensions :: FilePath -> String
+ System.FilePath: takeFileName :: FilePath -> FilePath
+ System.FilePath: type FilePath = String

Files

+ HACKING.md view
@@ -0,0 +1,21 @@+# Hacking++Most of the code is in `System/FilePath/Internal.hs` which is `cpphs`'d into both `System/FilePath/Posix.hs`+and `System/FilePath/Windows.hs` via `make cpp` and commited to the repo. This Internal module is a bit weird+in that it isn't really a Haskell module, but is more an include file.++The library has extensive doc tests. Anything starting with `-- >` is transformed into a doc test as a predicate+that must evaluate to `True`. These tests follow a few rules:++* Tests prefixed with `Windows:` or `Posix:` are only tested against that specific+  implementation - otherwise tests are run against both implementations.+* Any single letter variable, e.g. `x`, is considered universal quantification, and is checked with `QuickCheck`.+* If `Valid x =>` appears at the start of a doc test, that means the property+  will only be tested with `x` passing the `isValid` predicate.++The tests can be generated by `make gen` in the root of the repo, and will be placed in `tests/TestGen.hs`.+The `TestGen.hs` file is checked into the repo, and the CI scripts check that `TestGen.hs` is in sync with+what would be generated a fresh - if you don't regenerate `TestGen.hs` the CI will fail.++The `.ghci` file is set up to allow you to type `ghci` to open the library, then `:go` will regenerate the+tests and run them.
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2005-2018.+Copyright Neil Mitchell 2005-2020. All rights reserved.  Redistribution and use in source and binary forms, with or without
+ Makefile view
@@ -0,0 +1,10 @@+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++gen:+	runhaskell Generate.hs++.PHONY: all cpp gen
README.md view
@@ -1,33 +1,38 @@-# FilePath [![Hackage version](https://img.shields.io/hackage/v/filepath.svg?label=Hackage)](https://hackage.haskell.org/package/filepath) [![Linux Build Status](https://img.shields.io/travis/haskell/filepath/master.svg?label=Linux%20build)](https://travis-ci.org/haskell/filepath) [![Windows Build Status](https://img.shields.io/appveyor/ci/ndmitchell/filepath/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/filepath)+# 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 both [GHC](https://www.haskell.org/ghc/) and the [Haskell Platform](https://www.haskell.org/platform/). It provides three modules:+The `filepath` package provides functionality for manipulating `FilePath` values, and is shipped with [GHC](https://www.haskell.org/ghc/).+It provides three modules: -* [`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.+* [`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.  All three modules provide the same API, and the same documentation (calling out differences in the different variants). -### Should `FilePath` be an abstract data type?--The answer for this library is "no". While an abstract `FilePath` has some advantages (mostly type safety), it also has some disadvantages:+### What is a `FilePath`? -* In Haskell the definition is `type FilePath = String`, and all file-oriented functions operate on this type alias, e.g. `readFile`/`writeFile`. Any abstract type would require wrappers for these functions or lots of casts between `String` and the abstraction.-* It is not immediately obvious what a `FilePath` is, and what is just a pure `String`. For example, `/path/file.ext` is a `FilePath`. Is `/`? `/path`? `path`? `file.ext`? `.ext`? `file`?-* Often it is useful to represent invalid files, e.g. `/foo/*.txt` probably isn't an actual file, but a glob pattern. Other programs use `foo//bar` for globs, which is definitely not a file, but might want to be stored as a `FilePath`.-* Some programs use syntactic non-semantic details of the `FilePath` to change their behaviour. For example, `foo`, `foo/` and `foo/.` are all similar, and refer to the same location on disk, but may behave differently when passed to command-line tools.-* A useful step to introducing an abstract `FilePath` is to reduce the amount of manipulating `FilePath` values like lists. This library hopes to help in that effort.+In Haskell, the definition is `type FilePath = String` as of now. A Haskell `String` is a list of Unicode code points. -### Developer notes+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. -Most of the code is in `System/FilePath/Internal.hs` which is `#include`'d into both `System/FilePath/Posix.hs` and `System/FilePath/Windows.hs` with the `IS_WINDOWS` CPP define set to either `True` or `False`. This Internal module is a bit weird in that it isn't really a Haskell module, but is more an include file.+On windows (at least the API used by `Win32`) filepaths are UTF-16 strings. -The library has extensive doc tests. Anything starting with `-- >` is transformed into a doc test as a predicate that must evaluate to `True`. These tests follow a few rules:+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. -* Tests prefixed with `Windows:` or `Posix:` are only tested against that specific implementation - otherwise tests are run against both implementations.-* Any single letter variable, e.g. `x`, is considered universal quantification, and is checked with `QuickCheck`.-* If `Valid x =>` appears at the start of a doc test, that means the property will only be tested with `x` passing the `isValid` predicate.+Further, 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). -The tests can be generated by `Generate.hs` in the root of the repo, and will be placed in `tests/TestGen.hs`. The `TestGen.hs` file is checked into the repo, and the CI scripts check that `TestGen.hs` is in sync with what would be generated a fresh - if you don't regenerate `TestGen.hs` the CI will fail.+For such libraries, check out the following: -The `.ghci` file is set up to allow you to type `ghci` to open the library, then `:go` will regenerate the tests and run them.+* [hpath](https://hackage.haskell.org/package/hpath)+* [path](https://hackage.haskell.org/package/path)+* [paths](https://hackage.haskell.org/package/paths)+* [strong-path](https://hackage.haskell.org/package/strong-path)
System/FilePath.hs view
@@ -15,15 +15,133 @@ depending on the platform.  Both "System.FilePath.Posix" and "System.FilePath.Windows" provide the-same interface. See either for examples and a list of the available-functions.+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] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN) -}   #if defined(mingw32_HOST_OS) || defined(__MINGW32__)-module System.FilePath(module System.FilePath.Windows) where+module 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 System.FilePath.Windows #else-module System.FilePath(module System.FilePath.Posix) where+module 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 System.FilePath.Posix #endif
System/FilePath/Internal.hs view
@@ -747,6 +747,7 @@  -- | Join path elements back together. --+-- > joinPath a == foldr (</>) "" a -- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext" -- > Valid x => joinPath (splitPath x) == x -- > joinPath [] == ""@@ -768,9 +769,12 @@ --   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"@@ -835,10 +839,13 @@ -- -- * .\/ -> \"\" --+-- 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:\\"
System/FilePath/Posix.hs view
@@ -1,4 +1,1048 @@-{-# LANGUAGE CPP #-}-#define MODULE_NAME     Posix-#define IS_WINDOWS      False-#include "Internal.hs"++++{-# 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] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (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+--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > 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:\<path>" or "\\?\UNC\<server>\<share>"+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+--   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.+--+--   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)
System/FilePath/Windows.hs view
@@ -1,4 +1,1048 @@-{-# LANGUAGE CPP #-}-#define MODULE_NAME     Windows-#define IS_WINDOWS      True-#include "Internal.hs"++++{-# 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] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (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+--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > 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:\<path>" or "\\?\UNC\<server>\<share>"+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+--   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.+--+--   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)
changelog.md view
@@ -2,6 +2,28 @@  _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ +## 1.4.2.2 *Dec 2021*++This release is purely a documentation release, fixing the broken haddock links.++### Affected users++This release affects users who apply downstream patches to `System.FilePath.Internal`,+since `System.FilePath.Posix` and `System.FilePath.Windows` are now generated via `make cpp`+during development.++To make your patch apply, either apply it to `System.FilePath.Posix` and `System.FilePath.Windows`+instead or run `make cpp` after applying your patch.++### Changes++* Document relation between `joinPath` and `(</>)` wrt [#82](https://github.com/haskell/filepath/issues/82), [#82](https://github.com/haskell/filepath/issues/86)+* Clarify that `normalise` does not remove `..` wrt [#86](https://github.com/haskell/filepath/issues/86)+* Make clear that `equalFilePath` does not expand `..` wrt [#87](https://github.com/haskell/filepath/issues/87)+* Fix haddock source links by manually cpping wrt [#81](https://github.com/haskell/filepath/issues/81)+* Make export list in `System.FilePath` explicit to get haddocks on the landing module++ ## 1.4.2.1 *Jul 2018*   * Bundled with GHC 8.6.1
filepath.cabal view
@@ -1,18 +1,18 @@-cabal-version:  >= 1.18+cabal-version:  1.18 name:           filepath-version:        1.4.2.1+version:        1.4.2.2 -- NOTE: Don't forget to update ./changelog.md license:        BSD3 license-file:   LICENSE author:         Neil Mitchell <ndmitchell@gmail.com>-maintainer:     Neil Mitchell <ndmitchell@gmail.com>-copyright:      Neil Mitchell 2005-2018+maintainer:     Julian Ospald <hasufell@posteo.de>+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==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+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 description:     This package provides functionality for manipulating @FilePath@ values, and is shipped with both <https://www.haskell.org/ghc/ GHC> and the <https://www.haskell.org/platform/ Haskell Platform>. It provides three modules:     .@@ -26,8 +26,10 @@  extra-source-files:     System/FilePath/Internal.hs+    Makefile extra-doc-files:     README.md+    HACKING.md     changelog.md  source-repository head@@ -48,7 +50,7 @@         System.FilePath.Windows      build-depends:-        base >= 4 && < 4.13+        base >= 4.9 && < 4.17      ghc-options: -Wall @@ -56,7 +58,6 @@     type: exitcode-stdio-1.0     default-language: Haskell2010     main-is: Test.hs-    ghc-options: -main-is Test     hs-source-dirs: tests     other-modules:         TestGen@@ -64,4 +65,4 @@     build-depends:         filepath,         base,-        QuickCheck >= 2.7 && < 2.12+        QuickCheck >= 2.7 && < 2.15
tests/Test.hs view
@@ -1,5 +1,5 @@ -module Test(main) where+module Main where  import System.Environment import TestGen@@ -19,8 +19,8 @@         putStrLn $ "Test " ++ show i ++ " of " ++ show total ++ ": " ++ msg         res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop         case res of-            Success{} -> return Nothing-            bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; return $ Just (msg,bad)+            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
tests/TestGen.hs view
@@ -346,6 +346,8 @@     ,("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)@@ -359,6 +361,8 @@     ,("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"))@@ -388,6 +392,7 @@     ,("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:\\")