posix-paths (empty) → 0.1.0.0

raw patch · 10 files changed

+919/−0 lines, 10 filesdep +basedep +bytestringdep +criterionsetup-changed

Dependencies added: base, bytestring, criterion, directory, doctest, filepath, posix-paths, process, unix

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• benchmarks/Bench.hs +87/−0
• cbits/dirutils.c +7/−0
• cbits/dirutils.h +13/−0
• doctests.hs +5/−0
• posix-paths.cabal +62/−0
• src/System/Posix/Directory/Foreign.hsc +25/−0
• src/System/Posix/Directory/Traversals.hs +220/−0
• src/System/Posix/FilePath.hs +468/−0

@@ -0,0 +1,30 @@+Copyright (c) 2013, John Lato++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of John Lato nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,87 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wall #-}+import Control.Applicative+import Control.Monad+import System.Directory+import System.FilePath ((</>))+import System.Posix.ByteString.FilePath+import System.Posix.Directory.ByteString as PosixBS+import System.Posix.Directory.Traversals+import qualified System.Posix.FilePath as PosixBS+import System.Posix.Files.ByteString++import Control.Exception+import qualified Data.ByteString.Char8 as BS++import System.Environment (getArgs, withArgs)+import System.IO.Error+import System.IO.Unsafe+import System.Process (system)+import Criterion.Main+++listFilesRecursive :: FilePath -> IO [FilePath]+listFilesRecursive topdir = do+    names <- System.Directory.getDirectoryContents topdir+    let properNames = filter (`notElem` [".", ".."]) names+    paths <- forM properNames $ \name -> do+        let path = topdir </> name+        isDir <- doesDirectoryExist path+        if isDir+            then listFilesRecursive path+            else return [path]+    return (topdir : concat paths)++----------------------------------------------------------++getDirectoryContentsBS :: RawFilePath -> IO [RawFilePath]+getDirectoryContentsBS path = +  modifyIOError ((`ioeSetFileName` (BS.unpack path)) .+                 (`ioeSetLocation` "getDirectoryContentsBS")) $ do+    bracket+      (PosixBS.openDirStream path)+      PosixBS.closeDirStream+      loop+ where+  loop dirp = do+     e <- PosixBS.readDirStream dirp+     if BS.null e then return [] else do+       es <- loop dirp+       return (e:es)+++listFilesRecursiveBS :: RawFilePath -> IO [RawFilePath]+listFilesRecursiveBS topdir = do+    names <- getDirectoryContentsBS topdir+    let properNames = filter (`notElem` [".", ".."]) names+    paths <- forM properNames $ \name -> unsafeInterleaveIO $ do+        let path = PosixBS.combine topdir name+        isDir <- isDirectory <$> getFileStatus path+        if isDir+            then listFilesRecursiveBS path+            else return [path]+    return (topdir : concat paths)+----------------------------------------------------------+++benchTraverse :: RawFilePath -> IO ()+benchTraverse = traverseDirectory (\() p -> BS.putStrLn p) ()++main :: IO ()+main = do+  args <- getArgs+  let (d,otherArgs) = case args of+          []   -> ("/usr/local",[])+          x:xs -> (x,xs)+  withArgs otherArgs $ defaultMain+    [ bench "traverse (FilePath)"      $ nfIO $ listFilesRecursive d >>= mapM_ putStrLn+    , bench "traverse (RawFilePath)"   $ nfIO $ listFilesRecursiveBS (BS.pack d) >>= mapM_ BS.putStrLn+    , bench "allDirectoryContents"     $ nfIO $ allDirectoryContents (BS.pack d) >>= mapM_ BS.putStrLn+    , bench "allDirectoryContents'"    $ nfIO $ allDirectoryContents' (BS.pack d) >>= mapM_ BS.putStrLn+    , bench "traverseDirectory"        $ nfIO $ benchTraverse (BS.pack d)+    , bench "unix find"                $ nfIO $ void $ system ("find " ++ d)+    ]

@@ -0,0 +1,7 @@+#include "dirutils.h"+unsigned int+    __posixdir_d_type(struct dirent* d)+    {+      return(d -> d_type);+    }+

@@ -0,0 +1,13 @@+#ifndef POSIXPATHS_CBITS_DIRUTILS_H+#define POSIXPATHS_CBITS_DIRUTILS_H++#include <stdlib.h>+#include <dirent.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++extern unsigned int+    __posixdir_d_type(struct dirent* d)+    ;+#endif

@@ -0,0 +1,5 @@+module Main where++import Test.DocTest++main = doctest ["-isrc", "-XOverloadedStrings", "src/System/Posix/FilePath"]

@@ -0,0 +1,62 @@+name:		posix-paths+version:        0.1.0.0+license:	BSD3+license-file:	LICENSE+maintainer:	jwlato@gmail.com+bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries/unix+synopsis:	POSIX filepath/directory functionality+category:       System+description:+	This package gives access to certain POSIX-based Filepath/Directory+  services.  +	.+	The package is not supported under Windows (except under Cygwin).+extra-source-files: cbits/dirutils.h+                    doctests.hs+                    benchmarks/*.hs+extra-tmp-files:+build-type: Simple+Cabal-Version: >= 1.14++Library+    hs-source-dirs:     src+    default-language:   Haskell2010+    c-sources:          cbits/dirutils.c+    exposed-modules:    System.Posix.Directory.Foreign,+                        System.Posix.Directory.Traversals,+                        System.Posix.FilePath+    build-depends:      base >= 4.2 && < 4.7,+                        bytestring >= 0.9.2.0 && < 0.11,+                        unix >= 2.5 && < 2.7++test-suite doctests+    default-language:   Haskell2010+    type:               exitcode-stdio-1.0+    ghc-options:        -threaded+    main-is:            doctests.hs+    build-depends:      base,+                        bytestring,+                        unix,+                        posix-paths,+                        doctest >= 0.8++benchmark bench.hs+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: benchmarks+  main-is:        Bench.hs++  build-depends:+      base,+      posix-paths,+      bytestring,+      unix,+      directory  >= 1.1 && < 1.3,+      filepath   >= 1.2 && < 1.4,+      process    >= 1.0 && < 1.2,+      criterion  >= 0.6 && < 0.7+  ghc-options: -O2++source-repository head+  type:                git+  location:            git://github.com/JohnLato/posix-paths.git

@@ -0,0 +1,25 @@+module System.Posix.Directory.Foreign where++import Data.Bits+import Data.List (foldl')+import Foreign.C.Types++#include <limits.h>+#include <stdlib.h>+#include <dirent.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++newtype DirType = DirType Int deriving (Eq, Show)+newtype Flags = Flags { unFlags :: Int } deriving (Eq, Show)++#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN}++#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CLOEXEC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC}++pathMax :: Int+pathMax = #{const PATH_MAX}++unionFlags :: [Flags] -> CInt+unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0

@@ -0,0 +1,220 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wall #-}+module System.Posix.Directory.Traversals (++  getDirectoryContents++, allDirectoryContents+, allDirectoryContents'+, traverseDirectory++-- lower-level stuff+, openAt+, fdOpendir+, readDirEnt+, packDirStream+, unpackDirStream++, realpath+) where++import Control.Applicative+import Control.Monad+import System.Posix.FilePath ((</>))+import System.Posix.Directory.Foreign++import qualified System.Posix as Posix+import qualified System.Posix.IO.ByteString as PosixBS+import System.IO.Error+import Control.Exception+import qualified Data.ByteString.Char8 as BS+import System.Posix.ByteString.FilePath+import System.Posix.Directory.ByteString as PosixBS+import System.Posix.Files.ByteString++import System.IO.Unsafe+import Unsafe.Coerce (unsafeCoerce)+import Foreign.C.Error+import Foreign.C.String+import Foreign.C.Types+import Foreign.Marshal.Alloc (alloca,allocaBytes)+import Foreign.Ptr+import Foreign.Storable++----------------------------------------------------------++-- | Get all files from a directory and its subdirectories.+--+-- Upon entering a directory, 'allDirectoryContents' will get all entries+-- strictly.  However the returned list is lazy in that directories will only+-- be accessed on demand.+allDirectoryContents :: RawFilePath -> IO [RawFilePath]+allDirectoryContents topdir = do+    namesAndTypes <- getDirectoryContents topdir+    let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes+    paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do+        let path = topdir </> name+        case () of+            () | typ == dtDir -> allDirectoryContents path+               | typ == dtUnknown -> do+                    isDir <- isDirectory <$> getFileStatus path+                    if isDir+                        then allDirectoryContents path+                        else return [path]+               | otherwise -> return [path]+    return (topdir : concat paths)++-- | Get all files from a directory and its subdirectories strictly.+--+allDirectoryContents' :: RawFilePath -> IO [RawFilePath]+allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []+-- this uses traverseDirectory because it's more efficient than forcing the+-- lazy version.++-- recursively apply the 'action' to the parent directory and all+-- files/subdirectories.+traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s+traverseDirectory act s0 topdir = bracket someOpenFunc Posix.closeFd toploop+  where+    someOpenFunc = PosixBS.openFd topdir Posix.ReadOnly Nothing+                      (Posix.defaultFileFlags {Posix.nonBlock = True, Posix.noctty = True})+    toploop fd = do+        isDir <- isDirectory <$> getFileStatus topdir+        s' <- act s0 topdir+        if isDir then actOnDirContents fd "." s' (loop topdir)+                 else return s'++    loop relpath typ fd path acc = do+        let fullpath = relpath </> path+        isDir <- case () of+            () | typ == dtDir     -> return True+               | typ == dtUnknown -> isDirectory <$> getFileStatus fullpath+               | otherwise        -> return False+        if isDir+          then act acc path >>= \acc' -> actOnDirContents fd path acc' (loop fullpath)+          else act acc path+++actOnDirContents :: Posix.Fd -> RawFilePath -> b -> (DirType -> Posix.Fd -> RawFilePath -> b -> IO b) -> IO b+actOnDirContents dirFd relpath b f =+  modifyIOError ((`ioeSetFileName` (BS.unpack relpath)) .+                 (`ioeSetLocation` "findBSTypRel")) $ do+    bracket+      (openAt dirFd relpath)+      (Posix.closeFd)+      (\p -> fdOpendir p >>= \dirp -> loop p dirp b)+ where+  loop fd dirp b' = do+    (typ,e) <- readDirEnt dirp+    if (e == "")+      then return b'+      else do+          if (e == "." || e == "..") +              then loop fd dirp b'+              else f typ fd e b' >>= loop fd dirp++----------------------------------------------------------+-- dodgy stuff++type CDir = ()+type CDirent = ()++-- Posix doesn't export DirStream, so to re-use that type we need to use+-- unsafeCoerce.  It's just a newtype, so this is a legitimate usage.+-- ugly trick.+unpackDirStream :: DirStream -> Ptr CDir+unpackDirStream = unsafeCoerce++packDirStream :: Ptr CDir -> DirStream+packDirStream = unsafeCoerce++-- the __hscore_* functions are defined in the unix package.  We can import them and let+-- the linker figure it out.+foreign import ccall unsafe "__hscore_readdir"+  c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt++foreign import ccall unsafe "__hscore_free_dirent"+  c_freeDirEnt  :: Ptr CDirent -> IO ()++foreign import ccall unsafe "__hscore_d_name"+  c_name :: Ptr CDirent -> IO CString++foreign import ccall unsafe "__posixdir_d_type"+  c_type :: Ptr CDirent -> IO DirType++foreign import ccall unsafe "fdopendir"+  c_fdopendir :: Posix.Fd -> IO (Ptr ())++foreign import ccall unsafe "openat"+  c_openat :: Posix.Fd -> CString -> CInt -> IO Posix.Fd++foreign import ccall "realpath"+  c_realpath :: CString -> CString -> IO CString++fdOpendir :: Posix.Fd -> IO DirStream+fdOpendir fd =+    packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)++openAt :: Posix.Fd -> RawFilePath -> IO Posix.Fd+openAt relfd path =+    BS.useAsCString path $ throwErrnoIfMinus1Retry "openAt" . flip (c_openat relfd) defFlags+  where+    defFlags = unionFlags [oRdonly, oNonblock, oDirectory, oCloexec]++----------------------------------------------------------+-- less dodgy but still lower-level++readDirEnt :: DirStream -> IO (DirType, RawFilePath)+readDirEnt (unpackDirStream -> dirp) =+  alloca $ \ptr_dEnt  -> loop ptr_dEnt+ where+  loop ptr_dEnt = do+    resetErrno+    r <- c_readdir dirp ptr_dEnt+    if (r == 0)+       then do+         dEnt <- peek ptr_dEnt+         if (dEnt == nullPtr)+            then return (dtUnknown,BS.empty)+            else do+                 dName <- c_name dEnt >>= peekFilePath+                 dType <- c_type dEnt+                 c_freeDirEnt dEnt+                 return (dType, dName)+       else do+         errno <- getErrno+         if (errno == eINTR)+            then loop ptr_dEnt+            else do+                 let (Errno eo) = errno+                 if (eo == 0)+                    then return (dtUnknown,BS.empty)+                    else throwErrno "readDirEnt"++getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]+getDirectoryContents path =+  modifyIOError ((`ioeSetFileName` (BS.unpack path)) .+                 (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do+    bracket+      (PosixBS.openDirStream path)+      PosixBS.closeDirStream+      loop+ where+  loop dirp = do+     t@(_typ,e) <- readDirEnt dirp+     if BS.null e then return [] else do+       es <- loop dirp+       return (t:es)++-- | return the canonicalized absolute pathname+--+-- like canonicalizePath, but uses realpath(3)+realpath :: RawFilePath -> IO RawFilePath+realpath inp = do+    allocaBytes pathMax $ \tmp -> do+        void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp+        BS.packCString tmp

@@ -0,0 +1,468 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wall #-}++module System.Posix.FilePath (++  pathSeparator+, isPathSeparator+, searchPathSeparator+, isSearchPathSeparator+, extSeparator+, isExtSeparator++, splitExtension+, takeExtension+, replaceExtension+, dropExtension+, addExtension+, hasExtension+, (<.>)+, splitExtensions+, dropExtensions+, takeExtensions++, splitFileName+, takeFileName+, replaceFileName+, dropFileName+, takeBaseName+, replaceBaseName+, takeDirectory+, replaceDirectory+, combine+, (</>)+, splitPath+, joinPath+, splitDirectories++, hasTrailingPathSeparator+, addTrailingPathSeparator+, dropTrailingPathSeparator++, isRelative+, isAbsolute++, module System.Posix.ByteString.FilePath+) where++import           Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import           System.Posix.ByteString.FilePath++import           Data.Char  (ord)+import           Data.Maybe (isJust)+import           Data.Word (Word8)++import           Control.Arrow (second)++-- $setup+-- >>> import Data.Char+-- >>> import Test.QuickCheck+-- >>> import Control.Applicative+-- >>> import qualified Data.ByteString as BS+-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary+-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack+--+-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral+++-- | Path separator charactor+pathSeparator :: Word8+pathSeparator = fromIntegral $ ord '/'++-- | Check if a charactor is the path separator+--+-- prop> \n ->  (_chr n == '/') == isPathSeparator n+isPathSeparator :: Word8 -> Bool+isPathSeparator = (== pathSeparator)++-- | Search path separator+searchPathSeparator :: Word8+searchPathSeparator = fromIntegral $ ord ':'++-- | Check if a charactor is the search path separator+--+-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n+isSearchPathSeparator :: Word8 -> Bool+isSearchPathSeparator = (== searchPathSeparator)++-- | File extension separator+extSeparator :: Word8+extSeparator = fromIntegral $ ord '.'++-- | Check if a charactor is the file extension separator+--+-- prop> \n -> (_chr n == '.') == isExtSeparator n+isExtSeparator :: Word8 -> Bool+isExtSeparator = (== extSeparator)++------------------------+-- extension stuff++-- | Split a 'RawFilePath' into a path+filename and extension+--+-- >>> splitExtension "file.exe"+-- ("file",".exe")+--+-- >>> splitExtension "file"+-- ("file","")+--+-- >>> splitExtension "/path/file.tar.gz"+-- ("/path/file.tar",".gz")+--+-- prop> \path -> uncurry (BS.append) (splitExtension path) == path+splitExtension :: RawFilePath -> (RawFilePath, ByteString)+splitExtension x = if BS.null basename+    then (x,"")+    else (BS.concat [path,BS.init basename],BS.cons extSeparator fileExt)+  where+    (path,file) = splitFileNameRaw x+    (basename,fileExt) = BS.breakEnd isExtSeparator file++-- | Get the final extension from a 'RawFilePath'+--+-- >>> takeExtension "file.exe"+-- ".exe"+--+-- >>> takeExtension "file"+-- ""+--+-- >>> takeExtension "/path/file.tar.gz"+-- ".gz"+takeExtension :: RawFilePath -> ByteString+takeExtension = snd . splitExtension++-- | Change a file's extension+--+-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path+replaceExtension :: RawFilePath -> ByteString -> RawFilePath+replaceExtension path ext = dropExtension path <.> ext++-- | Drop the final extension from a 'RawFilePath'+--+-- >>> dropExtension "file.exe"+-- "file"+--+-- >>> dropExtension "file"+-- "file"+--+-- >>> dropExtension "/path/file.tar.gz"+-- "/path/file.tar"+dropExtension :: RawFilePath -> RawFilePath+dropExtension = fst . splitExtension++-- | Add an extension to a 'RawFilePath'+--+-- >>> addExtension "file" ".exe"+-- "file.exe"+--+-- >>> addExtension "file.tar" ".gz"+-- "file.tar.gz"+--+-- >>> addExtension "/path/" ".ext"+-- "/path/.ext"+addExtension :: RawFilePath -> ByteString -> RawFilePath+addExtension file ext+    | BS.null ext = file+    | isExtSeparator (BS.head ext) = BS.concat [file, ext]+    | otherwise = BS.concat [file, BS.singleton extSeparator, ext]+++-- | Operator version of 'addExtension'+(<.>) :: RawFilePath -> ByteString -> RawFilePath+(<.>) = addExtension++-- | Check if a 'RawFilePath' has an extension+-- >>> hasExtension "file"+-- False+--+-- >>> hasExtension "file.tar"+-- True+--+-- >>> hasExtension "/path.part1/"+-- False+hasExtension :: RawFilePath -> Bool+hasExtension = isJust . BS.elemIndex extSeparator . takeFileName++-- | Split a 'RawFilePath' on the first extension+--+-- >>> splitExtensions "/path/file.tar.gz"+-- ("/path/file",".tar.gz")+--+-- prop> \path -> uncurry addExtension (splitExtensions path) == path+splitExtensions :: RawFilePath -> (RawFilePath, ByteString)+splitExtensions x = if BS.null basename+    then (x,"")+    else (BS.concat [path,basename],fileExt)+  where+    (path,file) = splitFileNameRaw x+    (basename,fileExt) = BS.break isExtSeparator file++-- | Remove all extensions from a 'RawFilePath'+--+-- >>> dropExtensions "/path/file.tar.gz"+-- "/path/file"+dropExtensions :: RawFilePath -> RawFilePath+dropExtensions = fst . splitExtensions++-- | Take all extensions from a 'RawFilePath'+--+-- >>> takeExtensions "/path/file.tar.gz"+-- ".tar.gz"+takeExtensions :: RawFilePath -> ByteString+takeExtensions = snd . splitExtensions++------------------------+-- more stuff++-- Split a 'RawFilePath' into (path,file).  'combine' is the inverse+--+-- >>> splitFileName "path/file.txt"+-- ("path/","file.txt")+--+-- >>> splitFileName "path/"+-- ("path/","")+--+-- >>> splitFileName "file.txt"+-- ("./","file.txt")+--+-- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./"+splitFileName :: RawFilePath -> (RawFilePath, RawFilePath)+splitFileName x = if BS.null path+    then ("./", file)+    else (path,file)+  where+    (path,file) = splitFileNameRaw x++-- | Get the file name+--+-- >>> takeFileName "path/file.txt"+-- "file.txt"+--+-- >>> takeFileName "path/"+-- ""+takeFileName :: RawFilePath -> RawFilePath+takeFileName = snd . splitFileName++-- | Change the file name+--+-- prop> \path -> replaceFileName path (takeFileName path) == path+replaceFileName :: RawFilePath -> ByteString -> RawFilePath+replaceFileName x y = fst (splitFileNameRaw x) </> y++-- | Drop the file name+--+-- >>> dropFileName "path/file.txt"+-- "path/"+--+-- >>> dropFileName "file.txt"+-- "./"+dropFileName :: RawFilePath -> RawFilePath+dropFileName = fst . splitFileName++-- | Get the file name, without a trailing extension+--+-- >>> takeBaseName "path/file.tar.gz"+-- "file.tar"+--+-- >>> takeBaseName ""+-- ""+takeBaseName :: RawFilePath -> ByteString+takeBaseName = dropExtension . takeFileName++-- | Change the base name+--+-- >>> replaceBaseName "path/file.tar.gz" "bob"+-- "path/bob.gz"+--+-- prop> \path -> replaceBaseName path (takeBaseName path) == path+replaceBaseName :: RawFilePath -> ByteString -> RawFilePath+replaceBaseName path name = combineRaw dir (name <.> ext)+  where+    (dir,file) = splitFileNameRaw path+    ext = takeExtension file++-- | Get the directory, moving up one level if it's already a directory+--+-- >>> takeDirectory "path/file.txt"+-- "path"+--+-- >>> takeDirectory "file"+-- "."+--+-- >>> takeDirectory "/path/to/"+-- "/path/to"+--+-- >>> takeDirectory "/path/to"+-- "/path"+takeDirectory :: RawFilePath -> RawFilePath+takeDirectory x = case () of+    () | x == "/" -> x+       | BS.null res && not (BS.null file) -> file+       | otherwise -> res+  where+    res = fst $ BS.spanEnd isPathSeparator file+    file = dropFileName x++-- | Change the directory component of a 'RawFilePath'+--+-- prop> \path -> replaceDirectory path (takeDirectory path) `_equalFilePath` path || takeDirectory path == "."+replaceDirectory :: RawFilePath -> ByteString -> RawFilePath+replaceDirectory file dir = combineRaw dir (takeFileName file)++-- | Join two paths together+--+-- >>> combine "/" "file"+-- "/file"+-- >>> combine "/path/to" "file"+-- "/path/to/file"+-- >>> combine "file" "/absolute/path"+-- "/absolute/path"+combine :: RawFilePath -> RawFilePath -> RawFilePath+combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b+            | otherwise = combineRaw a b++-- | Operator version of combine+(</>) :: RawFilePath -> RawFilePath -> RawFilePath+(</>) = combine++-- | Split a path into a list of components:+--+-- >>> splitPath "/path/to/file.txt"+-- ["/","path/","to/","file.txt"]+--+-- prop> \path -> BS.concat (splitPath path) == path+splitPath :: RawFilePath -> [RawFilePath]+splitPath = splitter+  where+    splitter x+      | BS.null x = []+      | otherwise = case BS.elemIndex pathSeparator x of+            Nothing -> [x]+            Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of+                          Nothing -> [x]+                          Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x++-- | Like 'splitPath', but without trailing slashes+--+-- >>> splitDirectories "/path/to/file.txt"+-- ["/","path","to","file.txt"]+-- >>> splitDirectories ""+-- []+splitDirectories :: RawFilePath -> [RawFilePath]+splitDirectories x+    | BS.null x = []+    | isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x+                                    in root : splitter rest+    | otherwise = splitter x+  where+    splitter = filter (not . BS.null) . BS.split pathSeparator++-- | Join a split path back together+--+-- prop> \path -> joinPath (splitPath path) == path+--+-- >>> joinPath ["path","to","file.txt"]+-- "path/to/file.txt"+joinPath :: [RawFilePath] -> RawFilePath+joinPath = foldr (</>) BS.empty+++------------------------+-- trailing path separators++-- | Check if the last character of a 'RawFilePath' is '/', unless it's the+-- root.+--+-- >>> hasTrailingPathSeparator "/path/"+-- True+-- >>> hasTrailingPathSeparator "/"+-- False+hasTrailingPathSeparator :: RawFilePath -> Bool+hasTrailingPathSeparator x+    | BS.null x = False+    | x == "/"  = False+    | otherwise = isPathSeparator $ BS.last x++-- | Add a trailing path separator.+--+-- >>> addTrailingPathSeparator "/path"+-- "/path/"+--+-- >>> addTrailingPathSeparator "/path/"+-- "/path/"+addTrailingPathSeparator :: RawFilePath -> RawFilePath+addTrailingPathSeparator x = if hasTrailingPathSeparator x+    then x+    else x `BS.snoc` pathSeparator++-- | Remove a trailing path separator+--+-- >>> dropTrailingPathSeparator "/path/"+-- "/path"+--+-- >>> dropTrailingPathSeparator "/"+-- "/"+dropTrailingPathSeparator :: RawFilePath -> RawFilePath+dropTrailingPathSeparator x = if hasTrailingPathSeparator x+    then BS.init x+    else x++------------------------+-- Filename/system stuff++-- | Check if a path is absolute+--+-- >>> isAbsolute "/path"+-- True+-- >>> isAbsolute "path"+-- False+-- >>> isAbsolute ""+-- False+isAbsolute :: RawFilePath -> Bool+isAbsolute x+    | BS.length x > 0 = isPathSeparator (BS.head x)+    | otherwise = False++-- | Check if a path is relative+--+-- prop> \path -> isRelative path /= isAbsolute path+isRelative :: RawFilePath -> Bool+isRelative = not . isAbsolute++------------------------+-- internal stuff++-- Just split the input FileName without adding/normalizing or changing+-- anything.+splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)+splitFileNameRaw x = BS.breakEnd isPathSeparator x++-- | Combine two paths, assuming rhs is NOT absolute.+combineRaw :: RawFilePath -> RawFilePath -> RawFilePath+combineRaw a b | BS.null a = b+                  | BS.null b = a+                  | isPathSeparator (BS.last a) = BS.concat [a, b]+                  | otherwise = BS.concat [a,BS.singleton pathSeparator, b]++-- | we don't even attempt to fully normalize file paths, this is just enough+-- equality to test some operations.+--+_equalFilePath :: RawFilePath -> RawFilePath -> Bool+_equalFilePath a b = norm a == norm b+  where+    norm = dropDups . dropTrailingSlash . dropInitialDot+    dropTrailingSlash path+        | BS.length path >= 2 && isPathSeparator (BS.last path) = BS.init path+        | otherwise = path+    dropInitialDot path+        | BS.length path >= 2 && BS.take 2 path == "./" = BS.drop 2 path+        | otherwise = path+    dropDups = joinPath . map f . splitPath+    f component+        | BS.isSuffixOf "//" component = BS.init component+        | otherwise = component