packages feed

directory 1.3.7.1 → 1.3.11.0

raw patch · 49 files changed

Files

System/Directory.hs view
@@ -1,10 +1,3 @@-{-# LANGUAGE CPP #-}--#if !MIN_VERSION_base(4, 8, 0)--- In base-4.8.0 the Foreign module became Safe-{-# LANGUAGE Trustworthy #-}-#endif- ----------------------------------------------------------------------------- -- | -- Module      :  System.Directory@@ -15,7 +8,7 @@ -- Stability   :  stable -- Portability :  portable ----- System-independent interface to directory manipulation.+-- System-independent interface to directory manipulation (FilePath API). -- ----------------------------------------------------------------------------- @@ -47,6 +40,9 @@     , getUserDocumentsDirectory     , getTemporaryDirectory +    -- * PATH+    , getExecSearchPath+     -- * Actions on files     , removeFile     , renameFile@@ -113,21 +109,9 @@ import Prelude () import System.Directory.Internal import System.Directory.Internal.Prelude-import System.FilePath-  ( (<.>)-  , (</>)-  , addTrailingPathSeparator-  , dropTrailingPathSeparator-  , hasTrailingPathSeparator-  , isAbsolute-  , joinPath-  , makeRelative-  , splitDirectories-  , splitSearchPath-  , takeDirectory-  ) import Data.Time (UTCTime)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import System.OsPath (decodeFS, encodeFS)+import qualified System.Directory.OsPath as D  {- $intro A directory contains a series of entries, each of which is a named@@ -178,7 +162,8 @@  been given to use them as part of a path, but not to examine the  directory contents. -Note that to change some, but not all permissions, a construct on the following lines must be used.+Note that to change some, but not all permissions, a construct on the+following lines must be used.  >  makeReadable f = do >     p <- getPermissions f@@ -221,9 +206,7 @@ -- -- * 'isDoesNotExistError' if the file or directory does not exist. getPermissions :: FilePath -> IO Permissions-getPermissions path =-  (`ioeAddLocation` "getPermissions") `modifyIOError` do-    getAccessPermissions (emptyToCurDir path)+getPermissions = encodeFS >=> D.getPermissions  -- | Set the permissions of a file or directory. --@@ -240,9 +223,7 @@ -- -- * 'isDoesNotExistError' if the file or directory does not exist. setPermissions :: FilePath -> Permissions -> IO ()-setPermissions path p =-  (`ioeAddLocation` "setPermissions") `modifyIOError` do-    setAccessPermissions (emptyToCurDir path) p+setPermissions path p = encodeFS path >>= (`D.setPermissions` p)  -- | Copy the permissions of one file to another.  This reproduces the -- permissions more accurately than using 'getPermissions' followed by@@ -252,16 +233,11 @@ -- -- On POSIX systems, this is equivalent to @stat@ followed by @chmod@. copyPermissions :: FilePath -> FilePath -> IO ()-copyPermissions src dst =-  (`ioeAddLocation` "copyPermissions") `modifyIOError` do-    m <- getFileMetadata src-    copyPermissionsFromMetadata m dst+copyPermissions src dst = do+  src' <- encodeFS src+  dst' <- encodeFS dst+  D.copyPermissions src' dst' -copyPermissionsFromMetadata :: Metadata -> FilePath -> IO ()-copyPermissionsFromMetadata m dst = do-  -- instead of setFileMode, setFilePermissions is used here-  -- this is to retain backward compatibility in copyPermissions-  setFilePermissions dst (modeFromMetadata m)  ----------------------------------------------------------------------------- -- Implementation@@ -304,53 +280,16 @@ -}  createDirectory :: FilePath -> IO ()-createDirectory = createDirectoryInternal+createDirectory = encodeFS >=> D.createDirectory  -- | @'createDirectoryIfMissing' parents dir@ creates a new directory -- @dir@ if it doesn\'t exist. If the first argument is 'True' -- the function will also create all parent directories if they are missing.-createDirectoryIfMissing :: Bool     -- ^ Create its parents too?-                         -> FilePath -- ^ The path to the directory you want to make-                         -> IO ()-createDirectoryIfMissing create_parents path0-  | create_parents = createDirs (parents path0)-  | otherwise      = createDirs (take 1 (parents path0))-  where-    parents = reverse . scanl1 (</>) . splitDirectories . simplify--    createDirs []         = pure ()-    createDirs (dir:[])   = createDir dir ioError-    createDirs (dir:dirs) =-      createDir dir $ \_ -> do-        createDirs dirs-        createDir dir ioError--    createDir dir notExistHandler = do-      r <- tryIOError (createDirectory dir)-      case r of-        Right ()                   -> pure ()-        Left  e-          | isDoesNotExistError  e -> notExistHandler e-          -- createDirectory (and indeed POSIX mkdir) does not distinguish-          -- between a dir already existing and a file already existing. So we-          -- check for it here. Unfortunately there is a slight race condition-          -- here, but we think it is benign. It could report an exception in-          -- the case that the dir did exist but another process deletes the-          -- directory and creates a file in its place before we can check-          -- that the directory did indeed exist.-          -- We also follow this path when we get a permissions error, as-          -- trying to create "." when in the root directory on Windows-          -- fails with-          --     CreateDirectory ".": permission denied (Access is denied.)-          -- This caused GHCi to crash when loading a module in the root-          -- directory.-          | isAlreadyExistsError e-         || isPermissionError    e -> do-              canIgnore <- pathIsDirectory dir-                             `catchIOError` \ _ ->-                               pure (isAlreadyExistsError e)-              unless canIgnore (ioError e)-          | otherwise              -> ioError e+createDirectoryIfMissing+  :: Bool     -- ^ Create its parents too?+  -> FilePath -- ^ The path to the directory you want to make+  -> IO ()+createDirectoryIfMissing cp = encodeFS >=> D.createDirectoryIfMissing cp   {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The@@ -395,7 +334,7 @@ -}  removeDirectory :: FilePath -> IO ()-removeDirectory = removePathInternal True+removeDirectory = encodeFS >=> D.removeDirectory  -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ -- together with its contents and subdirectories. Within this directory,@@ -406,45 +345,7 @@ -- This operation is reported to be flaky on Windows so retry logic may -- be advisable. See: https://github.com/haskell/directory/pull/108 removeDirectoryRecursive :: FilePath -> IO ()-removeDirectoryRecursive path =-  (`ioeAddLocation` "removeDirectoryRecursive") `modifyIOError` do-    m <- getSymbolicLinkMetadata path-    case fileTypeFromMetadata m of-      Directory ->-        removeContentsRecursive path-      DirectoryLink ->-        ioError (err `ioeSetErrorString` "is a directory symbolic link")-      _ ->-        ioError (err `ioeSetErrorString` "not a directory")-  where err = mkIOError InappropriateType "" Nothing (Just path)---- | @removePathRecursive path@ removes an existing file or directory at--- /path/ together with its contents and subdirectories. Symbolic links are--- removed without affecting their the targets.------ This operation is reported to be flaky on Windows so retry logic may--- be advisable. See: https://github.com/haskell/directory/pull/108-removePathRecursive :: FilePath -> IO ()-removePathRecursive path =-  (`ioeAddLocation` "removePathRecursive") `modifyIOError` do-    m <- getSymbolicLinkMetadata path-    case fileTypeFromMetadata m of-      Directory     -> removeContentsRecursive path-      DirectoryLink -> removeDirectory path-      _             -> removeFile path---- | @removeContentsRecursive dir@ removes the contents of the directory--- /dir/ recursively. Symbolic links are removed without affecting their the--- targets.------ This operation is reported to be flaky on Windows so retry logic may--- be advisable. See: https://github.com/haskell/directory/pull/108-removeContentsRecursive :: FilePath -> IO ()-removeContentsRecursive path =-  (`ioeAddLocation` "removeContentsRecursive") `modifyIOError` do-    cont <- listDirectory path-    traverse_ removePathRecursive [path </> x | x <- cont]-    removeDirectory path+removeDirectoryRecursive = encodeFS >=> D.removeDirectoryRecursive  -- | Removes a file or directory at /path/ together with its contents and -- subdirectories. Symbolic links are removed without affecting their@@ -465,31 +366,7 @@ -- -- @since 1.2.7.0 removePathForcibly :: FilePath -> IO ()-removePathForcibly path =-  (`ioeAddLocation` "removePathForcibly") `modifyIOError` do-    makeRemovable path `catchIOError` \ _ -> pure ()-    ignoreDoesNotExistError $ do-      m <- getSymbolicLinkMetadata path-      case fileTypeFromMetadata m of-        DirectoryLink -> removeDirectory path-        Directory     -> do-          names <- listDirectory path-          sequenceWithIOErrors_ $-            [ removePathForcibly (path </> name) | name <- names ] ++-            [ removeDirectory path ]-        _             -> removeFile path-  where--    ignoreDoesNotExistError :: IO () -> IO ()-    ignoreDoesNotExistError action =-      () <$ tryIOErrorType isDoesNotExistError action--    makeRemovable :: FilePath -> IO ()-    makeRemovable p = do-      perms <- getPermissions p-      setPermissions path perms{ readable = True-                               , searchable = True-                               , writable = True }+removePathForcibly = encodeFS >=> D.removePathForcibly  {- |'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. The@@ -526,7 +403,7 @@ -}  removeFile :: FilePath -> IO ()-removeFile = removePathInternal False+removeFile = encodeFS >=> D.removeFile  {- |@'renameDirectory' old new@ changes the name of an existing directory from /old/ to /new/.  If the /new/ directory@@ -578,22 +455,22 @@ -}  renameDirectory :: FilePath -> FilePath -> IO ()-renameDirectory opath npath =-   (`ioeAddLocation` "renameDirectory") `modifyIOError` do-     -- XXX this test isn't performed atomically with the following rename-     isDir <- pathIsDirectory opath-     when (not isDir) $ do-       ioError . (`ioeSetErrorString` "not a directory") $-         (mkIOError InappropriateType "renameDirectory" Nothing (Just opath))-     renamePath opath npath+renameDirectory opath npath = do+  opath' <- encodeFS opath+  npath' <- encodeFS npath+  D.renameDirectory opath' npath'  {- |@'renameFile' old new@ changes the name of an existing file system object from /old/ to /new/.  If the /new/ object already exists, it is replaced by the /old/ object.  Neither path may refer to an existing-directory.  A conformant implementation need not support renaming files-in all situations (e.g. renaming across different physical devices), but-the constraints must be documented.+directory. +A conformant implementation need not support renaming files in all situations+(e.g. renaming across different physical devices), but the constraints must be+documented. On Windows, this does not support renaming across different physical+devices; if you are looking to do so, consider using 'copyFileWithMetadata' and+'removeFile'.+ On Windows, this calls @MoveFileEx@ with @MOVEFILE_REPLACE_EXISTING@ set, which is not guaranteed to be atomic (<https://github.com/haskell/directory/issues/109>).@@ -637,26 +514,10 @@ -}  renameFile :: FilePath -> FilePath -> IO ()-renameFile opath npath =-  (`ioeAddLocation` "renameFile") `modifyIOError` do-    -- XXX the tests are not performed atomically with the rename-    checkNotDir opath-    renamePath opath npath-      -- The underlying rename implementation can throw odd exceptions when the-      -- destination is a directory.  For example, Windows typically throws a-      -- permission error, while POSIX systems may throw a resource busy error-      -- if one of the paths refers to the current directory.  In these cases,-      -- we check if the destination is a directory and, if so, throw an-      -- InappropriateType error.-      `catchIOError` \ err -> do-        checkNotDir npath-        ioError err-  where checkNotDir path = do-          m <- tryIOError (getSymbolicLinkMetadata path)-          case fileTypeIsDirectory . fileTypeFromMetadata <$> m of-            Right True -> ioError . (`ioeSetErrorString` "is a directory") $-                          mkIOError InappropriateType "" Nothing (Just path)-            _          -> pure ()+renameFile opath npath = do+  opath' <- encodeFS opath+  npath' <- encodeFS npath+  D.renameFile opath' npath'  -- | Rename a file or directory.  If the destination path already exists, it -- is replaced atomically.  The destination path must not point to an existing@@ -703,9 +564,10 @@ renamePath :: FilePath                  -- ^ Old path            -> FilePath                  -- ^ New path            -> IO ()-renamePath opath npath =-  (`ioeAddLocation` "renamePath") `modifyIOError` do-    renamePathInternal opath npath+renamePath opath npath = do+  opath' <- encodeFS opath+  npath' <- encodeFS npath+  D.renamePath opath' npath'  -- | Copy a file with its permissions.  If the destination file already exists, -- it is replaced atomically.  Neither path may refer to an existing@@ -714,45 +576,10 @@ copyFile :: FilePath                    -- ^ Source filename          -> FilePath                    -- ^ Destination filename          -> IO ()-copyFile fromFPath toFPath =-  (`ioeAddLocation` "copyFile") `modifyIOError` do-    atomicCopyFileContents fromFPath toFPath-      (ignoreIOExceptions . copyPermissions fromFPath)---- | Copy the contents of a source file to a destination file, replacing the--- destination file atomically via @withReplacementFile@, resetting the--- attributes of the destination file to the defaults.-atomicCopyFileContents :: FilePath            -- ^ Source filename-                       -> FilePath            -- ^ Destination filename-                       -> (FilePath -> IO ()) -- ^ Post-action-                       -> IO ()-atomicCopyFileContents fromFPath toFPath postAction =-  (`ioeAddLocation` "atomicCopyFileContents") `modifyIOError` do-    withReplacementFile toFPath postAction $ \ hTo -> do-      copyFileToHandle fromFPath hTo---- | A helper function useful for replacing files in an atomic manner.  The--- function creates a temporary file in the directory of the destination file,--- opens it, performs the main action with its handle, closes it, performs the--- post-action with its path, and finally replaces the destination file with--- the temporary file.  If an error occurs during any step of this process,--- the temporary file is removed and the destination file remains untouched.-withReplacementFile :: FilePath            -- ^ Destination file-                    -> (FilePath -> IO ()) -- ^ Post-action-                    -> (Handle -> IO a)    -- ^ Main action-                    -> IO a-withReplacementFile path postAction action =-  (`ioeAddLocation` "withReplacementFile") `modifyIOError` do-    mask $ \ restore -> do-      (tmpFPath, hTmp) <- openBinaryTempFile (takeDirectory path)-                                             ".copyFile.tmp"-      (`onException` ignoreIOExceptions (removeFile tmpFPath)) $ do-        r <- (`onException` ignoreIOExceptions (hClose hTmp)) $ do-          restore (action hTmp)-        hClose hTmp-        restore (postAction tmpFPath)-        renameFile tmpFPath path-        pure r+copyFile fromFPath toFPath = do+  fromFPath' <- encodeFS fromFPath+  toFPath' <- encodeFS toFPath+  D.copyFile fromFPath' toFPath'  -- | Copy a file with its associated metadata.  If the destination file -- already exists, it is overwritten.  There is no guarantee of atomicity in@@ -775,18 +602,11 @@ copyFileWithMetadata :: FilePath        -- ^ Source file                      -> FilePath        -- ^ Destination file                      -> IO ()-copyFileWithMetadata src dst =-  (`ioeAddLocation` "copyFileWithMetadata") `modifyIOError`-    copyFileWithMetadataInternal copyPermissionsFromMetadata-                                 copyTimesFromMetadata-                                 src-                                 dst+copyFileWithMetadata src dst = do+  src' <- encodeFS src+  dst' <- encodeFS dst+  D.copyFileWithMetadata src' dst' -copyTimesFromMetadata :: Metadata -> FilePath -> IO ()-copyTimesFromMetadata st dst = do-  let atime = accessTimeFromMetadata st-  let mtime = modificationTimeFromMetadata st-  setFileTimes dst (Just atime, Just mtime)  -- | Make a path absolute, normalize the path, and remove as many indirections -- from it as possible.  Any trailing path separators are discarded via@@ -852,73 +672,7 @@ -- are now performed on Windows. -- canonicalizePath :: FilePath -> IO FilePath-canonicalizePath = \ path ->-  ((`ioeAddLocation` "canonicalizePath") .-   (`ioeSetFileName` path)) `modifyIOError` do-    -- simplify does more stuff, like upper-casing the drive letter-    dropTrailingPathSeparator . simplify <$>-      (canonicalizePathWith attemptRealpath =<< prependCurrentDirectory path)-  where--    -- allow up to 64 cycles before giving up-    attemptRealpath realpath =-      attemptRealpathWith (64 :: Int) Nothing realpath-      <=< canonicalizePathSimplify--    -- n is a counter to make sure we don't run into an infinite loop; we-    -- don't try to do any cycle detection here because an adversary could DoS-    -- any arbitrarily clever algorithm-    attemptRealpathWith n mFallback realpath path =-      case mFallback of-        -- too many indirections ... giving up.-        Just fallback | n <= 0 -> pure fallback-        -- either mFallback == Nothing (first attempt)-        --     or n > 0 (still have some attempts left)-        _ -> realpathPrefix (reverse (zip prefixes suffixes))--      where--        segments = splitDirectories path-        prefixes = scanl1 (</>) segments-        suffixes = tail (scanr (</>) "" segments)--        -- try to call realpath on the largest possible prefix-        realpathPrefix candidates =-          case candidates of-            [] -> pure path-            (prefix, suffix) : rest -> do-              exist <- doesPathExist prefix-              if not exist-                -- never call realpath on an inaccessible path-                -- (to avoid bugs in system realpath implementations)-                -- try a smaller prefix instead-                then realpathPrefix rest-                else do-                  mp <- tryIOError (realpath prefix)-                  case mp of-                    -- realpath failed: try a smaller prefix instead-                    Left _ -> realpathPrefix rest-                    -- realpath succeeded: fine-tune the result-                    Right p -> realpathFurther (p </> suffix) p suffix--        -- by now we have a reasonable fallback value that we can use if we-        -- run into too many indirections; the fallback value is the same-        -- result that we have been returning in versions prior to 1.3.1.0-        -- (this is essentially the fix to #64)-        realpathFurther fallback p suffix =-          case splitDirectories suffix of-            [] -> pure fallback-            next : restSuffix -> do-              -- see if the 'next' segment is a symlink-              mTarget <- tryIOError (getSymbolicLinkTarget (p </> next))-              case mTarget of-                Left _ -> pure fallback-                Right target -> do-                  -- if so, dereference it and restart the whole cycle-                  let mFallback' = Just (fromMaybe fallback mFallback)-                  path' <- canonicalizePathSimplify-                             (p </> target </> joinPath restSuffix)-                  attemptRealpathWith (n - 1) mFallback' realpath path'+canonicalizePath = encodeFS >=> D.canonicalizePath >=> decodeFS  -- | Convert a path into an absolute path.  If the given path is relative, the -- current directory is prepended and then the combined result is normalized.@@ -932,27 +686,15 @@ -- @since 1.2.2.0 -- makeAbsolute :: FilePath -> IO FilePath-makeAbsolute path =-  ((`ioeAddLocation` "makeAbsolute") .-   (`ioeSetFileName` path)) `modifyIOError` do-    matchTrailingSeparator path . simplify <$> prependCurrentDirectory path---- | Add or remove the trailing path separator in the second path so as to--- match its presence in the first path.------ (internal API)-matchTrailingSeparator :: FilePath -> FilePath -> FilePath-matchTrailingSeparator path-  | hasTrailingPathSeparator path = addTrailingPathSeparator-  | otherwise                     = dropTrailingPathSeparator+makeAbsolute = encodeFS >=> D.makeAbsolute >=> decodeFS  -- | Construct a path relative to the current directory, similar to -- 'makeRelative'. -- -- The operation may fail with the same exceptions as 'getCurrentDirectory'. makeRelativeToCurrentDirectory :: FilePath -> IO FilePath-makeRelativeToCurrentDirectory x = do-  (`makeRelative` x) <$> getCurrentDirectory+makeRelativeToCurrentDirectory =+  encodeFS >=> D.makeRelativeToCurrentDirectory >=> decodeFS  -- | Given the name or path of an executable file, 'findExecutable' searches -- for such a file in a list of system-defined locations, which generally@@ -978,9 +720,7 @@ -- testing each file for executable permissions.  Details can be found in the -- documentation of 'findFileWith'. findExecutable :: String -> IO (Maybe FilePath)-findExecutable binary =-  listTHead-    (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)+findExecutable = encodeFS >=> D.findExecutable >=> (`for` decodeFS)  -- | Search for executable files in a list of system-defined locations, which -- generally includes @PATH@ and possibly more.@@ -995,9 +735,7 @@ -- -- @since 1.2.2.0 findExecutables :: String -> IO [FilePath]-findExecutables binary =-  listTToList-    (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)+findExecutables = encodeFS >=> D.findExecutables >=> (`for` decodeFS)  -- | Given a name or path, 'findExecutable' appends the 'exeExtension' to the -- query and searches for executable files in the list of given search@@ -1013,16 +751,11 @@ -- -- @since 1.2.4.0 findExecutablesInDirectories :: [FilePath] -> String -> IO [FilePath]-findExecutablesInDirectories path binary =-  listTToList (findExecutablesInDirectoriesLazy path binary)--findExecutablesInDirectoriesLazy :: [FilePath] -> String -> ListT IO FilePath-findExecutablesInDirectoriesLazy path binary =-  findFilesWithLazy isExecutable path (binary <.> exeExtension)---- | Test whether a file has executable permissions.-isExecutable :: FilePath -> IO Bool-isExecutable file = executable <$> getPermissions file+findExecutablesInDirectories path binary = do+  path' <- for path encodeFS+  binary' <- encodeFS binary+  D.findExecutablesInDirectories path' binary'+    >>= (`for` decodeFS)  -- | Search through the given list of directories for the given file. --@@ -1050,8 +783,13 @@ -- documentation of 'findFilesWith'. -- -- @since 1.2.6.0-findFileWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO (Maybe FilePath)-findFileWith f ds name = listTHead (findFilesWithLazy f ds name)+findFileWith+  :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO (Maybe FilePath)+findFileWith f ds name = do+  ds' <- for ds encodeFS+  name' <- encodeFS name+  D.findFileWith (decodeFS >=> f) ds' name'+    >>= (`for` decodeFS)  -- | @findFilesWith predicate dirs name@ searches through the list of -- directories (@dirs@) for files that have the given @name@ and satisfy the@@ -1072,42 +810,25 @@ -- -- @since 1.2.1.0 findFilesWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO [FilePath]-findFilesWith f ds name = listTToList (findFilesWithLazy f ds name)--findFilesWithLazy-  :: (FilePath -> IO Bool) -> [FilePath] -> String -> ListT IO FilePath-findFilesWithLazy f dirs path-  -- make sure absolute paths are handled properly irrespective of 'dirs'-  -- https://github.com/haskell/directory/issues/72-  | isAbsolute path = ListT (find [""])-  | otherwise       = ListT (find dirs)--  where--    find []       = pure Nothing-    find (d : ds) = do-      let p = d </> path-      found <- doesFileExist p `andM` f p-      if found-        then pure (Just (p, ListT (find ds)))-        else find ds+findFilesWith f ds name = do+  ds' <- for ds encodeFS+  name' <- encodeFS name+  res <- D.findFilesWith (decodeFS >=> f) ds' name'+  for res decodeFS  -- | Filename extension for executable files (including the dot if any) --   (usually @\"\"@ on POSIX systems and @\".exe\"@ on Windows or OS\/2). -- -- @since 1.2.4.0 exeExtension :: String-exeExtension = exeExtensionInternal+exeExtension = so D.exeExtension  -- | Similar to 'listDirectory', but always includes the special entries (@.@ -- and @..@).  (This applies to Windows as well.) -- -- The operation may fail with the same exceptions as 'listDirectory'. getDirectoryContents :: FilePath -> IO [FilePath]-getDirectoryContents path =-  ((`ioeSetFileName` path) .-   (`ioeAddLocation` "getDirectoryContents")) `modifyIOError` do-    getDirectoryContentsInternal path+getDirectoryContents = encodeFS >=> D.getDirectoryContents >=> (`for` decodeFS)  -- | @'listDirectory' dir@ returns a list of /all/ entries in /dir/ without -- the special entries (@.@ and @..@).@@ -1141,8 +862,7 @@ -- @since 1.2.5.0 -- listDirectory :: FilePath -> IO [FilePath]-listDirectory path = filter f <$> getDirectoryContents path-  where f filename = filename /= "." && filename /= ".."+listDirectory = encodeFS >=> D.listDirectory >=> (`for` decodeFS)  -- | Obtain the current working directory as an absolute path. --@@ -1178,12 +898,7 @@ -- The operating system has no notion of current working directory. -- getCurrentDirectory :: IO FilePath-getCurrentDirectory =-  (`ioeAddLocation` "getCurrentDirectory") `modifyIOError` do-    specializeErrorString-      "Current working directory no longer exists"-      isDoesNotExistError-      getCurrentDirectoryInternal+getCurrentDirectory = D.getCurrentDirectory >>= decodeFS  -- | Change the working directory to the given path. --@@ -1219,7 +934,7 @@ -- @[ENOTDIR]@ -- setCurrentDirectory :: FilePath -> IO ()-setCurrentDirectory = setCurrentDirectoryInternal+setCurrentDirectory = encodeFS >=> D.setCurrentDirectory  -- | Run an 'IO' action with the given working directory and restore the -- original working directory afterwards, even if the given action fails due@@ -1234,17 +949,13 @@                      -> IO a      -- ^ Action to be executed                      -> IO a withCurrentDirectory dir action =-  bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do-    setCurrentDirectory dir-    action+  encodeFS dir >>= (`D.withCurrentDirectory` action)  -- | Obtain the size of a file in bytes. -- -- @since 1.2.7.0 getFileSize :: FilePath -> IO Integer-getFileSize path =-  (`ioeAddLocation` "getFileSize") `modifyIOError` do-    fileSizeFromMetadata <$> getFileMetadata path+getFileSize = encodeFS >=> D.getFileSize  -- | Test whether the given path points to an existing filesystem object.  If -- the user lacks necessary permissions to search the parent directories, this@@ -1252,10 +963,7 @@ -- -- @since 1.2.7.0 doesPathExist :: FilePath -> IO Bool-doesPathExist path = do-  (True <$ getFileMetadata path)-    `catchIOError` \ _ ->-      pure False+doesPathExist = encodeFS >=> D.doesPathExist  {- |The operation 'doesDirectoryExist' returns 'True' if the argument file exists and is either a directory or a symbolic link to a directory,@@ -1263,25 +971,15 @@ -}  doesDirectoryExist :: FilePath -> IO Bool-doesDirectoryExist path = do-  pathIsDirectory path-    `catchIOError` \ _ ->-      pure False+doesDirectoryExist = encodeFS >=> D.doesDirectoryExist  {- |The operation 'doesFileExist' returns 'True' if the argument file exists and is not a directory, and 'False' otherwise. -}  doesFileExist :: FilePath -> IO Bool-doesFileExist path = do-  (not <$> pathIsDirectory path)-    `catchIOError` \ _ ->-      pure False+doesFileExist = encodeFS >=> D.doesFileExist -pathIsDirectory :: FilePath -> IO Bool-pathIsDirectory path =-  (`ioeAddLocation` "pathIsDirectory") `modifyIOError` do-    fileTypeIsDirectory . fileTypeFromMetadata <$> getFileMetadata path  -- | Create a /file/ symbolic link.  The target path can be either absolute or -- relative and need not refer to an existing file.  The order of arguments@@ -1313,10 +1011,12 @@   :: FilePath                           -- ^ path to the target file   -> FilePath                           -- ^ path of the link to be created   -> IO ()-createFileLink target link =-  (`ioeAddLocation` "createFileLink") `modifyIOError` do-    createSymbolicLink False target link+createFileLink target link = do+  target' <- encodeFS target+  link' <- encodeFS link+  D.createFileLink target' link' + -- | Create a /directory/ symbolic link.  The target path can be either -- absolute or relative and need not refer to an existing directory.  The -- order of arguments follows the POSIX convention.@@ -1348,9 +1048,10 @@   :: FilePath                           -- ^ path to the target directory   -> FilePath                           -- ^ path of the link to be created   -> IO ()-createDirectoryLink target link =-  (`ioeAddLocation` "createDirectoryLink") `modifyIOError` do-    createSymbolicLink True target link+createDirectoryLink target link = do+  target' <- encodeFS target+  link' <- encodeFS link+  D.createDirectoryLink target' link'  -- | Remove an existing /directory/ symbolic link. --@@ -1361,9 +1062,7 @@ -- -- @since 1.3.1.0 removeDirectoryLink :: FilePath -> IO ()-removeDirectoryLink path =-  (`ioeAddLocation` "removeDirectoryLink") `modifyIOError` do-    removePathInternal linkToDirectoryIsDirectory path+removeDirectoryLink = encodeFS >=> D.removeDirectoryLink  -- | Check whether an existing @path@ is a symbolic link.  If @path@ is a -- regular file or directory, 'False' is returned.  If @path@ does not exist@@ -1382,10 +1081,7 @@ -- -- @since 1.3.0.0 pathIsSymbolicLink :: FilePath -> IO Bool-pathIsSymbolicLink path =-  ((`ioeAddLocation` "pathIsSymbolicLink") .-   (`ioeSetFileName` path)) `modifyIOError` do-     fileTypeIsLink . fileTypeFromMetadata <$> getSymbolicLinkMetadata path+pathIsSymbolicLink = encodeFS >=> D.pathIsSymbolicLink  {-# DEPRECATED isSymbolicLink "Use 'pathIsSymbolicLink' instead" #-} isSymbolicLink :: FilePath -> IO Bool@@ -1405,9 +1101,7 @@ -- -- @since 1.3.1.0 getSymbolicLinkTarget :: FilePath -> IO FilePath-getSymbolicLinkTarget path =-  (`ioeAddLocation` "getSymbolicLinkTarget") `modifyIOError` do-    readSymbolicLink path+getSymbolicLinkTarget = encodeFS >=> D.getSymbolicLinkTarget >=> decodeFS  -- | Obtain the time at which the file or directory was last accessed. --@@ -1425,9 +1119,7 @@ -- @since 1.2.3.0 -- getAccessTime :: FilePath -> IO UTCTime-getAccessTime path =-  (`ioeAddLocation` "getAccessTime") `modifyIOError` do-    accessTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)+getAccessTime = encodeFS >=> D.getAccessTime  -- | Obtain the time at which the file or directory was last modified. --@@ -1443,9 +1135,7 @@ -- and the underlying filesystem supports them. -- getModificationTime :: FilePath -> IO UTCTime-getModificationTime path =-  (`ioeAddLocation` "getModificationTime") `modifyIOError` do-    modificationTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)+getModificationTime = encodeFS >=> D.getModificationTime  -- | Change the time at which the file or directory was last accessed. --@@ -1471,9 +1161,7 @@ -- @since 1.2.3.0 -- setAccessTime :: FilePath -> UTCTime -> IO ()-setAccessTime path atime =-  (`ioeAddLocation` "setAccessTime") `modifyIOError` do-    setFileTimes path (Just atime, Nothing)+setAccessTime path atime = encodeFS path >>= (`D.setAccessTime` atime)  -- | Change the time at which the file or directory was last modified. --@@ -1484,6 +1172,9 @@ -- -- * 'isDoesNotExistError' if the file or directory does not exist. --+-- * 'InvalidArgument' on FAT32 file system if the time is before+--   DOS Epoch (1 January 1980).+-- -- Some caveats for POSIX systems: -- -- * Not all systems support @utimensat@, in which case the function can only@@ -1500,16 +1191,7 @@ -- setModificationTime :: FilePath -> UTCTime -> IO () setModificationTime path mtime =-  (`ioeAddLocation` "setModificationTime") `modifyIOError` do-    setFileTimes path (Nothing, Just mtime)--setFileTimes :: FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()-setFileTimes _ (Nothing, Nothing) = return ()-setFileTimes path (atime, mtime) =-  ((`ioeAddLocation` "setFileTimes") .-   (`ioeSetFileName` path)) `modifyIOError` do-    setTimes (emptyToCurDir path)-             (utcTimeToPOSIXSeconds <$> atime, utcTimeToPOSIXSeconds <$> mtime)+  encodeFS path >>= (`D.setModificationTime` mtime)  {- | Returns the current user's home directory. @@ -1521,9 +1203,12 @@ On Unix, 'getHomeDirectory' behaves as follows:  * Returns $HOME env variable if set (including to an empty string).-* Otherwise uses home directory returned by `getpwuid_r` using the UID of the current proccesses user. This basically reads the /etc/passwd file. An empty home directory field is considered valid.+* Otherwise uses home directory returned by @getpwuid_r@ using the UID of the+  current process' user. This basically reads the @\/etc\/passwd@ file. An+  empty home directory field is considered valid. -On Windows, the system is queried for a suitable path; a typical path might be @C:\/Users\//\<user\>/@.+On Windows, the system is queried for a suitable path; a typical path might be+@C:\/Users\//\<user\>/@.  The operation may fail with: @@ -1535,9 +1220,7 @@ cannot be found. -} getHomeDirectory :: IO FilePath-getHomeDirectory =-  (`ioeAddLocation` "getHomeDirectory") `modifyIOError` do-    getHomeDirectoryInternal+getHomeDirectory = D.getHomeDirectory >>= decodeFS  -- | Obtain the paths to special directories for storing user-specific --   application data, configuration, and cache files, conforming to the@@ -1568,17 +1251,7 @@                                         --   to the path; if empty, the base                                         --   path is returned                 -> IO FilePath-getXdgDirectory xdgDir suffix =-  (`ioeAddLocation` "getXdgDirectory") `modifyIOError` do-    simplify . (</> suffix) <$> do-      env <- lookupEnv $ case xdgDir of-        XdgData   -> "XDG_DATA_HOME"-        XdgConfig -> "XDG_CONFIG_HOME"-        XdgCache  -> "XDG_CACHE_HOME"-        XdgState  -> "XDG_STATE_HOME"-      case env of-        Just path | isAbsolute path -> pure path-        _                           -> getXdgDirectoryFallback getHomeDirectory xdgDir+getXdgDirectory xdgDir = encodeFS >=> D.getXdgDirectory xdgDir >=> decodeFS  -- | Similar to 'getXdgDirectory' but retrieves the entire list of XDG -- directories.@@ -1589,14 +1262,7 @@ -- Refer to the docs of 'XdgDirectoryList' for more details. getXdgDirectoryList :: XdgDirectoryList -- ^ which special directory list                     -> IO [FilePath]-getXdgDirectoryList xdgDirs =-  (`ioeAddLocation` "getXdgDirectoryList") `modifyIOError` do-    env <- lookupEnv $ case xdgDirs of-      XdgDataDirs   -> "XDG_DATA_DIRS"-      XdgConfigDirs -> "XDG_CONFIG_DIRS"-    case env of-      Nothing    -> getXdgDirectoryListFallback xdgDirs-      Just paths -> pure (splitSearchPath paths)+getXdgDirectoryList = D.getXdgDirectoryList >=> (`for` decodeFS)  -- | Obtain the path to a special directory for storing user-specific --   application data (traditional Unix location).  Newer applications may@@ -1627,9 +1293,7 @@ getAppUserDataDirectory :: FilePath     -- ^ a relative path that is appended                                         --   to the path                         -> IO FilePath-getAppUserDataDirectory appName = do-  (`ioeAddLocation` "getAppUserDataDirectory") `modifyIOError` do-    getAppUserDataDirectoryInternal appName+getAppUserDataDirectory = encodeFS >=> D.getAppUserDataDirectory >=>decodeFS  {- | Returns the current user's document directory. @@ -1652,9 +1316,7 @@ cannot be found. -} getUserDocumentsDirectory :: IO FilePath-getUserDocumentsDirectory = do-  (`ioeAddLocation` "getUserDocumentsDirectory") `modifyIOError` do-    getUserDocumentsDirectoryInternal+getUserDocumentsDirectory = D.getUserDocumentsDirectory >>= decodeFS  {- | Returns the current directory for temporary files. @@ -1683,4 +1345,8 @@ The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath-getTemporaryDirectory = getTemporaryDirectoryInternal+getTemporaryDirectory = D.getTemporaryDirectory >>= decodeFS++-- | Get the contents of the @PATH@ environment variable.+getExecSearchPath :: IO [FilePath]+getExecSearchPath = D.getExecSearchPath >>= (`for` decodeFS)
System/Directory/Internal/C_utimensat.hsc view
@@ -1,3 +1,5 @@+{-# LANGUAGE CApiFFI #-}+ module System.Directory.Internal.C_utimensat where #include <HsDirectoryConfig.h> #ifdef HAVE_UTIMENSAT@@ -10,17 +12,16 @@ #ifdef HAVE_SYS_STAT_H # include <sys/stat.h> #endif-#include <System/Directory/Internal/utility.h> import Prelude () import System.Directory.Internal.Prelude import Data.Time.Clock.POSIX (POSIXTime)+import qualified System.Posix as Posix  data CTimeSpec = CTimeSpec EpochTime CLong  instance Storable CTimeSpec where     sizeOf    _ = #{size struct timespec}-    -- workaround (hsc2hs for GHC < 8.0 doesn't support #{alignment ...})-    alignment _ = #{size char[alignof(struct timespec)] }+    alignment _ = #{alignment struct timespec}     poke p (CTimeSpec sec nsec) = do       (#poke struct timespec, tv_sec)  p sec       (#poke struct timespec, tv_nsec) p nsec@@ -29,9 +30,6 @@       nsec <- #{peek struct timespec, tv_nsec} p       return (CTimeSpec sec nsec) -c_AT_FDCWD :: CInt-c_AT_FDCWD = (#const AT_FDCWD)- utimeOmit :: CTimeSpec utimeOmit = CTimeSpec (CTime 0) (#const UTIME_OMIT) @@ -41,7 +39,7 @@     (sec,  frac)  = if frac' < 0 then (sec' - 1, frac' + 1) else (sec', frac')     (sec', frac') = properFraction (toRational t) -foreign import ccall "utimensat" c_utimensat-  :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt+foreign import capi "sys/stat.h utimensat" c_utimensat+  :: Posix.Fd -> CString -> Ptr CTimeSpec -> CInt -> IO CInt  #endif
System/Directory/Internal/Common.hs view
@@ -1,18 +1,36 @@-module System.Directory.Internal.Common where+{-# LANGUAGE CPP #-}+module System.Directory.Internal.Common+  ( module System.Directory.Internal.Common+  , OsPath+  , OsString+  ) where import Prelude () import System.Directory.Internal.Prelude-import System.FilePath-  ( addTrailingPathSeparator+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))+import GHC.IO.Encoding.UTF16 (mkUTF16le)+import GHC.IO.Encoding.UTF8 (mkUTF8)+import qualified System.File.OsPath.Internal as File+import System.OsPath+  ( OsPath+  , OsString+  , addTrailingPathSeparator+  , decodeUtf+  , decodeWith+  , encodeUtf   , hasTrailingPathSeparator   , isPathSeparator   , isRelative   , joinDrive   , joinPath   , normalise+  , pack   , pathSeparator   , pathSeparators   , splitDirectories   , splitDrive+  , toChar+  , unpack+  , unsafeFromChar   )  -- | A generator with side-effects.@@ -38,17 +56,17 @@ listTToList (ListT m) = do   mx <- m   case mx of-    Nothing -> return []+    Nothing -> pure []     Just (x, m') -> do       xs <- listTToList m'-      return (x : xs)+      pure (x : xs)  andM :: Monad m => m Bool -> m Bool -> m Bool andM mx my = do   x <- mx   if x     then my-    else return x+    else pure x  sequenceWithIOErrors_ :: [IO ()] -> IO () sequenceWithIOErrors_ actions = go (Right ()) actions@@ -59,13 +77,7 @@     go (Right ()) []       = pure ()     go s          (m : ms) = s `seq` do       r <- tryIOError m-      go (thenEither s r) ms--    -- equivalent to (*>) for Either, defined here to retain compatibility-    -- with base prior to 4.3-    thenEither :: Either b a -> Either b a -> Either b a-    thenEither x@(Left _) _ = x-    thenEither _          y = y+      go (s *> r) ms  -- | Similar to 'try' but only catches a specify kind of 'IOError' as --   specified by the predicate.@@ -95,60 +107,87 @@     newLoc = loc <> if null oldLoc then "" else ":" <> oldLoc     oldLoc = ioeGetLocation e +rightOrError :: Exception e => Either e a -> a+rightOrError (Left e)  = error (displayException e)+rightOrError (Right a) = a++-- | Fallibly converts String to OsString. Only intended to be used on literals.+os :: String -> OsString+os = rightOrError . encodeUtf++-- | Fallibly converts OsString to String. Only intended to be used on literals.+so :: OsString -> String+so = rightOrError . decodeUtf++ioeSetOsPath :: IOError -> OsPath -> IOError+ioeSetOsPath err =+  ioeSetFileName err .+  rightOrError .+  decodeWith+    (mkUTF8 TransliterateCodingFailure)+    (mkUTF16le TransliterateCodingFailure)++dropSpecialDotDirs :: [OsPath] -> [OsPath]+dropSpecialDotDirs = filter f+  where f filename = filename /= os "." && filename /= os ".."+ -- | Given a list of path segments, expand @.@ and @..@.  The path segments -- must not contain path separators.-expandDots :: [FilePath] -> [FilePath]+expandDots :: [OsPath] -> [OsPath] expandDots = reverse . go []   where     go ys' xs' =       case xs' of         [] -> ys'-        x : xs ->-          case x of-            "." -> go ys' xs-            ".." ->+        x : xs+          | x == os "." -> go ys' xs+          | x == os ".." ->               case ys' of                 [] -> go (x : ys') xs-                ".." : _ -> go (x : ys') xs-                _ : ys -> go ys xs-            _ -> go (x : ys') xs+                y : ys+                  | y == os ".." -> go (x : ys') xs+                  | otherwise -> go ys xs+          | otherwise -> go (x : ys') xs  -- | Convert to the right kind of slashes.-normalisePathSeps :: FilePath -> FilePath-normalisePathSeps p = (\ c -> if isPathSeparator c then pathSeparator else c) <$> p+normalisePathSeps :: OsPath -> OsPath+normalisePathSeps p = pack (normaliseChar <$> unpack p)+  where normaliseChar c = if isPathSeparator c then pathSeparator else c  -- | Remove redundant trailing slashes and pick the right kind of slash.-normaliseTrailingSep :: FilePath -> FilePath+normaliseTrailingSep :: OsPath -> OsPath normaliseTrailingSep path = do-  let path' = reverse path+  let path' = reverse (unpack path)   let (sep, path'') = span isPathSeparator path'   let addSep = if null sep then id else (pathSeparator :)-  reverse (addSep path'')+  pack (reverse (addSep path''))  -- | Convert empty paths to the current directory, otherwise leave it -- unchanged.-emptyToCurDir :: FilePath -> FilePath-emptyToCurDir ""   = "."-emptyToCurDir path = path+emptyToCurDir :: OsPath -> OsPath+emptyToCurDir path+  | path == mempty = os "."+  | otherwise      = path  -- | Similar to 'normalise' but empty paths stay empty.-simplifyPosix :: FilePath -> FilePath-simplifyPosix ""   = ""-simplifyPosix path = normalise path+simplifyPosix :: OsPath -> OsPath+simplifyPosix path+  | path == mempty = mempty+  | otherwise      = normalise path  -- | Similar to 'normalise' but: -- -- * empty paths stay empty, -- * parent dirs (@..@) are expanded, and--- * paths starting with @\\\\?\\@ are preserved.+-- * paths starting with @\\\\@ are preserved. -- -- The goal is to preserve the meaning of paths better than 'normalise'.-simplifyWindows :: FilePath -> FilePath-simplifyWindows "" = ""-simplifyWindows path =-  case drive' of-    "\\\\?\\" -> drive' <> subpath-    _ -> simplifiedPath+simplifyWindows :: OsPath -> OsPath+simplifyWindows path+  | path == mempty = mempty+  | otherwise = case toChar <$> unpack drive' of+      '\\' : '\\' : _ -> drive' <> subpath+      _ -> simplifiedPath   where     simplifiedPath = joinDrive drive' subpath'     (drive, subpath) = splitDrive path@@ -157,32 +196,44 @@                stripPardirs . expandDots . skipSeps .                splitDirectories $ subpath -    upperDrive d = case d of-      c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s+    upperDrive d = case unpack d of+      c : k : s+        | isAlpha (toChar c), toChar k == ':', all isPathSeparator s ->+          -- unsafeFromChar is safe here since all characters are ASCII.+          pack (unsafeFromChar (toUpper (toChar c)) : unsafeFromChar ':' : s)       _ -> d-    skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))-    stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..")+    skipSeps =+      (pack <$>) .+      filter (not . (`elem` (pure <$> pathSeparators))) .+      (unpack <$>)+    stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== os "..")                  | otherwise = id-    prependSep | subpathIsAbsolute = (pathSeparator :)+    prependSep | subpathIsAbsolute = (pack [pathSeparator] <>)                | otherwise = id     avoidEmpty | not pathIsAbsolute-                 && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:."+               , drive == mempty || hasTrailingPathSep -- prefer "C:" over "C:."                  = emptyToCurDir                | otherwise = id-    appendSep p | hasTrailingPathSep-                  && not (pathIsAbsolute && null p)+    appendSep p | hasTrailingPathSep, not (pathIsAbsolute && p == mempty)                   = addTrailingPathSeparator p                 | otherwise = p     pathIsAbsolute = not (isRelative path)-    subpathIsAbsolute = any isPathSeparator (take 1 subpath)+    subpathIsAbsolute = any isPathSeparator (take 1 (unpack subpath))     hasTrailingPathSep = hasTrailingPathSeparator subpath -data FileType = File-              | SymbolicLink -- ^ POSIX: either file or directory link; Windows: file link-              | Directory-              | DirectoryLink -- ^ Windows only: directory link-              deriving (Bounded, Enum, Eq, Ord, Read, Show)+data WhetherFollow = NoFollow | FollowLinks deriving (Show) +isNoFollow :: WhetherFollow -> Bool+isNoFollow NoFollow    = True+isNoFollow FollowLinks = False++data FileType+  = File+  | SymbolicLink -- ^ POSIX: either file or directory link; Windows: file link+  | Directory+  | DirectoryLink -- ^ Windows only: directory link+  deriving (Bounded, Enum, Eq, Ord, Read, Show)+ -- | Check whether the given 'FileType' is considered a directory by the -- operating system.  This affects the choice of certain functions -- e.g. 'System.Directory.removeDirectory' vs 'System.Directory.removeFile'.@@ -205,26 +256,17 @@   , searchable :: Bool   } deriving (Eq, Ord, Read, Show) --- | Truncate the destination file and then copy the contents of the source--- file to the destination file.  If the destination file already exists, its--- attributes shall remain unchanged.  Otherwise, its attributes are reset to--- the defaults.-copyFileContents :: FilePath            -- ^ Source filename-                 -> FilePath            -- ^ Destination filename-                 -> IO ()-copyFileContents fromFPath toFPath =-  (`ioeAddLocation` "copyFileContents") `modifyIOError` do-    withBinaryFile toFPath WriteMode $ \ hTo ->-      copyFileToHandle fromFPath hTo+withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withBinaryFile path mode =+  bracket (File.openFileWithCloseOnExec path mode) hClose --- | Copy all data from a file to a handle.-copyFileToHandle :: FilePath            -- ^ Source file-                 -> Handle              -- ^ Destination handle-                 -> IO ()-copyFileToHandle fromFPath hTo =-  (`ioeAddLocation` "copyFileToHandle") `modifyIOError` do-    withBinaryFile fromFPath ReadMode $ \ hFrom ->-      copyHandleData hFrom hTo+openTempFile' :: String -> OsPath -> OsString -> Bool -> CMode -> Bool+              -> IO (OsPath, Handle)+openTempFile' loc tmpDir template binary mode _cloExec =+  File.openTempFile' loc tmpDir template binary mode+#if MIN_VERSION_file_io(0, 2, 0)+    _cloExec+#endif  -- | Copy data from one handle to another until end of file. copyHandleData :: Handle                -- ^ Source handle@@ -234,7 +276,8 @@   (`ioeAddLocation` "copyData") `modifyIOError` do     allocaBytes bufferSize go   where-    bufferSize = 131072 -- 128 KiB, as coreutils `cp` uses as of May 2014 (see ioblksize.h)+    -- 128 KiB, as coreutils `cp` uses as of May 2014 (see ioblksize.h)+    bufferSize = 131072     go buffer = do       count <- hGetBuf hFrom buffer bufferSize       when (count > 0) $ do@@ -276,7 +319,7 @@    -- but that is not important or portable enough to the user that it    -- should be stored in 'XdgData'.    -- It uses the @XDG_STATE_HOME@ environment variable.-   -- On non-Windows sytems, the default is @~\/.local\/state@.  On+   -- On non-Windows systems, the default is @~\/.local\/state@.  On    -- Windows, the default is @%LOCALAPPDATA%@    -- (e.g. @C:\/Users\//\<user\>/\/AppData\/Local@).    --
System/Directory/Internal/Config.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-} module System.Directory.Internal.Config where #include <HsDirectoryConfig.h>+import System.Directory.Internal.Common -exeExtension :: String-exeExtension = EXE_EXTENSION+exeExtension :: OsString+exeExtension = os EXE_EXTENSION -- We avoid using #const_str from hsc because it breaks cross-compilation -- builds, so we use this ugly workaround where we simply paste the C string -- literal directly in here.  This will probably break if the EXE_EXTENSION
System/Directory/Internal/Posix.hsc view
@@ -1,9 +1,14 @@+{-# LANGUAGE CApiFFI #-} module System.Directory.Internal.Posix where #include <HsDirectoryConfig.h> #if !defined(mingw32_HOST_OS)+#include <fcntl.h> #ifdef HAVE_LIMITS_H # include <limits.h> #endif+#ifdef HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif import Prelude () import System.Directory.Internal.Prelude #ifdef HAVE_UTIMENSAT@@ -13,24 +18,80 @@ import System.Directory.Internal.Config (exeExtension) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime)-import System.FilePath ((</>), isRelative, splitSearchPath)+import System.OsPath ((</>), isRelative, splitSearchPath)+import System.OsString.Internal.Types (OsString(OsString, getOsString)) import qualified Data.Time.Clock.POSIX as POSIXTime-import qualified GHC.Foreign as GHC-import qualified System.Posix as Posix-import qualified System.Posix.User as PU+import qualified System.OsPath.Internal as OsPath+import qualified System.Posix.Directory.Fd as Posix+import qualified System.Posix.Directory.PosixPath as Posix+import qualified System.Posix.Env.PosixString as Posix+import qualified System.Posix.Files as Posix (FileStatus(..))+import qualified System.Posix.Files.PosixString as Posix+import qualified System.Posix.Internals as Posix (CStat)+import qualified System.Posix.IO.PosixString as Posix+import qualified System.Posix.PosixPath.FilePath as Posix+import qualified System.Posix.Types as Posix+import qualified System.Posix.User.ByteString as Posix -createDirectoryInternal :: FilePath -> IO ()-createDirectoryInternal path = Posix.createDirectory path 0o777+c_AT_FDCWD :: Posix.Fd+c_AT_FDCWD = Posix.Fd (#const AT_FDCWD) -removePathInternal :: Bool -> FilePath -> IO ()-removePathInternal True  = Posix.removeDirectory-removePathInternal False = Posix.removeLink+c_AT_SYMLINK_NOFOLLOW :: CInt+c_AT_SYMLINK_NOFOLLOW = (#const AT_SYMLINK_NOFOLLOW) -renamePathInternal :: FilePath -> FilePath -> IO ()-renamePathInternal = Posix.rename+atWhetherFollow :: WhetherFollow -> CInt+atWhetherFollow NoFollow    = c_AT_SYMLINK_NOFOLLOW+atWhetherFollow FollowLinks = 0 +defaultOpenFlags :: Posix.OpenFileFlags+defaultOpenFlags =+  Posix.defaultFileFlags+  { Posix.noctty = True+  , Posix.nonBlock = True+  , Posix.cloexec = True+  }++type RawHandle = Posix.Fd++openRaw :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO RawHandle+openRaw whetherFollow dir (OsString path) =+  Posix.openFdAt dir path Posix.ReadOnly flags+  where+    flags = defaultOpenFlags { Posix.nofollow = isNoFollow whetherFollow }++closeRaw :: RawHandle -> IO ()+closeRaw = Posix.closeFd++createDirectoryInternal :: OsPath -> IO ()+createDirectoryInternal (OsString path) = Posix.createDirectory path 0o777++foreign import ccall "unistd.h unlinkat" c_unlinkat+  :: Posix.Fd -> CString -> CInt -> IO CInt++removePathAt :: FileType -> Maybe RawHandle -> OsPath -> IO ()+removePathAt ty dir (OsString path) =+  Posix.withFilePath path $ \ pPath -> do+    Posix.throwErrnoPathIfMinus1_ "unlinkat" path+      (c_unlinkat (fromMaybe c_AT_FDCWD dir) pPath flag)+    pure ()+  where+    flag | fileTypeIsDirectory ty = (#const AT_REMOVEDIR)+         | otherwise              = 0++removePathInternal :: Bool -> OsPath -> IO ()+removePathInternal True  = Posix.removeDirectory . getOsString+removePathInternal False = Posix.removeLink . getOsString++renamePathInternal :: OsPath -> OsPath -> IO ()+renamePathInternal (OsString p1) (OsString p2) = Posix.rename p1 p2++-- On POSIX, the removability of a file is only affected by the attributes of+-- the containing directory.+filesAlwaysRemovable :: Bool+filesAlwaysRemovable = True+ -- | On POSIX, equivalent to 'simplifyPosix'.-simplify :: FilePath -> FilePath+simplify :: OsPath -> OsPath simplify = simplifyPosix  -- we use the 'free' from the standard library here since it's not entirely@@ -52,7 +113,13 @@ #if !defined(HAVE_REALPATH)  c_realpath :: CString -> CString -> IO CString-c_realpath _ _ = throwIO (mkIOError UnsupportedOperation "platform does not support realpath" Nothing Nothing)+c_realpath _ _ =+  throwIO+    (mkIOError+      UnsupportedOperation+      "platform does not support realpath"+      Nothing+      Nothing)  #else @@ -71,47 +138,51 @@     allocaBytes (pathMax + 1) (realpath >=> action)   where realpath = throwErrnoIfNull "" . c_realpath path -canonicalizePathWith :: ((FilePath -> IO FilePath) -> FilePath -> IO FilePath)-                     -> FilePath-                     -> IO FilePath-canonicalizePathWith attemptRealpath path = do-  encoding <- getFileSystemEncoding-  let realpath path' =-        GHC.withCString encoding path' (`withRealpath` GHC.peekCString encoding)-  attemptRealpath realpath path+realPath :: OsPath -> IO OsPath+realPath (OsString path') =+  Posix.withFilePath path'+    (`withRealpath` ((OsString <$>) . Posix.peekFilePath)) -canonicalizePathSimplify :: FilePath -> IO FilePath+canonicalizePathSimplify :: OsPath -> IO OsPath canonicalizePathSimplify = pure -findExecutablesLazyInternal :: ([FilePath] -> String -> ListT IO FilePath)-                            -> String-                            -> ListT IO FilePath+findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)+                            -> OsString+                            -> ListT IO OsPath findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary =   liftJoinListT $ do     path <- getPath     pure (findExecutablesInDirectoriesLazy path binary) -exeExtensionInternal :: String+getPath :: IO [OsPath]+getPath = splitSearchPath <$> getEnvOs (os "PATH")++exeExtensionInternal :: OsString exeExtensionInternal = exeExtension -getDirectoryContentsInternal :: FilePath -> IO [FilePath]-getDirectoryContentsInternal path =-  bracket-    (Posix.openDirStream path)-    Posix.closeDirStream-    start+openDirFromFd :: Posix.Fd -> IO Posix.DirStream+openDirFromFd fd = Posix.unsafeOpenDirStreamFd =<< Posix.dup fd++readDirStreamToEnd :: Posix.DirStream -> IO [OsPath]+readDirStreamToEnd stream = loop id   where-    start dirp = loop id-      where-        loop acc = do-          e <- Posix.readDirStream dirp-          if null e-            then pure (acc [])-            else loop (acc . (e:))+    loop acc = do+      e <- Posix.readDirStream stream+      if e == mempty+        then pure (acc [])+        else loop (acc . (OsString e :)) -getCurrentDirectoryInternal :: IO FilePath-getCurrentDirectoryInternal = Posix.getWorkingDirectory+readDirToEnd :: RawHandle -> IO [OsPath]+readDirToEnd fd =+  bracket (openDirFromFd fd) Posix.closeDirStream readDirStreamToEnd +getDirectoryContentsInternal :: OsPath -> IO [OsPath]+getDirectoryContentsInternal (OsString path) =+  bracket (Posix.openDirStream path) Posix.closeDirStream readDirStreamToEnd++getCurrentDirectoryInternal :: IO OsPath+getCurrentDirectoryInternal = OsString <$> Posix.getWorkingDirectory+ -- | Convert a path into an absolute path.  If the given path is relative, the -- current directory is prepended and the path may or may not be simplified. -- If the path is already absolute, the path is returned unchanged.  The@@ -121,34 +192,52 @@ -- operation may throw exceptions. -- -- Empty paths are treated as the current directory.-prependCurrentDirectory :: FilePath -> IO FilePath+prependCurrentDirectory :: OsPath -> IO OsPath prependCurrentDirectory path   | isRelative path =     ((`ioeAddLocation` "prependCurrentDirectory") .-     (`ioeSetFileName` path)) `modifyIOError` do+     (`ioeSetOsPath` path)) `modifyIOError` do       (</> path) <$> getCurrentDirectoryInternal   | otherwise = pure path -setCurrentDirectoryInternal :: FilePath -> IO ()-setCurrentDirectoryInternal = Posix.changeWorkingDirectory+setCurrentDirectoryInternal :: OsPath -> IO ()+setCurrentDirectoryInternal = Posix.changeWorkingDirectory . getOsString  linkToDirectoryIsDirectory :: Bool linkToDirectoryIsDirectory = False -createSymbolicLink :: Bool -> FilePath -> FilePath -> IO ()-createSymbolicLink _ = Posix.createSymbolicLink+createHardLink :: OsPath -> OsPath -> IO ()+createHardLink (OsString p1) (OsString p2) = Posix.createLink p1 p2 -readSymbolicLink :: FilePath -> IO FilePath-readSymbolicLink = Posix.readSymbolicLink+createSymbolicLink :: Bool -> OsPath -> OsPath -> IO ()+createSymbolicLink _ (OsString p1) (OsString p2) =+  Posix.createSymbolicLink p1 p2 +readSymbolicLink :: OsPath -> IO OsPath+readSymbolicLink = (OsString <$>) . Posix.readSymbolicLink . getOsString+ type Metadata = Posix.FileStatus -getSymbolicLinkMetadata :: FilePath -> IO Metadata-getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus+foreign import capi "sys/stat.h fstatat" c_fstatat+  :: Posix.Fd -> CString -> Ptr Posix.CStat -> CInt -> IO CInt -getFileMetadata :: FilePath -> IO Metadata-getFileMetadata = Posix.getFileStatus+getMetadataAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO Metadata+getMetadataAt whetherFollow dir (OsString path) =+  Posix.withFilePath path $ \ pPath -> do+    stat <- mallocForeignPtrBytes (#const sizeof(struct stat))+    withForeignPtr stat $ \ pStat -> do+      Posix.throwErrnoPathIfMinus1_ "fstatat" path $ do+        c_fstatat (fromMaybe c_AT_FDCWD dir) pPath pStat flags+    pure (Posix.FileStatus stat)+  where+    flags = atWhetherFollow whetherFollow +getSymbolicLinkMetadata :: OsPath -> IO Metadata+getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus . getOsString++getFileMetadata :: OsPath -> IO Metadata+getFileMetadata = Posix.getFileStatus . getOsString+ fileTypeFromMetadata :: Metadata -> FileType fileTypeFromMetadata stat   | isLink    = SymbolicLink@@ -163,21 +252,11 @@  accessTimeFromMetadata :: Metadata -> UTCTime accessTimeFromMetadata =-  POSIXTime.posixSecondsToUTCTime . posix_accessTimeHiRes+  POSIXTime.posixSecondsToUTCTime . Posix.accessTimeHiRes  modificationTimeFromMetadata :: Metadata -> UTCTime modificationTimeFromMetadata =-  POSIXTime.posixSecondsToUTCTime . posix_modificationTimeHiRes--posix_accessTimeHiRes, posix_modificationTimeHiRes-  :: Posix.FileStatus -> POSIXTime-#if MIN_VERSION_unix(2, 6, 0)-posix_accessTimeHiRes = Posix.accessTimeHiRes-posix_modificationTimeHiRes = Posix.modificationTimeHiRes-#else-posix_accessTimeHiRes = realToFrac . Posix.accessTime-posix_modificationTimeHiRes = realToFrac . Posix.modificationTime-#endif+  POSIXTime.posixSecondsToUTCTime . Posix.modificationTimeHiRes  type Mode = Posix.FileMode @@ -197,19 +276,32 @@ setWriteMode False m = m .&. complement allWriteMode setWriteMode True  m = m .|. allWriteMode -setFileMode :: FilePath -> Mode -> IO ()-setFileMode = Posix.setFileMode+setForceRemoveMode :: Mode -> Mode+setForceRemoveMode m = m .|. Posix.ownerModes -setFilePermissions :: FilePath -> Mode -> IO ()+foreign import capi "sys/stat.h fchmodat" c_fchmodat+  :: Posix.Fd -> CString -> Posix.FileMode -> CInt -> IO CInt++setModeAt :: Maybe RawHandle -> OsPath -> Mode -> IO ()+setModeAt dir (OsString path) mode = do+  Posix.withFilePath path $ \ pPath ->+    Posix.throwErrnoPathIfMinus1_ "fchmodat" path $ do+      c_fchmodat (fromMaybe c_AT_FDCWD dir) pPath mode 0++setFileMode :: OsPath -> Mode -> IO ()+setFileMode = Posix.setFileMode . getOsString++setFilePermissions :: OsPath -> Mode -> IO () setFilePermissions = setFileMode -getAccessPermissions :: FilePath -> IO Permissions+getAccessPermissions :: OsPath -> IO Permissions getAccessPermissions path = do   m <- getFileMetadata path   let isDir = fileTypeIsDirectory (fileTypeFromMetadata m)-  r <- Posix.fileAccess path True  False False-  w <- Posix.fileAccess path False True  False-  x <- Posix.fileAccess path False False True+  let OsString path' = path+  r <- Posix.fileAccess path' True  False False+  w <- Posix.fileAccess path' False True  False+  x <- Posix.fileAccess path' False False True   pure Permissions        { readable   = r        , writable   = w@@ -217,7 +309,7 @@        , searchable = x && isDir        } -setAccessPermissions :: FilePath -> Permissions -> IO ()+setAccessPermissions :: OsPath -> Permissions -> IO () setAccessPermissions path (Permissions r w e s) = do   m <- getFileMetadata path   setFileMode path (modifyBit (e || s) Posix.ownerExecuteMode .@@ -229,98 +321,118 @@     modifyBit False b m = m .&. complement b     modifyBit True  b m = m .|. b -copyOwnerFromStatus :: Posix.FileStatus -> FilePath -> IO ()-copyOwnerFromStatus st dst = do+copyOwnerFromStatus :: Posix.FileStatus -> OsPath -> IO ()+copyOwnerFromStatus st (OsString dst) = do   Posix.setOwnerAndGroup dst (Posix.fileOwner st) (-1) -copyGroupFromStatus :: Posix.FileStatus -> FilePath -> IO ()-copyGroupFromStatus st dst = do+copyGroupFromStatus :: Posix.FileStatus -> OsPath -> IO ()+copyGroupFromStatus st (OsString dst) = do   Posix.setOwnerAndGroup dst (-1) (Posix.fileGroup st) -tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> FilePath -> IO ()+tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> OsPath -> IO () tryCopyOwnerAndGroupFromStatus st dst = do   ignoreIOExceptions (copyOwnerFromStatus st dst)   ignoreIOExceptions (copyGroupFromStatus st dst) -copyFileWithMetadataInternal :: (Metadata -> FilePath -> IO ())-                             -> (Metadata -> FilePath -> IO ())-                             -> FilePath-                             -> FilePath+-- | Truncate the destination file and then copy the contents of the source+-- file to the destination file.  If the destination file already exists, its+-- attributes shall remain unchanged.  Otherwise, its attributes are reset to+-- the defaults.+copyFileContents :: OsPath              -- ^ Source filename+                 -> OsPath              -- ^ Destination filename+                 -> IO ()+copyFileContents fromFPath toFPath =+  (`ioeAddLocation` "copyFileContents") `modifyIOError` do+    withBinaryFile toFPath WriteMode $ \ hTo -> do+      withBinaryFile fromFPath ReadMode $ \ hFrom -> do+        copyHandleData hFrom hTo++copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())+                             -> (Metadata -> OsPath -> IO ())+                             -> OsPath+                             -> OsPath                              -> IO () copyFileWithMetadataInternal copyPermissionsFromMetadata                              copyTimesFromMetadata                              src                              dst = do-  st <- Posix.getFileStatus src+  st <- Posix.getFileStatus (getOsString src)   copyFileContents src dst   tryCopyOwnerAndGroupFromStatus st dst   copyPermissionsFromMetadata st dst   copyTimesFromMetadata st dst -setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()+setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO () #ifdef HAVE_UTIMENSAT-setTimes path' (atime', mtime') =-  withFilePath path' $ \ path'' ->+setTimes (OsString path') (atime', mtime') =+  Posix.withFilePath path' $ \ path'' ->   withArray [ maybe utimeOmit toCTimeSpec atime'             , maybe utimeOmit toCTimeSpec mtime' ] $ \ times ->-  throwErrnoPathIfMinus1_ "" path' $+  Posix.throwErrnoPathIfMinus1_ "" path' $     c_utimensat c_AT_FDCWD path'' times 0 #else-setTimes path' (Just atime', Just mtime') = setFileTimes' path' atime' mtime'-setTimes path' (atime', mtime') = do-  m <- getFileMetadata path'+setTimes (OsString path') (Just atime', Just mtime') =+  Posix.setFileTimesHiRes path' atime' mtime'+setTimes (OsString path') (atime', mtime') = do+  m <- getFileMetadata (OsString path')   let atimeOld = accessTimeFromMetadata m   let mtimeOld = modificationTimeFromMetadata m-  setFileTimes' path'+  Posix.setFileTimesHiRes path'     (fromMaybe (POSIXTime.utcTimeToPOSIXSeconds atimeOld) atime')     (fromMaybe (POSIXTime.utcTimeToPOSIXSeconds mtimeOld) mtime')--setFileTimes' :: FilePath -> POSIXTime -> POSIXTime -> IO ()-# if MIN_VERSION_unix(2, 7, 0)-setFileTimes' = Posix.setFileTimesHiRes-#  else-setFileTimes' pth atime' mtime' =-  Posix.setFileTimes pth-    (fromInteger (truncate atime'))-    (fromInteger (truncate mtime'))-# endif #endif --- | Get the contents of the @PATH@ environment variable.-getPath :: IO [FilePath]-getPath = splitSearchPath <$> getEnv "PATH"+lookupEnvOs :: OsString -> IO (Maybe OsString)+lookupEnvOs (OsString name) = (OsString <$>) <$> Posix.getEnv name +getEnvOs :: OsString -> IO OsString+getEnvOs name = do+  env <- lookupEnvOs name+  case env of+    Nothing ->+      throwIO $+        mkIOError+          doesNotExistErrorType+          ("env var " <> show name <> " not found")+          Nothing+          Nothing+    Just value -> pure value+ -- | $HOME is preferred, because the user has control over it. However, POSIX -- doesn't define it as a mandatory variable, so fall back to `getpwuid_r`.-getHomeDirectoryInternal :: IO FilePath+getHomeDirectoryInternal :: IO OsPath getHomeDirectoryInternal = do-  e <- lookupEnv "HOME"+  e <- lookupEnvOs (os "HOME")   case e of-       Just fp -> pure fp-       Nothing -> PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)+    Just fp -> pure fp+    Nothing ->+      OsPath.fromBytes . Posix.homeDirectory =<<+        Posix.getUserEntryForID =<<+        Posix.getEffectiveUserID -getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath+getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath getXdgDirectoryFallback getHomeDirectory xdgDir = do   (<$> getHomeDirectory) $ flip (</>) $ case xdgDir of-    XdgData   -> ".local/share"-    XdgConfig -> ".config"-    XdgCache  -> ".cache"-    XdgState  -> ".local/state"+    XdgData   -> os ".local/share"+    XdgConfig -> os ".config"+    XdgCache  -> os ".cache"+    XdgState  -> os ".local/state" -getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath]+getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath] getXdgDirectoryListFallback xdgDirs =   pure $ case xdgDirs of-    XdgDataDirs   -> ["/usr/local/share/", "/usr/share/"]-    XdgConfigDirs -> ["/etc/xdg"]+    XdgDataDirs   -> [os "/usr/local/share/", os "/usr/share/"]+    XdgConfigDirs -> [os "/etc/xdg"] -getAppUserDataDirectoryInternal :: FilePath -> IO FilePath+getAppUserDataDirectoryInternal :: OsPath -> IO OsPath getAppUserDataDirectoryInternal appName =-  (\ home -> home <> ('/' : '.' : appName)) <$> getHomeDirectoryInternal+  (\ home -> home <> (os "/" <> os "." <> appName)) <$> getHomeDirectoryInternal -getUserDocumentsDirectoryInternal :: IO FilePath+getUserDocumentsDirectoryInternal :: IO OsPath getUserDocumentsDirectoryInternal = getHomeDirectoryInternal -getTemporaryDirectoryInternal :: IO FilePath-getTemporaryDirectoryInternal = fromMaybe "/tmp" <$> lookupEnv "TMPDIR"+getTemporaryDirectoryInternal :: IO OsPath+getTemporaryDirectoryInternal =+  fromMaybe (os "/tmp") <$> lookupEnvOs (os "TMPDIR")  #endif
System/Directory/Internal/Prelude.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Stability: unstable@@ -8,14 +7,6 @@  module System.Directory.Internal.Prelude   ( module Prelude-#if !MIN_VERSION_base(4, 6, 0)-  , forkFinally-  , lookupEnv-#endif-#if !MIN_VERSION_base(4, 8, 0)-  , module Control.Applicative-  , module Data.Functor-#endif   , module Control.Arrow   , module Control.Concurrent   , module Control.Exception@@ -36,22 +27,11 @@   , module System.Exit   , module System.IO   , module System.IO.Error-  , module System.Posix.Internals   , module System.Posix.Types   , module System.Timeout   , Void   ) where-#if MIN_VERSION_base(4, 6, 0)-import System.Environment (lookupEnv)-#else-import Prelude hiding (catch)-#endif-#if MIN_VERSION_base(4, 8, 0) import Data.Void (Void)-#else-import Control.Applicative (Applicative, (<*>), (*>), pure)-import Data.Functor ((<$>), (<$))-#endif import Control.Arrow (second) import Control.Concurrent   ( forkIO@@ -60,16 +40,14 @@   , putMVar   , readMVar   , takeMVar-#if MIN_VERSION_base(4, 6, 0)   , forkFinally-#else-  , ThreadId-#endif   ) import Control.Exception-  ( SomeException+  ( Exception(displayException)+  , SomeException   , bracket   , bracket_+  , bracketOnError   , catch   , finally   , mask@@ -80,7 +58,7 @@ import Control.Monad ((>=>), (<=<), unless, when, replicateM, replicateM_) import Data.Bits ((.&.), (.|.), complement) import Data.Char (isAlpha, isAscii, toLower, toUpper)-import Data.Foldable (for_, traverse_)+import Data.Foldable (for_, sequenceA_) import Data.Function (on) import Data.Maybe (catMaybes, fromMaybe, maybeToList) import Data.Monoid ((<>), mconcat, mempty)@@ -102,11 +80,13 @@   , allocaArray   , allocaBytes   , allocaBytesAligned+  , mallocForeignPtrBytes   , maybeWith   , nullPtr   , plusPtr   , with   , withArray+  , withForeignPtr   ) import Foreign.C   ( CInt(..)@@ -118,14 +98,9 @@   , CUShort(..)   , CWString   , CWchar(..)-  , peekCString-  , peekCWStringLen   , throwErrnoIfMinus1Retry_   , throwErrnoIfMinus1_   , throwErrnoIfNull-  , throwErrnoPathIfMinus1_-  , withCString-  , withCWString   ) import GHC.IO.Exception   ( IOErrorType@@ -136,7 +111,7 @@     )   ) import GHC.IO.Encoding (getFileSystemEncoding)-import System.Environment (getArgs, getEnv)+import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO   ( Handle@@ -147,14 +122,13 @@   , hPutBuf   , hPutStr   , hPutStrLn-  , openBinaryTempFile   , stderr   , stdout-  , withBinaryFile   ) import System.IO.Error   ( IOError   , catchIOError+  , doesNotExistErrorType   , illegalOperationErrorType   , ioeGetErrorString   , ioeGetErrorType@@ -172,28 +146,5 @@   , tryIOError   , userError   )-import System.Posix.Internals (withFilePath)-import System.Posix.Types (EpochTime)+import System.Posix.Types (CMode, EpochTime) import System.Timeout (timeout)--#if !MIN_VERSION_base(4, 6, 0)-lookupEnv :: String -> IO (Maybe String)-lookupEnv name = do-  env <- tryIOError (getEnv name)-  case env of-    Left err | isDoesNotExistError err -> pure Nothing-             | otherwise               -> throwIO err-    Right value -> pure (Just value)--forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId-forkFinally action and_then =-  mask $ \restore ->-    forkIO $ try (restore action) >>= and_then-#endif--#if !MIN_VERSION_base(4, 8, 0)-data Void = Void--_unusedVoid :: Void-_unusedVoid = Void-#endif
System/Directory/Internal/Windows.hsc view
@@ -4,14 +4,14 @@ #if defined(mingw32_HOST_OS) ##if defined(i386_HOST_ARCH) ## define WINAPI stdcall-##elif defined(x86_64_HOST_ARCH)+##elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) ## define WINAPI ccall ##else ## error unknown architecture ##endif #include <shlobj.h> #include <windows.h>-#include <System/Directory/Internal/utility.h>+#include <HsBaseConfig.h> #include <System/Directory/Internal/windows_ext.h> import Prelude () import System.Directory.Internal.Prelude@@ -19,61 +19,109 @@ import System.Directory.Internal.Config (exeExtension) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)-import System.FilePath+#ifdef __IO_MANAGER_WINIO__+import GHC.IO.SubSystem (IoSubSystem(IoPOSIX, IoNative), ioSubSystem)+#endif+import System.OsPath   ( (</>)+  , hasExtension+  , isExtensionOf   , isPathSeparator   , isRelative+  , pack   , pathSeparator   , splitDirectories+  , splitSearchPath   , takeExtension+  , toChar+  , unpack   )+import System.OsPath.Types (WindowsPath, WindowsString)+import System.OsString.Internal.Types (OsString(OsString, getOsString)) import qualified Data.List as List-import qualified System.Win32 as Win32+import qualified System.Win32.WindowsString.File as Win32+import qualified System.Win32.WindowsString.Info as Win32+import qualified System.Win32.WindowsString.Shell as Win32+import qualified System.Win32.WindowsString.Time as Win32+import qualified System.Win32.WindowsString.Types as Win32+import qualified System.Win32.WindowsString.Console as Win32 -createDirectoryInternal :: FilePath -> IO ()+type RawHandle = OsPath++pathAt :: Maybe RawHandle -> OsPath -> OsPath+pathAt dir path = fromMaybe mempty dir </> path++openRaw :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO RawHandle+openRaw _ dir path = pure (pathAt dir path)++closeRaw :: RawHandle -> IO ()+closeRaw _ = pure ()++lookupEnvOs :: OsString -> IO (Maybe OsString)+lookupEnvOs (OsString name) = (OsString <$>) <$> Win32.getEnv name++getEnvOs :: OsString -> IO OsString+getEnvOs name = do+  env <- lookupEnvOs name+  case env of+    Nothing ->+      throwIO $+        mkIOError+          doesNotExistErrorType+          ("env var " <> show name <> " not found")+          Nothing+          Nothing+    Just value -> pure value++-- | Get the contents of the @PATH@ environment variable.+getPath :: IO [OsPath]+getPath = splitSearchPath <$> getEnvOs (os "PATH")++createDirectoryInternal :: OsPath -> IO () createDirectoryInternal path =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     Win32.createDirectory path' Nothing -removePathInternal :: Bool -> FilePath -> IO ()+removePathAt :: FileType -> Maybe RawHandle -> OsPath -> IO ()+removePathAt ty dir path = removePathInternal isDir (pathAt dir path)+  where isDir = fileTypeIsDirectory ty++removePathInternal :: Bool -> OsPath -> IO () removePathInternal isDir path =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     furnishPath path       >>= if isDir then Win32.removeDirectory else Win32.deleteFile -renamePathInternal :: FilePath -> FilePath -> IO ()+renamePathInternal :: OsPath -> OsPath -> IO () renamePathInternal opath npath =-  (`ioeSetFileName` opath) `modifyIOError` do+  (`ioeSetOsPath` opath) `modifyIOError` do     opath' <- furnishPath opath     npath' <- furnishPath npath-#if MIN_VERSION_Win32(2, 6, 0)     Win32.moveFileEx opath' (Just npath') Win32.mOVEFILE_REPLACE_EXISTING-#else-    Win32.moveFileEx opath' npath' Win32.mOVEFILE_REPLACE_EXISTING-#endif -copyFileWithMetadataInternal :: (Metadata -> FilePath -> IO ())-                             -> (Metadata -> FilePath -> IO ())-                             -> FilePath-                             -> FilePath+-- On Windows, the removability of a file may be affected by the attributes of+-- the file itself.+filesAlwaysRemovable :: Bool+filesAlwaysRemovable = False++copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())+                             -> (Metadata -> OsPath -> IO ())+                             -> OsPath+                             -> OsPath                              -> IO () copyFileWithMetadataInternal _ _ src dst =-  (`ioeSetFileName` src) `modifyIOError` do+  (`ioeSetOsPath` src) `modifyIOError` do     src' <- furnishPath src     dst' <- furnishPath dst     Win32.copyFile src' dst' False -win32_cSIDL_LOCAL_APPDATA :: Win32.CSIDL-#if MIN_VERSION_Win32(2, 3, 1)-win32_cSIDL_LOCAL_APPDATA = Win32.cSIDL_LOCAL_APPDATA-#else-win32_cSIDL_LOCAL_APPDATA = (#const CSIDL_LOCAL_APPDATA)-#endif- win32_cSIDL_COMMON_APPDATA :: Win32.CSIDL win32_cSIDL_COMMON_APPDATA = (#const CSIDL_COMMON_APPDATA) +win32_eRROR_ENVVAR_NOT_FOUND :: Win32.ErrCode+win32_eRROR_ENVVAR_NOT_FOUND = (#const ERROR_ENVVAR_NOT_FOUND)+ win32_eRROR_INVALID_FUNCTION :: Win32.ErrCode win32_eRROR_INVALID_FUNCTION = (#const ERROR_INVALID_FUNCTION) @@ -89,64 +137,20 @@ win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE :: Win32.DWORD win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE = 0x2 -win32_fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag-#if MIN_VERSION_Win32(2, 4, 0)-win32_fILE_ATTRIBUTE_REPARSE_POINT = Win32.fILE_ATTRIBUTE_REPARSE_POINT-#else-win32_fILE_ATTRIBUTE_REPARSE_POINT = (#const FILE_ATTRIBUTE_REPARSE_POINT)-#endif--win32_fILE_SHARE_DELETE :: Win32.ShareMode-#if MIN_VERSION_Win32(2, 3, 1)-win32_fILE_SHARE_DELETE = Win32.fILE_SHARE_DELETE -- added in 2.3.0.2-#else-win32_fILE_SHARE_DELETE = (#const FILE_SHARE_DELETE)-#endif- maxShareMode :: Win32.ShareMode maxShareMode =-  win32_fILE_SHARE_DELETE .|.+  Win32.fILE_SHARE_DELETE .|.   Win32.fILE_SHARE_READ   .|.   Win32.fILE_SHARE_WRITE -win32_getLongPathName, win32_getShortPathName :: FilePath -> IO FilePath-#if MIN_VERSION_Win32(2, 4, 0)-win32_getLongPathName = Win32.getLongPathName-win32_getShortPathName = Win32.getShortPathName-#else-win32_getLongPathName path =-  ((`ioeSetLocation` "GetLongPathName") .-   (`ioeSetFileName` path)) `modifyIOError` do-    withCWString path $ \ ptrPath -> do-      getPathNameWith (c_GetLongPathName ptrPath)--win32_getShortPathName path =-  ((`ioeSetLocation` "GetShortPathName") .-   (`ioeSetFileName` path)) `modifyIOError` do-    withCWString path $ \ ptrPath -> do-      getPathNameWith (c_GetShortPathName ptrPath)--foreign import WINAPI unsafe "windows.h GetLongPathNameW"-  c_GetLongPathName-    :: Ptr CWchar-    -> Ptr CWchar-    -> Win32.DWORD-    -> IO Win32.DWORD--foreign import WINAPI unsafe "windows.h GetShortPathNameW"-  c_GetShortPathName-    :: Ptr CWchar-    -> Ptr CWchar-    -> Win32.DWORD-    -> IO Win32.DWORD-#endif--win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO FilePath-win32_getFinalPathNameByHandle _h _flags =-  (`ioeSetLocation` "GetFinalPathNameByHandle") `modifyIOError` do+win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO WindowsPath #ifdef HAVE_GETFINALPATHNAMEBYHANDLEW-    getPathNameWith $ \ ptr len -> do-      c_GetFinalPathNameByHandle _h ptr len _flags+win32_getFinalPathNameByHandle h flags = do+  result <- peekTStringWith (#const MAX_PATH) $ \ ptr len -> do+    c_GetFinalPathNameByHandle h ptr len flags+  case result of+    Left errCode -> Win32.failWith "GetFinalPathNameByHandle" errCode+    Right path -> pure path  foreign import WINAPI unsafe "windows.h GetFinalPathNameByHandleW"   c_GetFinalPathNameByHandle@@ -157,14 +161,19 @@     -> IO Win32.DWORD  #else-    throwIO (mkIOError UnsupportedOperation-             "platform does not support GetFinalPathNameByHandle"-             Nothing Nothing)+win32_getFinalPathNameByHandle _ _ = throwIO $+  mkIOError+    UnsupportedOperation+    "platform does not support GetFinalPathNameByHandle"+    Nothing+    Nothing #endif -getFinalPathName :: FilePath -> IO FilePath+getFinalPathName :: OsPath -> IO OsPath getFinalPathName =-  (fromExtendedLengthPath <$>) . rawGetFinalPathName . toExtendedLengthPath+  (fromExtendedLengthPath <$>) .+  rawGetFinalPathName .+  toExtendedLengthPath   where #ifdef HAVE_GETFINALPATHNAMEBYHANDLEW     rawGetFinalPathName path = do@@ -173,7 +182,7 @@       bracket open Win32.closeHandle $ \ h -> do         win32_getFinalPathNameByHandle h 0 #else-    rawGetFinalPathName = win32_getLongPathName <=< win32_getShortPathName+    rawGetFinalPathName = Win32.getLongPathName <=< Win32.getShortPathName #endif  win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag@@ -194,9 +203,9 @@ win32_sYMLINK_FLAG_RELATIVE = 0x00000001  data Win32_REPARSE_DATA_BUFFER-  = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER String String+  = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER WindowsString WindowsString     -- ^ substituteName printName-  | Win32_SYMLINK_REPARSE_DATA_BUFFER String String Bool+  | Win32_SYMLINK_REPARSE_DATA_BUFFER WindowsString WindowsString Bool     -- ^ substituteName printName isRelative   | Win32_GENERIC_REPARSE_DATA_BUFFER @@ -206,8 +215,7 @@   allocaBytesAligned size align $ \ ptr ->     action (ptr, size)   where size = fromIntegral win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE-        -- workaround (hsc2hs for GHC < 8.0 don't support #{alignment ...})-        align = #{size char[alignof(HsDirectory_REPARSE_DATA_BUFFER)]}+        align = #{alignment HsDirectory_REPARSE_DATA_BUFFER}  win32_peek_REPARSE_DATA_BUFFER   :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER@@ -247,10 +255,10 @@                 (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0))       | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER   where-    peekName :: Ptr CWchar -> CUShort -> CUShort -> IO String+    peekName :: Ptr CWchar -> CUShort -> CUShort -> IO WindowsString     peekName buf offset size =-      peekCWStringLen ( buf `plusPtr` fromIntegral offset-                      , fromIntegral size `div` sizeOf (0 :: CWchar) )+      Win32.peekTStringLen ( buf `plusPtr` fromIntegral offset+                           , fromIntegral size `div` sizeOf (0 :: CWchar) )  deviceIoControl   :: Win32.HANDLE@@ -279,9 +287,9 @@     -> Ptr Void     -> IO Win32.BOOL -readSymbolicLink :: FilePath -> IO FilePath+readSymbolicLink :: OsPath -> IO OsPath readSymbolicLink path =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING                                 (Win32.fILE_FLAG_BACKUP_SEMANTICS .|.@@ -300,41 +308,44 @@                  | otherwise -> Win32.failWith "DeviceIoControl" e           Right _ -> pure ()         rData <- win32_peek_REPARSE_DATA_BUFFER ptr-        strip <$> case rData of+        strip . OsString <$> case rData of           Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn _ -> pure sn           Win32_SYMLINK_REPARSE_DATA_BUFFER sn _ _ -> pure sn           _ -> throwIO (mkIOError InappropriateType                                   "readSymbolicLink" Nothing Nothing)   where-    strip sn = fromMaybe sn (List.stripPrefix "\\??\\" sn)+    strip sn =+      fromMaybe sn+        (pack <$> List.stripPrefix (unpack (os "\\??\\")) (unpack sn))  -- | On Windows, equivalent to 'simplifyWindows'.-simplify :: FilePath -> FilePath+simplify :: OsPath -> OsPath simplify = simplifyWindows  -- | Normalise the path separators and prepend the @"\\\\?\\"@ prefix if -- necessary or possible.  This is used for symbolic links targets because -- they can't handle forward slashes.-normaliseSeparators :: FilePath -> FilePath+normaliseSeparators :: OsPath -> WindowsPath normaliseSeparators path-  | isRelative path = normaliseSep <$> path+  | isRelative path = getOsString (pack (normaliseSep <$> unpack path))   | otherwise = toExtendedLengthPath path   where normaliseSep c = if isPathSeparator c then pathSeparator else c  -- | 'simplify' the path and prepend the @"\\\\?\\"@ if possible.  This -- function can sometimes be used to bypass the @MAX_PATH@ length restriction -- in Windows API calls.-toExtendedLengthPath :: FilePath -> FilePath-toExtendedLengthPath path-  | isRelative path = simplifiedPath-  | otherwise =-      case simplifiedPath of-        '\\' : '?'  : '?' : '\\' : _ -> simplifiedPath-        '\\' : '\\' : '?' : '\\' : _ -> simplifiedPath-        '\\' : '\\' : '.' : '\\' : _ -> simplifiedPath-        '\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath-        _ -> "\\\\?\\" <> simplifiedPath+toExtendedLengthPath :: OsPath -> WindowsPath+toExtendedLengthPath path =+  getOsString $+  if isRelative path+  then simplifiedPath+  else+    case toChar <$> simplifiedPath' of+      '\\' : '?'  : '?' : '\\' : _ -> simplifiedPath+      '\\' : '\\' : _ -> simplifiedPath+      _ -> os "\\\\?\\" <> simplifiedPath   where simplifiedPath = simplify path+        simplifiedPath' = unpack simplifiedPath  -- | Make a path absolute and convert to an extended length path, if possible. --@@ -342,79 +353,110 @@ -- -- This function never fails.  If it doesn't understand the path, it just -- returns the path unchanged.-furnishPath :: FilePath -> IO FilePath+furnishPath :: OsPath -> IO WindowsPath furnishPath path =   (toExtendedLengthPath <$> rawPrependCurrentDirectory path)     `catchIOError` \ _ ->-      pure path+      pure (getOsString path)  -- | Strip the @"\\\\?\\"@ prefix if possible. -- The prefix is kept if the meaning of the path would otherwise change.-fromExtendedLengthPath :: FilePath -> FilePath-fromExtendedLengthPath ePath =-  case ePath of-    '\\' : '\\' : '?' : '\\' : path ->+fromExtendedLengthPath :: WindowsPath -> OsPath+fromExtendedLengthPath ePath' =+  case unpack ePath of+    c1 : c2 : c3 : c4 : path+      | (toChar <$> [c1, c2, c3, c4]) == "\\\\?\\" ->       case path of-        'U' : 'N' : 'C' : subpath@('\\' : _) -> "\\" <> subpath-        drive : ':' : subpath+        c5 : c6 : c7 : subpath@(c8 : _)+          | (toChar <$> [c5, c6, c7, c8]) == "UNC\\" ->+            pack (c8 : subpath)+        drive : col : subpath           -- if the path is not "regular", then the prefix is necessary           -- to ensure the path is interpreted literally-          | isAlpha drive && isAscii drive && isPathRegular subpath -> path+          | toChar col == ':', isDriveChar drive, isPathRegular subpath ->+            pack path         _ -> ePath     _ -> ePath   where+    ePath = OsString ePath'+    isDriveChar drive = isAlpha (toChar drive) && isAscii (toChar drive)     isPathRegular path =-      not ('/' `elem` path ||-           "." `elem` splitDirectories path ||-           ".." `elem` splitDirectories path)+      not ('/' `elem` (toChar <$> path) ||+           os "." `elem` splitDirectories (pack path) ||+           os ".." `elem` splitDirectories (pack path)) -getPathNameWith :: (Ptr CWchar -> Win32.DWORD -> IO Win32.DWORD) -> IO FilePath-getPathNameWith cFunc = do-  let getPathNameWithLen len = do-        allocaArray (fromIntegral len) $ \ ptrPathOut -> do-          len' <- Win32.failIfZero "" (cFunc ptrPathOut len)-          if len' <= len-            then Right <$> peekCWStringLen (ptrPathOut, fromIntegral len')-            else pure (Left len')-  r <- getPathNameWithLen ((#const MAX_PATH) * (#size wchar_t))-  case r of-    Right s -> pure s-    Left len -> do-      r' <- getPathNameWithLen len-      case r' of-        Right s -> pure s-        Left _ -> throwIO (mkIOError OtherError "" Nothing Nothing-                           `ioeSetErrorString` "path changed unexpectedly")+saturatingDouble :: Win32.DWORD -> Win32.DWORD+saturatingDouble s | s > maxBound `div` 2 = maxBound+                   | otherwise            = s * 2 -canonicalizePathWith :: ((FilePath -> IO FilePath) -> FilePath -> IO FilePath)-                     -> FilePath-                     -> IO FilePath-canonicalizePathWith attemptRealpath = attemptRealpath getFinalPathName+-- Handles Windows APIs that write strings through a user-provided buffer and+-- can propose a new length when it isn't big enough. This is similar to+-- Win32.try, but also returns the precise error code.+peekTStringWith :: Win32.DWORD+                -> (Win32.LPTSTR -> Win32.DWORD -> IO Win32.DWORD)+                -- ^ Must accept a buffer and its size in TCHARs. If the+                --   buffer is large enough for the function, it must write a+                --   string to it, which need not be null-terminated, and+                --   return the length of the string, not including the null+                --   terminator if present. If the buffer is too small, it+                --   must return a proposed buffer size in TCHARs, although it+                --   need not guarantee success with the proposed size if,+                --   say, the underlying data changes in the interim. If it+                --   fails for any other reason, it must return zero and+                --   communicate the error code through GetLastError.+                -> IO (Either Win32.ErrCode WindowsPath)+peekTStringWith bufferSize cFunc = do+  outcome <- do+    allocaArray (fromIntegral bufferSize) $ \ ptr -> do+      size <- cFunc ptr bufferSize+      case size of+        0 -> Right . Left <$> Win32.getLastError+        _ | size <= bufferSize ->+              Right . Right <$> Win32.peekTStringLen (ptr, fromIntegral size)+          | otherwise ->+              -- At least double the size to ensure fast termination.+              pure (Left (max size (saturatingDouble bufferSize)))+  case outcome of+    Left proposedSize -> peekTStringWith proposedSize cFunc+    Right result      -> pure result -canonicalizePathSimplify :: FilePath -> IO FilePath+realPath :: OsPath -> IO OsPath+realPath = getFinalPathName++canonicalizePathSimplify :: OsPath -> IO OsPath canonicalizePathSimplify path =   getFullPathName path     `catchIOError` \ _ ->       pure path -searchPathEnvForExes :: String -> IO (Maybe FilePath)-searchPathEnvForExes binary = Win32.searchPath Nothing binary $-#if MIN_VERSION_Win32(2, 6, 0)-  Just-#endif-  exeExtension+searchPathEnvForExes :: OsString -> IO (Maybe OsPath)+searchPathEnvForExes binaryPath@(OsString binary) = do+  maybePath <- search+    `catch` \e ->+      if ioeGetErrorType e == InvalidArgument+      then pure Nothing+      else throwIO e+  pure (OsString <$> maybePath >>= verify)+ where+  search = Win32.searchPath Nothing binary (Just (getOsString exeExtension))+  verify p+    | hasExtension binaryPath || exeExtension `isExtensionOf` p = Just p+    | otherwise = Nothing -findExecutablesLazyInternal :: ([FilePath] -> String -> ListT IO FilePath)-                            -> String-                            -> ListT IO FilePath+findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)+                            -> OsString+                            -> ListT IO OsPath findExecutablesLazyInternal _ = maybeToListT . searchPathEnvForExes -exeExtensionInternal :: String+exeExtensionInternal :: OsString exeExtensionInternal = exeExtension -getDirectoryContentsInternal :: FilePath -> IO [FilePath]+readDirToEnd :: RawHandle -> IO [OsPath]+readDirToEnd = getDirectoryContentsInternal++getDirectoryContentsInternal :: OsPath -> IO [OsPath] getDirectoryContentsInternal path = do-  query <- furnishPath (path </> "*")+  query <- furnishPath (path </> os "*")   bracket     (Win32.findFirstFile query)     (\ (h, _) -> Win32.findClose h)@@ -422,28 +464,28 @@   where     -- we needn't worry about empty directories: a directory always     -- has at least "." and ".." entries-    loop :: Win32.HANDLE -> Win32.FindData -> [FilePath] -> IO [FilePath]+    loop :: Win32.HANDLE -> Win32.FindData -> [OsPath] -> IO [OsPath]     loop h fdat acc = do       filename <- Win32.getFindDataFileName fdat       more <- Win32.findNextFile h fdat       if more-        then loop h fdat (filename : acc)-        else pure (filename : acc)+        then loop h fdat (OsString filename : acc)+        else pure (OsString filename : acc)              -- no need to reverse, ordering is undefined -getCurrentDirectoryInternal :: IO FilePath-getCurrentDirectoryInternal = Win32.getCurrentDirectory+getCurrentDirectoryInternal :: IO OsPath+getCurrentDirectoryInternal = OsString <$> Win32.getCurrentDirectory -getFullPathName :: FilePath -> IO FilePath+getFullPathName :: OsPath -> IO OsPath getFullPathName path =   fromExtendedLengthPath <$> Win32.getFullPathName (toExtendedLengthPath path)  -- | Similar to 'prependCurrentDirectory' but fails for empty paths.-rawPrependCurrentDirectory :: FilePath -> IO FilePath+rawPrependCurrentDirectory :: OsPath -> IO OsPath rawPrependCurrentDirectory path   | isRelative path =     ((`ioeAddLocation` "prependCurrentDirectory") .-     (`ioeSetFileName` path)) `modifyIOError` do+     (`ioeSetOsPath` path)) `modifyIOError` do       getFullPathName path   | otherwise = pure path @@ -456,19 +498,19 @@ -- operation may throw exceptions. -- -- Empty paths are treated as the current directory.-prependCurrentDirectory :: FilePath -> IO FilePath+prependCurrentDirectory :: OsPath -> IO OsPath prependCurrentDirectory = rawPrependCurrentDirectory . emptyToCurDir  -- SetCurrentDirectory does not support long paths even with the \\?\ prefix -- https://ghc.haskell.org/trac/ghc/ticket/13373#comment:6-setCurrentDirectoryInternal :: FilePath -> IO ()-setCurrentDirectoryInternal = Win32.setCurrentDirectory+setCurrentDirectoryInternal :: OsPath -> IO ()+setCurrentDirectoryInternal = Win32.setCurrentDirectory . getOsString -createSymbolicLinkUnpriv :: String -> String -> Bool -> IO ()+createSymbolicLinkUnpriv :: WindowsPath -> WindowsPath -> Bool -> IO () createSymbolicLinkUnpriv link _target _isDir = #ifdef HAVE_CREATESYMBOLICLINKW-  withCWString link $ \ pLink ->-  withCWString _target $ \ pTarget -> do+  Win32.withTString link $ \ pLink ->+  Win32.withTString _target $ \ pTarget -> do     let flags = if _isDir then win32_sYMBOLIC_LINK_FLAG_DIRECTORY else 0     call pLink pTarget flags win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE   where@@ -481,14 +523,16 @@                 let msg = "Incorrect function. The underlying file system " <>                           "might not support symbolic links."                 throwIO (mkIOError illegalOperationErrorType-                                   "CreateSymbolicLink" Nothing (Just link)+                                   "CreateSymbolicLink" Nothing Nothing+                         `ioeSetOsPath` OsString link                          `ioeSetErrorString` msg)             | e == win32_eRROR_PRIVILEGE_NOT_HELD -> do                 let msg = "A required privilege is not held by the client. " <>                           "Creating symbolic links usually requires " <>                           "administrative rights."                 throwIO (mkIOError permissionErrorType "CreateSymbolicLink"-                                   Nothing (Just link)+                                   Nothing Nothing+                         `ioeSetOsPath` OsString link                          `ioeSetErrorString` msg)             | e == win32_eRROR_INVALID_PARAMETER &&               unpriv /= 0 ->@@ -502,27 +546,35 @@     :: Ptr CWchar -> Ptr CWchar -> Win32.DWORD -> IO Win32.BYTE  #else-  throwIO . (`ioeSetErrorString` unsupportedErrorMsg) $+  throwIO . (`ioeSetErrorString` unsupportedErrorMsg)+          . (`ioeSetOsPath` OsString link) $                mkIOError UnsupportedOperation "CreateSymbolicLink"-                         Nothing (Just link)+                         Nothing Nothing   where unsupportedErrorMsg = "Not supported on Windows XP or older" #endif  linkToDirectoryIsDirectory :: Bool linkToDirectoryIsDirectory = True -createSymbolicLink :: Bool -> FilePath -> FilePath -> IO ()+createSymbolicLink :: Bool -> OsPath -> OsPath -> IO () createSymbolicLink isDir target link =-  (`ioeSetFileName` link) `modifyIOError` do+  (`ioeSetOsPath` link) `modifyIOError` do     -- normaliseSeparators ensures the target gets normalised properly     link' <- furnishPath link-    createSymbolicLinkUnpriv link' (normaliseSeparators target) isDir+    createSymbolicLinkUnpriv+      link'+      (normaliseSeparators target)+      isDir  type Metadata = Win32.BY_HANDLE_FILE_INFORMATION -getSymbolicLinkMetadata :: FilePath -> IO Metadata+getMetadataAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO Metadata+getMetadataAt NoFollow    dir path = getSymbolicLinkMetadata (pathAt dir path)+getMetadataAt FollowLinks dir path = getFileMetadata         (pathAt dir path)++getSymbolicLinkMetadata :: OsPath -> IO Metadata getSymbolicLinkMetadata path =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING                                 (Win32.fILE_FLAG_BACKUP_SEMANTICS .|.@@ -530,9 +582,9 @@     bracket open Win32.closeHandle $ \ h -> do       Win32.getFileInformationByHandle h -getFileMetadata :: FilePath -> IO Metadata+getFileMetadata :: OsPath -> IO Metadata getFileMetadata path =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING                                 Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing@@ -545,7 +597,7 @@   | isDir     = Directory   | otherwise = File   where-    isLink = attrs .&. win32_fILE_ATTRIBUTE_REPARSE_POINT /= 0+    isLink = attrs .&. Win32.fILE_ATTRIBUTE_REPARSE_POINT /= 0     isDir  = attrs .&. Win32.fILE_ATTRIBUTE_DIRECTORY /= 0     attrs  = Win32.bhfiFileAttributes info @@ -575,23 +627,20 @@ posixToWindowsTime t = Win32.FILETIME $   truncate (t * 10000000 + windowsPosixEpochDifference) -setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()+setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO () setTimes path' (atime', mtime') =   bracket (openFileHandle path' Win32.gENERIC_WRITE)           Win32.closeHandle $ \ handle ->-#if MIN_VERSION_Win32(2,12,0)-  Win32.setFileTime handle Nothing (posixToWindowsTime <$> atime') (posixToWindowsTime <$> mtime')-#else-  maybeWith with (posixToWindowsTime <$> atime') $ \ atime'' ->-  maybeWith with (posixToWindowsTime <$> mtime') $ \ mtime'' ->-  Win32.failIf_ not "" $-    Win32.c_SetFileTime handle nullPtr atime'' mtime''-#endif+  Win32.setFileTime+    handle+    Nothing+    (posixToWindowsTime <$> atime')+    (posixToWindowsTime <$> mtime')  -- | Open the handle of an existing file or directory.-openFileHandle :: String -> Win32.AccessMode -> IO Win32.HANDLE+openFileHandle :: OsString -> Win32.AccessMode -> IO Win32.HANDLE openFileHandle path mode =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     Win32.createFile path' mode maxShareMode Nothing                      Win32.oPEN_EXISTING flags Nothing@@ -610,26 +659,32 @@ setWriteMode False m = m .|. Win32.fILE_ATTRIBUTE_READONLY setWriteMode True  m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY -setFileMode :: FilePath -> Mode -> IO ()+setForceRemoveMode :: Mode -> Mode+setForceRemoveMode m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY++setModeAt :: Maybe RawHandle -> OsPath -> Mode -> IO ()+setModeAt dir path = setFileMode (pathAt dir path)++setFileMode :: OsPath -> Mode -> IO () setFileMode path mode =-  (`ioeSetFileName` path) `modifyIOError` do+  (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     Win32.setFileAttributes path' mode  -- | A restricted form of 'setFileMode' that only sets the permission bits. -- For Windows, this means only the "read-only" attribute is affected.-setFilePermissions :: FilePath -> Mode -> IO ()+setFilePermissions :: OsPath -> Mode -> IO () setFilePermissions path m = do   m' <- modeFromMetadata <$> getFileMetadata path   setFileMode path ((m' .&. complement Win32.fILE_ATTRIBUTE_READONLY) .|.                     (m  .&. Win32.fILE_ATTRIBUTE_READONLY)) -getAccessPermissions :: FilePath -> IO Permissions+getAccessPermissions :: OsPath -> IO Permissions getAccessPermissions path = do   m <- getFileMetadata path   let isDir = fileTypeIsDirectory (fileTypeFromMetadata m)   let w = hasWriteMode (modeFromMetadata m)-  let x = (toLower <$> takeExtension path)+  let x = (toLower . toChar <$> unpack (takeExtension path))           `elem` [".bat", ".cmd", ".com", ".exe"]   pure Permissions        { readable   = True@@ -638,39 +693,39 @@        , searchable = isDir        } -setAccessPermissions :: FilePath -> Permissions -> IO ()+setAccessPermissions :: OsPath -> Permissions -> IO () setAccessPermissions path Permissions{writable = w} = do   setFilePermissions path (setWriteMode w 0) -getFolderPath :: Win32.CSIDL -> IO FilePath-getFolderPath what = Win32.sHGetFolderPath nullPtr what nullPtr 0+getFolderPath :: Win32.CSIDL -> IO OsPath+getFolderPath what = OsString <$> Win32.sHGetFolderPath nullPtr what nullPtr 0 -getHomeDirectoryInternal :: IO FilePath+getHomeDirectoryInternal :: IO OsPath getHomeDirectoryInternal =   getFolderPath Win32.cSIDL_PROFILE `catchIOError` \ _ ->     getFolderPath Win32.cSIDL_WINDOWS -getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath+getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath getXdgDirectoryFallback _ xdgDir = do   case xdgDir of     XdgData   -> getFolderPath Win32.cSIDL_APPDATA     XdgConfig -> getFolderPath Win32.cSIDL_APPDATA-    XdgCache  -> getFolderPath win32_cSIDL_LOCAL_APPDATA-    XdgState  -> getFolderPath win32_cSIDL_LOCAL_APPDATA+    XdgCache  -> getFolderPath Win32.cSIDL_LOCAL_APPDATA+    XdgState  -> getFolderPath Win32.cSIDL_LOCAL_APPDATA -getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath]+getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath] getXdgDirectoryListFallback _ =   pure <$> getFolderPath win32_cSIDL_COMMON_APPDATA -getAppUserDataDirectoryInternal :: FilePath -> IO FilePath+getAppUserDataDirectoryInternal :: OsPath -> IO OsPath getAppUserDataDirectoryInternal appName =-  (\ appData -> appData <> ('\\' : appName))+  (\ appData -> appData <> (os "\\" <> appName))   <$> getXdgDirectoryFallback getHomeDirectoryInternal XdgData -getUserDocumentsDirectoryInternal :: IO FilePath+getUserDocumentsDirectoryInternal :: IO OsPath getUserDocumentsDirectoryInternal = getFolderPath Win32.cSIDL_PERSONAL -getTemporaryDirectoryInternal :: IO FilePath-getTemporaryDirectoryInternal = Win32.getTemporaryDirectory+getTemporaryDirectoryInternal :: IO OsPath+getTemporaryDirectoryInternal = OsString <$> Win32.getTemporaryDirectory  #endif
− System/Directory/Internal/utility.h 
@@ -1,6 +0,0 @@-#if !defined(alignof) && __cplusplus < 201103L-# ifdef STDC_HEADERS-#  include <stddef.h>-# endif-# define alignof(x) offsetof(struct { char c; x m; }, m)-#endif
+ System/Directory/OsPath.hs view
@@ -0,0 +1,1669 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Directory.OsPath+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  stable+-- Portability :  portable+--+-- System-independent interface to directory manipulation.+--+-- @since 1.3.8.0+--+-----------------------------------------------------------------------------++module System.Directory.OsPath+   (+    -- $intro++    -- * Actions on directories+      createDirectory+    , createDirectoryIfMissing+    , removeDirectory+    , removeDirectoryRecursive+    , removePathForcibly+    , renameDirectory+    , listDirectory+    , getDirectoryContents+    -- ** Current working directory+    , getCurrentDirectory+    , setCurrentDirectory+    , withCurrentDirectory++    -- * Pre-defined directories+    , getHomeDirectory+    , XdgDirectory(..)+    , getXdgDirectory+    , XdgDirectoryList(..)+    , getXdgDirectoryList+    , getAppUserDataDirectory+    , getUserDocumentsDirectory+    , getTemporaryDirectory++    -- * PATH+    , getExecSearchPath++    -- * Actions on files+    , removeFile+    , renameFile+    , renamePath+    , copyFile+    , copyFileWithMetadata+    , getFileSize++    , canonicalizePath+    , makeAbsolute+    , makeRelativeToCurrentDirectory++    -- * Existence tests+    , doesPathExist+    , doesFileExist+    , doesDirectoryExist++    , findExecutable+    , findExecutables+    , findExecutablesInDirectories+    , findFile+    , findFiles+    , findFileWith+    , findFilesWith+    , exeExtension++    -- * Symbolic links+    , createFileLink+    , createDirectoryLink+    , removeDirectoryLink+    , pathIsSymbolicLink+    , getSymbolicLinkTarget++    -- * Permissions++    -- $permissions++    , Permissions+    , emptyPermissions+    , readable+    , writable+    , executable+    , searchable+    , setOwnerReadable+    , setOwnerWritable+    , setOwnerExecutable+    , setOwnerSearchable++    , getPermissions+    , setPermissions+    , copyPermissions++    -- * Timestamps++    , getAccessTime+    , getModificationTime+    , setAccessTime+    , setModificationTime++   ) where+import Prelude ()+import System.Directory.Internal+import System.Directory.Internal.Prelude+import System.OsPath+  ( (<.>)+  , (</>)+  , addTrailingPathSeparator+  , dropTrailingPathSeparator+  , hasTrailingPathSeparator+  , isAbsolute+  , joinPath+  , makeRelative+  , splitDirectories+  , splitSearchPath+  , takeDirectory+  , encodeWith+  )+import qualified Data.List.NonEmpty as NE+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import GHC.IO.Encoding.UTF8 ( mkUTF8 )+import GHC.IO.Encoding.UTF16 ( mkUTF16le )+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )++{- $intro+A directory contains a series of entries, each of which is a named+reference to a file system object (file, directory etc.).  Some+entries may be hidden, inaccessible, or have some administrative+function (e.g. @.@ or @..@ under+<http://www.opengroup.org/onlinepubs/009695399 POSIX>), but in+this standard all such entries are considered to form part of the+directory contents. Entries in sub-directories are not, however,+considered to form part of the directory contents.++Each file system object is referenced by a /path/.  There is+normally at least one absolute path to each file system object.  In+some operating systems, it may also be possible to have paths which+are relative to the current directory.++Unless otherwise documented:++* 'IO' operations in this package may throw any 'IOError'.  No other types of+  exceptions shall be thrown.++* The list of possible 'IOErrorType's in the API documentation is not+  exhaustive.  The full list may vary by platform and/or evolve over time.++-}++-----------------------------------------------------------------------------+-- Permissions++{- $permissions++directory offers a limited (and quirky) interface for reading and setting file+and directory permissions; see 'getPermissions' and 'setPermissions' for a+discussion of their limitations.  Because permissions are very difficult to+implement portably across different platforms, users who wish to do more+sophisticated things with permissions are advised to use other,+platform-specific libraries instead.  For example, if you are only interested+in permissions on POSIX-like platforms,+<https://hackage.haskell.org/package/unix/docs/System-Posix-Files.html unix>+offers much more flexibility.++ The 'Permissions' type is used to record whether certain operations are+ permissible on a file\/directory. 'getPermissions' and 'setPermissions'+ get and set these permissions, respectively. Permissions apply both to+ files and directories. For directories, the executable field will be+ 'False', and for files the searchable field will be 'False'. Note that+ directories may be searchable without being readable, if permission has+ been given to use them as part of a path, but not to examine the+ directory contents.++Note that to change some, but not all permissions, a construct on the+following lines must be used.++>  makeReadable f = do+>     p <- getPermissions f+>     setPermissions f (p {readable = True})++-}++emptyPermissions :: Permissions+emptyPermissions = Permissions {+                       readable   = False,+                       writable   = False,+                       executable = False,+                       searchable = False+                   }++setOwnerReadable :: Bool -> Permissions -> Permissions+setOwnerReadable b p = p { readable = b }++setOwnerWritable :: Bool -> Permissions -> Permissions+setOwnerWritable b p = p { writable = b }++setOwnerExecutable :: Bool -> Permissions -> Permissions+setOwnerExecutable b p = p { executable = b }++setOwnerSearchable :: Bool -> Permissions -> Permissions+setOwnerSearchable b p = p { searchable = b }++-- | Get the permissions of a file or directory.+--+-- On Windows, the 'writable' permission corresponds to the "read-only"+-- attribute.  The 'executable' permission is set if the file extension is of+-- an executable file type.  The 'readable' permission is always set.+--+-- On POSIX systems, this returns the result of @access@.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to access the+--   permissions, or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+getPermissions :: OsPath -> IO Permissions+getPermissions path =+  (`ioeAddLocation` "getPermissions") `modifyIOError` do+    getAccessPermissions (emptyToCurDir path)++-- | Set the permissions of a file or directory.+--+-- On Windows, this is only capable of changing the 'writable' permission,+-- which corresponds to the "read-only" attribute.  Changing the other+-- permissions has no effect.+--+-- On POSIX systems, this sets the /owner/ permissions.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to set the permissions,+--   or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+setPermissions :: OsPath -> Permissions -> IO ()+setPermissions path p =+  (`ioeAddLocation` "setPermissions") `modifyIOError` do+    setAccessPermissions (emptyToCurDir path) p++-- | Copy the permissions of one file to another.  This reproduces the+-- permissions more accurately than using 'getPermissions' followed by+-- 'setPermissions'.+--+-- On Windows, this copies only the read-only attribute.+--+-- On POSIX systems, this is equivalent to @stat@ followed by @chmod@.+copyPermissions :: OsPath -> OsPath -> IO ()+copyPermissions src dst =+  (`ioeAddLocation` "copyPermissions") `modifyIOError` do+    m <- getFileMetadata src+    copyPermissionsFromMetadata m dst++copyPermissionsFromMetadata :: Metadata -> OsPath -> IO ()+copyPermissionsFromMetadata m dst = do+  -- instead of setFileMode, setFilePermissions is used here+  -- this is to retain backward compatibility in copyPermissions+  setFilePermissions dst (modeFromMetadata m)++-----------------------------------------------------------------------------+-- Implementation++{- |@'createDirectory' dir@ creates a new directory @dir@ which is+initially empty, or as near to empty as the operating system+allows.++The operation may fail with:++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES]@++* 'isAlreadyExistsError'+The operand refers to a directory that already exists.+@ [EEXIST]@++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+There is no path to the directory.+@[ENOENT, ENOTDIR]@++* 'System.IO.isFullError'+Insufficient resources (virtual memory, process file descriptors,+physical disk space, etc.) are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* @InappropriateType@+The path refers to an existing non-directory object.+@[EEXIST]@++-}++createDirectory :: OsPath -> IO ()+createDirectory = createDirectoryInternal++-- | @'createDirectoryIfMissing' parents dir@ creates a new directory+-- @dir@ if it doesn\'t exist. If the first argument is 'True'+-- the function will also create all parent directories if they are missing.+createDirectoryIfMissing+  :: Bool   -- ^ Create its parents too?+  -> OsPath -- ^ The path to the directory you want to make+  -> IO ()+createDirectoryIfMissing create_parents path0+  | create_parents = createDirs (parents path0)+  | otherwise      = createDirs (take 1 (parents path0))+  where+    parents = reverse . scanl1 (</>) . splitDirectories . simplify++    createDirs []         = pure ()+    createDirs [dir]      = createDir dir ioError+    createDirs (dir:dirs) =+      createDir dir $ \_ -> do+        createDirs dirs+        createDir dir ioError++    createDir dir notExistHandler = do+      r <- tryIOError (createDirectory dir)+      case r of+        Right ()                   -> pure ()+        Left  e+          | isDoesNotExistError  e -> notExistHandler e+          -- createDirectory (and indeed POSIX mkdir) does not distinguish+          -- between a dir already existing and a file already existing. So we+          -- check for it here. Unfortunately there is a slight race condition+          -- here, but we think it is benign. It could report an exception in+          -- the case that the dir did exist but another process deletes the+          -- directory and creates a file in its place before we can check+          -- that the directory did indeed exist.+          -- We also follow this path when we get a permissions error, as+          -- trying to create "." when in the root directory on Windows+          -- fails with+          --     CreateDirectory ".": permission denied (Access is denied.)+          -- This caused GHCi to crash when loading a module in the root+          -- directory.+          | isAlreadyExistsError e+         || isPermissionError    e -> do+              canIgnore <- pathIsDirectory dir+                             `catchIOError` \ _ ->+                               pure (isAlreadyExistsError e)+              unless canIgnore (ioError e)+          | otherwise              -> ioError e+++{- | @'removeDirectory' dir@ removes an existing directory /dir/.  The+implementation may specify additional constraints which must be+satisfied before a directory can be removed (e.g. the directory has to+be empty, or may not be in use by other processes).  It is not legal+for an implementation to partially remove a directory unless the+entire directory is removed. A conformant implementation need not+support directory removal in all situations (e.g. removal of the root+directory).++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The directory does not exist.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY, ENOTEMPTY, EEXIST]@++* @UnsupportedOperation@+The implementation does not support removal in this situation.+@[EINVAL]@++* @InappropriateType@+The operand refers to an existing non-directory object.+@[ENOTDIR]@++-}++removeDirectory :: OsPath -> IO ()+removeDirectory = removePathInternal True++type Preremover = Maybe RawHandle -> OsPath -> Metadata -> IO ()++noPreremover :: Preremover+noPreremover _ _ _ = pure ()++forcePreremover :: Preremover+forcePreremover dir path metadata = do+  when (fileTypeIsDirectory (fileTypeFromMetadata metadata)+        || not filesAlwaysRemovable) $ do+    setModeAt dir path mode+      `catchIOError` \ _ -> pure ()+  where+    mode = setForceRemoveMode (modeFromMetadata metadata)++removeRecursivelyAt+  :: (IO () -> IO ())+  -> ([IO ()] -> IO ())+  -> Preremover+  -> Maybe RawHandle+  -> OsPath+  -> IO ()+removeRecursivelyAt catcher sequencer preremover dir name = catcher $ do+  metadata <- getMetadataAt NoFollow dir name+  preremover dir name metadata+  let+    fileType = fileTypeFromMetadata metadata+    subremovals = do+      when (fileType == Directory) $ do+        bracket (openRaw NoFollow dir name) closeRaw $ \ handle -> do+          -- dropSpecialDotDirs is extremely important! Otherwise it will+          -- recurse into the parent directory and wreak havoc.+          names <- dropSpecialDotDirs <$> readDirToEnd handle+          sequencer (recurse (Just handle) <$> names)+  sequencer [subremovals, removePathAt fileType dir name]+  where recurse = removeRecursivelyAt catcher sequencer preremover++-- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/+-- together with its contents and subdirectories. Within this directory,+-- symbolic links are removed without affecting their targets.+--+-- On Windows, the operation fails if /dir/ is a directory symbolic link.+--+-- This operation is reported to be flaky on Windows so retry logic may+-- be advisable. See: https://github.com/haskell/directory/pull/108+removeDirectoryRecursive :: OsPath -> IO ()+removeDirectoryRecursive path =+  (`ioeAddLocation` "removeDirectoryRecursive") `modifyIOError` do+    m <- getSymbolicLinkMetadata path+    case fileTypeFromMetadata m of+      Directory ->+        removeRecursivelyAt id sequenceA_ noPreremover Nothing path+      DirectoryLink ->+        ioError (err `ioeSetErrorString` "is a directory symbolic link")+      _ ->+        ioError (err `ioeSetErrorString` "not a directory")+  where err = mkIOError InappropriateType "" Nothing Nothing `ioeSetOsPath` path++-- | Removes a file or directory at /path/ together with its contents and+-- subdirectories. Symbolic links are removed without affecting their+-- targets. If the path does not exist, nothing happens.+--+-- Unlike other removal functions, this function will also attempt to delete+-- files marked as read-only or otherwise made unremovable due to permissions.+-- As a result, if the removal is incomplete, the permissions or attributes on+-- the remaining files may be altered.  If there are hard links in the+-- directory, then permissions on all related hard links may be altered.+--+-- If an entry within the directory vanishes while @removePathForcibly@ is+-- running, it is silently ignored.+--+-- If an exception occurs while removing an entry, @removePathForcibly@ will+-- still try to remove as many entries as it can before failing with an+-- exception.  The first exception that it encountered is re-thrown.+removePathForcibly :: OsPath -> IO ()+removePathForcibly path =+  (`ioeAddLocation` "removePathForcibly") `modifyIOError` do+    removeRecursivelyAt+      ignoreDoesNotExistError+      sequenceWithIOErrors_+      forcePreremover+      Nothing+      path++  where++    ignoreDoesNotExistError :: IO () -> IO ()+    ignoreDoesNotExistError action =+      () <$ tryIOErrorType isDoesNotExistError action++{- |'removeFile' /file/ removes the directory entry for an existing file+/file/, where /file/ is not itself a directory. The+implementation may specify additional constraints which must be+satisfied before a file can be removed (e.g. the file may not be in+use by other processes).++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+The operand is not a valid file name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The file does not exist.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY]@++* @InappropriateType@+The operand refers to an existing directory.+@[EPERM, EINVAL]@++-}++removeFile :: OsPath -> IO ()+removeFile = removePathInternal False++{- |@'renameDirectory' old new@ changes the name of an existing+directory from /old/ to /new/.  If the /new/ directory+already exists, it is atomically replaced by the /old/ directory.+If the /new/ directory is neither the /old/ directory nor an+alias of the /old/ directory, it is removed as if by+'removeDirectory'.  A conformant implementation need not support+renaming directories in all situations (e.g. renaming to an existing+directory, or across different physical devices), but the constraints+must be documented.++On Win32 platforms, @renameDirectory@ fails if the /new/ directory already+exists.++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+Either operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The original directory does not exist, or there is no path to the target.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'System.IO.isFullError'+Insufficient resources are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY, ENOTEMPTY, EEXIST]@++* @UnsupportedOperation@+The implementation does not support renaming in this situation.+@[EINVAL, EXDEV]@++* @InappropriateType@+Either path refers to an existing non-directory object.+@[ENOTDIR, EISDIR]@++-}++renameDirectory :: OsPath -> OsPath -> IO ()+renameDirectory opath npath =+   (`ioeAddLocation` "renameDirectory") `modifyIOError` do+     -- XXX this test isn't performed atomically with the following rename+     isDir <- pathIsDirectory opath+     when (not isDir) . ioError $+       mkIOError InappropriateType "renameDirectory" Nothing Nothing+       `ioeSetErrorString` "not a directory"+       `ioeSetOsPath` opath+     renamePath opath npath++{- |@'renameFile' old new@ changes the name of an existing file system+object from /old/ to /new/.  If the /new/ object already exists, it is+replaced by the /old/ object.  Neither path may refer to an existing+directory.++A conformant implementation need not support renaming files in all situations+(e.g. renaming across different physical devices), but the constraints must be+documented. On Windows, this does not support renaming across different physical+devices; if you are looking to do so, consider using 'copyFileWithMetadata' and+'removeFile'.++On Windows, this calls @MoveFileEx@ with @MOVEFILE_REPLACE_EXISTING@ set,+which is not guaranteed to be atomic+(<https://github.com/haskell/directory/issues/109>).++On other platforms, this operation is atomic.++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+Either operand is not a valid file name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The original file does not exist, or there is no path to the target.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'System.IO.isFullError'+Insufficient resources are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY]@++* @UnsupportedOperation@+The implementation does not support renaming in this situation.+@[EXDEV]@++* @InappropriateType@+Either path refers to an existing directory.+@[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@++-}++renameFile :: OsPath -> OsPath -> IO ()+renameFile opath npath =+  (`ioeAddLocation` "renameFile") `modifyIOError` do+    -- XXX the tests are not performed atomically with the rename+    checkNotDir opath+    renamePath opath npath+      -- The underlying rename implementation can throw odd exceptions when the+      -- destination is a directory.  For example, Windows typically throws a+      -- permission error, while POSIX systems may throw a resource busy error+      -- if one of the paths refers to the current directory.  In these cases,+      -- we check if the destination is a directory and, if so, throw an+      -- InappropriateType error.+      `catchIOError` \ err -> do+        checkNotDir npath+        ioError err+  where checkNotDir path = do+          m <- tryIOError (getSymbolicLinkMetadata path)+          case fileTypeIsDirectory . fileTypeFromMetadata <$> m of+            Right True ->+              ioError $+              mkIOError InappropriateType "" Nothing Nothing+              `ioeSetErrorString` "is a directory"+              `ioeSetOsPath` path+            _          -> pure ()++-- | Rename a file or directory.  If the destination path already exists, it+-- is replaced atomically.  The destination path must not point to an existing+-- directory.  A conformant implementation need not support renaming files in+-- all situations (e.g. renaming across different physical devices), but the+-- constraints must be documented.+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * @InvalidArgument@+-- Either operand is not a valid file name.+-- @[ENAMETOOLONG, ELOOP]@+--+-- * 'isDoesNotExistError'+-- The original file does not exist, or there is no path to the target.+-- @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EROFS, EACCES, EPERM]@+--+-- * 'System.IO.isFullError'+-- Insufficient resources are available to perform the operation.+-- @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@+--+-- * @UnsatisfiedConstraints@+-- Implementation-dependent constraints are not satisfied.+-- @[EBUSY]@+--+-- * @UnsupportedOperation@+-- The implementation does not support renaming in this situation.+-- @[EXDEV]@+--+-- * @InappropriateType@+-- Either the destination path refers to an existing directory, or one of the+-- parent segments in the destination path is not a directory.+-- @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@+renamePath :: OsPath                  -- ^ Old path+           -> OsPath                  -- ^ New path+           -> IO ()+renamePath opath npath =+  (`ioeAddLocation` "renamePath") `modifyIOError` do+    renamePathInternal opath npath++-- | Copy a file with its permissions.  If the destination file already exists,+-- it is replaced atomically.  Neither path may refer to an existing+-- directory.  No exceptions are thrown if the permissions could not be+-- copied.+copyFile :: OsPath                    -- ^ Source filename+         -> OsPath                    -- ^ Destination filename+         -> IO ()+copyFile fromFPath toFPath =+  (`ioeAddLocation` "copyFile") `modifyIOError` do+    atomicCopyFileContents fromFPath toFPath+      (ignoreIOExceptions . copyPermissions fromFPath)++-- | Copy all data from a file to a handle.+copyFileToHandle :: OsPath              -- ^ Source file+                 -> Handle              -- ^ Destination handle+                 -> IO ()+copyFileToHandle fromFPath hTo =+  (`ioeAddLocation` "copyFileToHandle") `modifyIOError` do+    withBinaryFile fromFPath ReadMode $ \ hFrom ->+      copyHandleData hFrom hTo++-- | Copy the contents of a source file to a destination file, replacing the+-- destination file atomically via @withReplacementFile@, resetting the+-- attributes of the destination file to the defaults.+atomicCopyFileContents :: OsPath            -- ^ Source filename+                       -> OsPath            -- ^ Destination filename+                       -> (OsPath -> IO ()) -- ^ Post-action+                       -> IO ()+atomicCopyFileContents fromFPath toFPath postAction =+  (`ioeAddLocation` "atomicCopyFileContents") `modifyIOError` do+    withReplacementFile toFPath postAction $ \ hTo -> do+      copyFileToHandle fromFPath hTo++-- | A helper function useful for replacing files in an atomic manner.  The+-- function creates a temporary file in the directory of the destination file,+-- opens it, performs the main action with its handle, closes it, performs the+-- post-action with its path, and finally replaces the destination file with+-- the temporary file.  If an error occurs during any step of this process,+-- the temporary file is removed and the destination file remains untouched.+withReplacementFile :: OsPath            -- ^ Destination file+                    -> (OsPath -> IO ()) -- ^ Post-action+                    -> (Handle -> IO a)  -- ^ Main action+                    -> IO a+withReplacementFile path postAction action =+  (`ioeAddLocation` "withReplacementFile") `modifyIOError` do+    mask $ \ restore -> do+      let tmpPath = case encodeWith (mkUTF8 ErrorOnCodingFailure)+                                    (mkUTF16le ErrorOnCodingFailure)+                                    ".copyFile.tmp"+                         of+            Left err ->+              error ("withReplacementFile: invalid encoding: " <> show err)+            Right p -> p+      let dir = takeDirectory path+      (tmpFPath, hTmp) <-+        openTempFile' "openTempFile'" dir tmpPath True 0o600 True+      (`onException` ignoreIOExceptions (removeFile tmpFPath)) $ do+        r <- (`onException` ignoreIOExceptions (hClose hTmp)) $ do+          restore (action hTmp)+        hClose hTmp+        restore (postAction tmpFPath)+        renameFile tmpFPath path+        pure r++-- | Copy a file with its associated metadata.  If the destination file+-- already exists, it is overwritten.  There is no guarantee of atomicity in+-- the replacement of the destination file.  Neither path may refer to an+-- existing directory.  If the source and/or destination are symbolic links,+-- the copy is performed on the targets of the links.+--+-- On Windows, it behaves like the Win32 function+-- <https://msdn.microsoft.com/en-us/library/windows/desktop/aa363851.aspx CopyFile>,+-- which copies various kinds of metadata including file attributes and+-- security resource properties.+--+-- On Unix-like systems, permissions, access time, and modification time are+-- preserved.  If possible, the owner and group are also preserved.  Note that+-- the very act of copying can change the access time of the source file,+-- hence the access times of the two files may differ after the operation+-- completes.+copyFileWithMetadata :: OsPath        -- ^ Source file+                     -> OsPath        -- ^ Destination file+                     -> IO ()+copyFileWithMetadata src dst =+  (`ioeAddLocation` "copyFileWithMetadata") `modifyIOError`+    copyFileWithMetadataInternal copyPermissionsFromMetadata+                                 copyTimesFromMetadata+                                 src+                                 dst++copyTimesFromMetadata :: Metadata -> OsPath -> IO ()+copyTimesFromMetadata st dst = do+  let atime = accessTimeFromMetadata st+  let mtime = modificationTimeFromMetadata st+  setFileTimes dst (Just atime, Just mtime)++-- | Make a path absolute, normalize the path, and remove as many indirections+-- from it as possible.  Any trailing path separators are discarded via+-- 'dropTrailingPathSeparator'.  Additionally, on Windows the letter case of+-- the path is canonicalized.+--+-- __Note__: This function is a very big hammer.  If you only need an absolute+-- path, 'makeAbsolute' is sufficient for removing dependence on the current+-- working directory.+--+-- Indirections include the two special directories @.@ and @..@, as well as+-- any symbolic links (and junction points on Windows).  The input path need+-- not point to an existing file or directory.  Canonicalization is performed+-- on the longest prefix of the path that points to an existing file or+-- directory.  The remaining portion of the path that does not point to an+-- existing file or directory will still be normalized, but case+-- canonicalization and indirection removal are skipped as they are impossible+-- to do on a nonexistent path.+--+-- Most programs should not worry about the canonicity of a path.  In+-- particular, despite the name, the function does not truly guarantee+-- canonicity of the returned path due to the presence of hard links, mount+-- points, etc.+--+-- If the path points to an existing file or directory, then the output path+-- shall also point to the same file or directory, subject to the condition+-- that the relevant parts of the file system do not change while the function+-- is still running.  In other words, the function is definitively not atomic.+-- The results can be utterly wrong if the portions of the path change while+-- this function is running.+--+-- Since some indirections (symbolic links on all systems, @..@ on non-Windows+-- systems, and junction points on Windows) are dependent on the state of the+-- existing filesystem, the function can only make a conservative attempt by+-- removing such indirections from the longest prefix of the path that still+-- points to an existing file or directory.+--+-- Note that on Windows parent directories @..@ are always fully expanded+-- before the symbolic links, as consistent with the rest of the Windows API+-- (such as @GetFullPathName@).  In contrast, on POSIX systems parent+-- directories @..@ are expanded alongside symbolic links from left to right.+-- To put this more concretely: if @L@ is a symbolic link for @R/P@, then on+-- Windows @L\\..@ refers to @.@, whereas on other operating systems @L/..@+-- refers to @R@.+--+-- Similar to 'System.FilePath.normalise', passing an empty path is equivalent+-- to passing the current directory.+--+-- @canonicalizePath@ can resolve at least 64 indirections in a single path,+-- more than what is supported by most operating systems.  Therefore, it may+-- return the fully resolved path even though the operating system itself+-- would have long given up.+--+-- On Windows XP or earlier systems, junction expansion is not performed due+-- to their lack of @GetFinalPathNameByHandle@.+--+-- /Changes since 1.2.3.0:/ The function has been altered to be more robust+-- and has the same exception behavior as 'makeAbsolute'.+--+-- /Changes since 1.3.0.0:/ The function no longer preserves the trailing path+-- separator.  File symbolic links that appear in the middle of a path are+-- properly dereferenced.  Case canonicalization and symbolic link expansion+-- are now performed on Windows.+--+canonicalizePath :: OsPath -> IO OsPath+canonicalizePath = \ path ->+  ((`ioeAddLocation` "canonicalizePath") .+   (`ioeSetOsPath` path)) `modifyIOError` do+    -- simplify does more stuff, like upper-casing the drive letter+    dropTrailingPathSeparator . simplify <$>+      (attemptRealpath realPath =<< prependCurrentDirectory path)+  where++    -- allow up to 64 cycles before giving up+    attemptRealpath realpath =+      attemptRealpathWith (64 :: Int) Nothing realpath+      <=< canonicalizePathSimplify++    -- n is a counter to make sure we don't run into an infinite loop; we+    -- don't try to do any cycle detection here because an adversary could DoS+    -- any arbitrarily clever algorithm+    attemptRealpathWith n mFallback realpath path =+      case mFallback of+        -- too many indirections ... giving up.+        Just fallback | n <= 0 -> pure fallback+        -- either mFallback == Nothing (first attempt)+        --     or n > 0 (still have some attempts left)+        _ -> realpathPrefix (reverse (zip prefixes suffixes))++      where++        segments = splitDirectories path+        prefixes = scanl1 (</>) segments+        suffixes = NE.tail (NE.scanr (</>) mempty segments)++        -- try to call realpath on the largest possible prefix+        realpathPrefix candidates =+          case candidates of+            [] -> pure path+            (prefix, suffix) : rest -> do+              exist <- doesPathExist prefix+              if not exist+                -- never call realpath on an inaccessible path+                -- (to avoid bugs in system realpath implementations)+                -- try a smaller prefix instead+                then realpathPrefix rest+                else do+                  mp <- tryIOError (realpath prefix)+                  case mp of+                    -- realpath failed: try a smaller prefix instead+                    Left _ -> realpathPrefix rest+                    -- realpath succeeded: fine-tune the result+                    Right p -> realpathFurther (p </> suffix) p suffix++        -- by now we have a reasonable fallback value that we can use if we+        -- run into too many indirections; the fallback value is the same+        -- result that we have been returning in versions prior to 1.3.1.0+        -- (this is essentially the fix to #64)+        realpathFurther fallback p suffix =+          case splitDirectories suffix of+            [] -> pure fallback+            next : restSuffix -> do+              -- see if the 'next' segment is a symlink+              mTarget <- tryIOError (getSymbolicLinkTarget (p </> next))+              case mTarget of+                Left _ -> pure fallback+                Right target -> do+                  -- if so, dereference it and restart the whole cycle+                  let mFallback' = Just (fromMaybe fallback mFallback)+                  path' <- canonicalizePathSimplify+                             (p </> target </> joinPath restSuffix)+                  attemptRealpathWith (n - 1) mFallback' realpath path'++-- | Convert a path into an absolute path.  If the given path is relative, the+-- current directory is prepended and then the combined result is normalized.+-- If the path is already absolute, the path is simply normalized.  The+-- function preserves the presence or absence of the trailing path separator+-- unless the path refers to the root directory @/@.+--+-- If the path is already absolute, the operation never fails.  Otherwise, the+-- operation may fail with the same exceptions as 'getCurrentDirectory'.+--+makeAbsolute :: OsPath -> IO OsPath+makeAbsolute path =+  ((`ioeAddLocation` "makeAbsolute") .+   (`ioeSetOsPath` path)) `modifyIOError` do+    matchTrailingSeparator path . simplify <$> prependCurrentDirectory path++-- | Add or remove the trailing path separator in the second path so as to+-- match its presence in the first path.+--+-- (internal API)+matchTrailingSeparator :: OsPath -> OsPath -> OsPath+matchTrailingSeparator path+  | hasTrailingPathSeparator path = addTrailingPathSeparator+  | otherwise                     = dropTrailingPathSeparator++-- | Construct a path relative to the current directory, similar to+-- 'makeRelative'.+--+-- The operation may fail with the same exceptions as 'getCurrentDirectory'.+makeRelativeToCurrentDirectory :: OsPath -> IO OsPath+makeRelativeToCurrentDirectory x = do+  (`makeRelative` x) <$> getCurrentDirectory++-- | Given the name or path of an executable file, 'findExecutable' searches+-- for such a file in a list of system-defined locations, which generally+-- includes @PATH@ and possibly more.  The full path to the executable is+-- returned if found.  For example, @(findExecutable \"ghc\")@ would normally+-- give you the path to GHC.+--+-- The path returned by @'findExecutable' name@ corresponds to the program+-- that would be executed by+-- @<http://hackage.haskell.org/package/process/docs/System-Process.html#v:createProcess createProcess>@+-- when passed the same string (as a @RawCommand@, not a @ShellCommand@),+-- provided that @name@ is not a relative path with more than one segment.+--+-- On Windows, 'findExecutable' calls the Win32 function+-- @<https://msdn.microsoft.com/en-us/library/aa365527.aspx SearchPath>@,+-- which may search other places before checking the directories in the @PATH@+-- environment variable.  Where it actually searches depends on registry+-- settings, but notably includes the directory containing the current+-- executable.+--+-- On non-Windows platforms, the behavior is equivalent to 'findFileWith'+-- using the search directories from the @PATH@ environment variable and+-- testing each file for executable permissions.  Details can be found in the+-- documentation of 'findFileWith'.+findExecutable :: OsString -> IO (Maybe OsPath)+findExecutable binary =+  listTHead+    (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)++-- | Search for executable files in a list of system-defined locations, which+-- generally includes @PATH@ and possibly more.+--+-- On Windows, this /only returns the first occurrence/, if any.  Its behavior+-- is therefore equivalent to 'findExecutable'.+--+-- On non-Windows platforms, the behavior is equivalent to+-- 'findExecutablesInDirectories' using the search directories from the @PATH@+-- environment variable.  Details can be found in the documentation of+-- 'findExecutablesInDirectories'.+findExecutables :: OsString -> IO [OsPath]+findExecutables binary =+  listTToList+    (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)++-- | Given a name or path, 'findExecutable' appends the 'exeExtension' to the+-- query and searches for executable files in the list of given search+-- directories and returns all occurrences.+--+-- The behavior is equivalent to 'findFileWith' using the given search+-- directories and testing each file for executable permissions.  Details can+-- be found in the documentation of 'findFileWith'.+--+-- Unlike other similarly named functions, 'findExecutablesInDirectories' does+-- not use @SearchPath@ from the Win32 API.  The behavior of this function on+-- Windows is therefore equivalent to those on non-Windows platforms.+findExecutablesInDirectories :: [OsPath] -> OsString -> IO [OsPath]+findExecutablesInDirectories path binary =+  listTToList (findExecutablesInDirectoriesLazy path binary)++findExecutablesInDirectoriesLazy :: [OsPath] -> OsString -> ListT IO OsPath+findExecutablesInDirectoriesLazy path binary =+  findFilesWithLazy isExecutable path (binary <.> exeExtension)++-- | Test whether a file has executable permissions.+isExecutable :: OsPath -> IO Bool+isExecutable file = executable <$> getPermissions file++-- | Search through the given list of directories for the given file.+--+-- The behavior is equivalent to 'findFileWith', returning only the first+-- occurrence.  Details can be found in the documentation of 'findFileWith'.+findFile :: [OsPath] -> OsString -> IO (Maybe OsPath)+findFile = findFileWith (\ _ -> pure True)++-- | Search through the given list of directories for the given file and+-- returns all paths where the given file exists.+--+-- The behavior is equivalent to 'findFilesWith'.  Details can be found in the+-- documentation of 'findFilesWith'.+findFiles :: [OsPath] -> OsString -> IO [OsPath]+findFiles = findFilesWith (\ _ -> pure True)++-- | Search through a given list of directories for a file that has the given+-- name and satisfies the given predicate and return the path of the first+-- occurrence.  The directories are checked in a left-to-right order.+--+-- This is essentially a more performant version of 'findFilesWith' that+-- always returns the first result, if any.  Details can be found in the+-- documentation of 'findFilesWith'.+findFileWith :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> IO (Maybe OsPath)+findFileWith f ds name = listTHead (findFilesWithLazy f ds name)++-- | @findFilesWith predicate dirs name@ searches through the list of+-- directories (@dirs@) for files that have the given @name@ and satisfy the+-- given @predicate@ and returns the paths of those files.  The directories+-- are checked in a left-to-right order and the paths are returned in the same+-- order.+--+-- If the @name@ is a relative path, then for every search directory @dir@,+-- the function checks whether @dir '</>' name@ exists and satisfies the+-- predicate.  If so, @dir '</>' name@ is returned as one of the results.  In+-- other words, the returned paths can be either relative or absolute+-- depending on the search directories were used.  If there are no search+-- directories, no results are ever returned.+--+-- If the @name@ is an absolute path, then the function will return a single+-- result if the file exists and satisfies the predicate and no results+-- otherwise.  This is irrespective of what search directories were given.+findFilesWith :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> IO [OsPath]+findFilesWith f ds name = listTToList (findFilesWithLazy f ds name)++findFilesWithLazy+  :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> ListT IO OsPath+findFilesWithLazy f dirs path+  -- make sure absolute paths are handled properly irrespective of 'dirs'+  -- https://github.com/haskell/directory/issues/72+  | isAbsolute path = ListT (find [mempty])+  | otherwise       = ListT (find dirs)++  where++    find []       = pure Nothing+    find (d : ds) = do+      let p = d </> path+      found <- doesFileExist p `andM` f p+      if found+        then pure (Just (p, ListT (find ds)))+        else find ds++-- | Filename extension for executable files (including the dot if any)+--   (usually @\"\"@ on POSIX systems and @\".exe\"@ on Windows or OS\/2).+exeExtension :: OsString+exeExtension = exeExtensionInternal++-- | Similar to 'listDirectory', but always includes the special entries (@.@+-- and @..@).  (This applies to Windows as well.)+--+-- The operation may fail with the same exceptions as 'listDirectory'.+getDirectoryContents :: OsPath -> IO [OsPath]+getDirectoryContents path =+  ((`ioeSetOsPath` path) .+   (`ioeAddLocation` "getDirectoryContents")) `modifyIOError` do+    getDirectoryContentsInternal path++-- | @'listDirectory' dir@ returns a list of /all/ entries in /dir/ without+-- the special entries (@.@ and @..@).+--+-- The operation may fail with:+--+-- * @HardwareFault@+--   A physical I\/O error has occurred.+--   @[EIO]@+--+-- * @InvalidArgument@+--   The operand is not a valid directory name.+--   @[ENAMETOOLONG, ELOOP]@+--+-- * 'isDoesNotExistError'+--   The directory does not exist.+--   @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError'+--   The process has insufficient privileges to perform the operation.+--   @[EACCES]@+--+-- * 'System.IO.isFullError'+--   Insufficient resources are available to perform the operation.+--   @[EMFILE, ENFILE]@+--+-- * @InappropriateType@+--   The path refers to an existing non-directory object.+--   @[ENOTDIR]@+--+listDirectory :: OsPath -> IO [OsPath]+listDirectory path = dropSpecialDotDirs <$> getDirectoryContents path++-- | Obtain the current working directory as an absolute path.+--+-- In a multithreaded program, the current working directory is a global state+-- shared among all threads of the process.  Therefore, when performing+-- filesystem operations from multiple threads, it is highly recommended to+-- use absolute rather than relative paths (see: 'makeAbsolute').+--+-- Note that 'getCurrentDirectory' is not guaranteed to return the same path+-- received by 'setCurrentDirectory'. On POSIX systems, the path returned will+-- always be fully dereferenced (not contain any symbolic links). For more+-- information, refer to the documentation of+-- <https://pubs.opengroup.org/onlinepubs/9699919799/functions/getcwd.html getcwd>.+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * 'isDoesNotExistError'+-- There is no path referring to the working directory.+-- @[EPERM, ENOENT, ESTALE...]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EACCES]@+--+-- * 'System.IO.isFullError'+-- Insufficient resources are available to perform the operation.+--+-- * @UnsupportedOperation@+-- The operating system has no notion of current working directory.+--+getCurrentDirectory :: IO OsPath+getCurrentDirectory =+  (`ioeAddLocation` "getCurrentDirectory") `modifyIOError` do+    specializeErrorString+      "Current working directory no longer exists"+      isDoesNotExistError+      getCurrentDirectoryInternal++-- | Change the working directory to the given path.+--+-- In a multithreaded program, the current working directory is a global state+-- shared among all threads of the process.  Therefore, when performing+-- filesystem operations from multiple threads, it is highly recommended to+-- use absolute rather than relative paths (see: 'makeAbsolute').+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * @InvalidArgument@+-- The operand is not a valid directory name.+-- @[ENAMETOOLONG, ELOOP]@+--+-- * 'isDoesNotExistError'+-- The directory does not exist.+-- @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EACCES]@+--+-- * @UnsupportedOperation@+-- The operating system has no notion of current working directory, or the+-- working directory cannot be dynamically changed.+--+-- * @InappropriateType@+-- The path refers to an existing non-directory object.+-- @[ENOTDIR]@+--+setCurrentDirectory :: OsPath -> IO ()+setCurrentDirectory = setCurrentDirectoryInternal++-- | Run an 'IO' action with the given working directory and restore the+-- original working directory afterwards, even if the given action fails due+-- to an exception.+--+-- The operation may fail with the same exceptions as 'getCurrentDirectory'+-- and 'setCurrentDirectory'.+--+withCurrentDirectory :: OsPath    -- ^ Directory to execute in+                     -> IO a      -- ^ Action to be executed+                     -> IO a+withCurrentDirectory dir action =+  bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+    setCurrentDirectory dir+    action++-- | Obtain the size of a file in bytes.+getFileSize :: OsPath -> IO Integer+getFileSize path =+  (`ioeAddLocation` "getFileSize") `modifyIOError` do+    fileSizeFromMetadata <$> getFileMetadata path++-- | Test whether the given path points to an existing filesystem object.  If+-- the user lacks necessary permissions to search the parent directories, this+-- function may return false even if the file does actually exist.  This+-- operation traverses symbolic links, so it can return either True or False+-- for them.+doesPathExist :: OsPath -> IO Bool+doesPathExist path = do+  (True <$ getFileMetadata path)+    `catchIOError` \ _ ->+      pure False++-- | The operation 'doesDirectoryExist' returns 'True' if the argument file+-- exists and is either a directory or a symbolic link to a directory, and+-- 'False' otherwise.  This operation traverses symbolic links, so it can+-- return either True or False for them.+doesDirectoryExist :: OsPath -> IO Bool+doesDirectoryExist path = do+  pathIsDirectory path+    `catchIOError` \ _ ->+      pure False++-- | The operation 'doesFileExist' returns 'True' if the argument file exists+-- and is not a directory, and 'False' otherwise.  This operation traverses+-- symbolic links, so it can return either True or False for them.+doesFileExist :: OsPath -> IO Bool+doesFileExist path = do+  (not <$> pathIsDirectory path)+    `catchIOError` \ _ ->+      pure False++pathIsDirectory :: OsPath -> IO Bool+pathIsDirectory path =+  (`ioeAddLocation` "pathIsDirectory") `modifyIOError` do+    fileTypeIsDirectory . fileTypeFromMetadata <$> getFileMetadata path++-- | Create a /file/ symbolic link.  The target path can be either absolute or+-- relative and need not refer to an existing file.  The order of arguments+-- follows the POSIX convention.+--+-- To remove an existing file symbolic link, use 'removeFile'.+--+-- Although the distinction between /file/ symbolic links and /directory/+-- symbolic links does not exist on POSIX systems, on Windows this is an+-- intrinsic property of every symbolic link and cannot be changed without+-- recreating the link.  A file symbolic link that actually points to a+-- directory will fail to dereference and vice versa.  Moreover, creating+-- symbolic links on Windows may require privileges unavailable to users+-- outside the Administrators group.  Portable programs that use symbolic+-- links should take both into consideration.+--+-- On Windows, the function is implemented using @CreateSymbolicLink@.  Since+-- 1.3.3.0, the @SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE@ flag is included+-- if supported by the operating system.  On POSIX, the function uses @symlink@+-- and is therefore atomic.+--+-- Windows-specific errors: This operation may fail with 'permissionErrorType'+-- if the user lacks the privileges to create symbolic links.  It may also+-- fail with 'illegalOperationErrorType' if the file system does not support+-- symbolic links.+createFileLink+  :: OsPath                           -- ^ path to the target file+  -> OsPath                           -- ^ path of the link to be created+  -> IO ()+createFileLink target link =+  (`ioeAddLocation` "createFileLink") `modifyIOError` do+    createSymbolicLink False target link++-- | Create a /directory/ symbolic link.  The target path can be either+-- absolute or relative and need not refer to an existing directory.  The+-- order of arguments follows the POSIX convention.+--+-- To remove an existing directory symbolic link, use 'removeDirectoryLink'.+--+-- Although the distinction between /file/ symbolic links and /directory/+-- symbolic links does not exist on POSIX systems, on Windows this is an+-- intrinsic property of every symbolic link and cannot be changed without+-- recreating the link.  A file symbolic link that actually points to a+-- directory will fail to dereference and vice versa.  Moreover, creating+-- symbolic links on Windows may require privileges unavailable to users+-- outside the Administrators group.  Portable programs that use symbolic+-- links should take both into consideration.+--+-- On Windows, the function is implemented using @CreateSymbolicLink@ with+-- @SYMBOLIC_LINK_FLAG_DIRECTORY@.  Since 1.3.3.0, the+-- @SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE@ flag is also included if+-- supported by the operating system.   On POSIX, this is an alias for+-- 'createFileLink' and is therefore atomic.+--+-- Windows-specific errors: This operation may fail with 'permissionErrorType'+-- if the user lacks the privileges to create symbolic links.  It may also+-- fail with 'illegalOperationErrorType' if the file system does not support+-- symbolic links.+createDirectoryLink+  :: OsPath                           -- ^ path to the target directory+  -> OsPath                           -- ^ path of the link to be created+  -> IO ()+createDirectoryLink target link =+  (`ioeAddLocation` "createDirectoryLink") `modifyIOError` do+    createSymbolicLink True target link++-- | Remove an existing /directory/ symbolic link.+--+-- On Windows, this is an alias for 'removeDirectory'.  On POSIX systems, this+-- is an alias for 'removeFile'.+--+-- See also: 'removeFile', which can remove an existing /file/ symbolic link.+removeDirectoryLink :: OsPath -> IO ()+removeDirectoryLink path =+  (`ioeAddLocation` "removeDirectoryLink") `modifyIOError` do+    removePathInternal linkToDirectoryIsDirectory path++-- | Check whether an existing @path@ is a symbolic link.  If @path@ is a+-- regular file or directory, 'False' is returned.  If @path@ does not exist+-- or is otherwise inaccessible, an exception is thrown (see below).+--+-- On Windows, this checks for @FILE_ATTRIBUTE_REPARSE_POINT@.  In addition to+-- symbolic links, the function also returns true on junction points.  On+-- POSIX systems, this checks for @S_IFLNK@.+--+-- The operation may fail with:+--+-- * 'isDoesNotExistError' if the symbolic link does not exist; or+--+-- * 'isPermissionError' if the user is not permitted to read the symbolic+--   link.+pathIsSymbolicLink :: OsPath -> IO Bool+pathIsSymbolicLink path =+  ((`ioeAddLocation` "pathIsSymbolicLink") .+   (`ioeSetOsPath` path)) `modifyIOError` do+     fileTypeIsLink . fileTypeFromMetadata <$> getSymbolicLinkMetadata path++-- | Retrieve the target path of either a file or directory symbolic link.+-- The returned path may not be absolute, may not exist, and may not even be a+-- valid path.+--+-- On Windows systems, this calls @DeviceIoControl@ with+-- @FSCTL_GET_REPARSE_POINT@.  In addition to symbolic links, the function+-- also works on junction points.  On POSIX systems, this calls @readlink@.+--+-- Windows-specific errors: This operation may fail with+-- 'illegalOperationErrorType' if the file system does not support symbolic+-- links.+getSymbolicLinkTarget :: OsPath -> IO OsPath+getSymbolicLinkTarget path =+  (`ioeAddLocation` "getSymbolicLinkTarget") `modifyIOError` do+    readSymbolicLink path++-- | Obtain the time at which the file or directory was last accessed.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to read+--   the access time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Caveat for POSIX systems: This function returns a timestamp with sub-second+-- resolution only if this package is compiled against @unix-2.6.0.0@ or later+-- and the underlying filesystem supports them.+--+getAccessTime :: OsPath -> IO UTCTime+getAccessTime path =+  (`ioeAddLocation` "getAccessTime") `modifyIOError` do+    accessTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)++-- | Obtain the time at which the file or directory was last modified.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to read+--   the modification time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Caveat for POSIX systems: This function returns a timestamp with sub-second+-- resolution only if this package is compiled against @unix-2.6.0.0@ or later+-- and the underlying filesystem supports them.+--+getModificationTime :: OsPath -> IO UTCTime+getModificationTime path =+  (`ioeAddLocation` "getModificationTime") `modifyIOError` do+    modificationTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)++-- | Change the time at which the file or directory was last accessed.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to alter the+--   access time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Some caveats for POSIX systems:+--+-- * Not all systems support @utimensat@, in which case the function can only+--   emulate the behavior by reading the modification time and then setting+--   both the access and modification times together.  On systems where+--   @utimensat@ is supported, the access time is set atomically with+--   nanosecond precision.+--+-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function+--   would not be able to set timestamps with sub-second resolution.  In this+--   case, there would also be loss of precision in the modification time.+--+setAccessTime :: OsPath -> UTCTime -> IO ()+setAccessTime path atime =+  (`ioeAddLocation` "setAccessTime") `modifyIOError` do+    setFileTimes path (Just atime, Nothing)++-- | Change the time at which the file or directory was last modified.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to alter the+--   modification time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- * 'InvalidArgument' on FAT32 file system if the time is before+--   DOS Epoch (1 January 1980).+--+-- Some caveats for POSIX systems:+--+-- * Not all systems support @utimensat@, in which case the function can only+--   emulate the behavior by reading the access time and then setting both the+--   access and modification times together.  On systems where @utimensat@ is+--   supported, the modification time is set atomically with nanosecond+--   precision.+--+-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function+--   would not be able to set timestamps with sub-second resolution.  In this+--   case, there would also be loss of precision in the access time.+--+setModificationTime :: OsPath -> UTCTime -> IO ()+setModificationTime path mtime =+  (`ioeAddLocation` "setModificationTime") `modifyIOError` do+    setFileTimes path (Nothing, Just mtime)++setFileTimes :: OsPath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()+setFileTimes _ (Nothing, Nothing) = pure ()+setFileTimes path (atime, mtime) =+  ((`ioeAddLocation` "setFileTimes") .+   (`ioeSetOsPath` path)) `modifyIOError` do+    setTimes (emptyToCurDir path)+             (utcTimeToPOSIXSeconds <$> atime, utcTimeToPOSIXSeconds <$> mtime)++{- | Returns the current user's home directory.++The directory returned is expected to be writable by the current user,+but note that it isn't generally considered good practice to store+application-specific data here; use 'getXdgDirectory' or+'getAppUserDataDirectory' instead.++On Unix, 'getHomeDirectory' behaves as follows:++* Returns $HOME env variable if set (including to an empty string).+* Otherwise uses home directory returned by @getpwuid_r@ using the UID of the+  current process' user. This basically reads the @\/etc\/passwd@ file. An+  empty home directory field is considered valid.++On Windows, the system is queried for a suitable path; a typical path might be+@C:\/Users\//\<user\>/@.++The operation may fail with:++* @UnsupportedOperation@+The operating system has no notion of home directory.++* 'isDoesNotExistError'+The home directory for the current user does not exist, or+cannot be found.+-}+getHomeDirectory :: IO OsPath+getHomeDirectory =+  (`ioeAddLocation` "getHomeDirectory") `modifyIOError` do+    getHomeDirectoryInternal++-- | Obtain the paths to special directories for storing user-specific+--   application data, configuration, and cache files, conforming to the+--   <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html XDG Base Directory Specification>.+--   Compared with 'getAppUserDataDirectory', this function provides a more+--   fine-grained hierarchy as well as greater flexibility for the user.+--+--   On Windows, 'XdgData' and 'XdgConfig' usually map to the same directory+--   unless overridden.+--+--   Refer to the docs of 'XdgDirectory' for more details.+--+--   The second argument is usually the name of the application.  Since it+--   will be integrated into the path, it must consist of valid path+--   characters.  Note: if the second argument is an absolute path, it will+--   just return the second argument.+--+--   Note: The directory may not actually exist, in which case you would need+--   to create it with file mode @700@ (i.e. only accessible by the owner).+--+--   As of 1.3.5.0, the environment variable is ignored if set to a relative+--   path, per revised XDG Base Directory Specification.  See+--   <https://github.com/haskell/directory/issues/100 #100>.+getXdgDirectory :: XdgDirectory         -- ^ which special directory+                -> OsPath               -- ^ a relative path that is appended+                                        --   to the path; if empty, the base+                                        --   path is returned+                -> IO OsPath+getXdgDirectory xdgDir suffix =+  (`ioeAddLocation` "getXdgDirectory") `modifyIOError` do+    simplify . (</> suffix) <$> do+      env <- lookupEnvOs $ case xdgDir of+        XdgData   -> os "XDG_DATA_HOME"+        XdgConfig -> os "XDG_CONFIG_HOME"+        XdgCache  -> os "XDG_CACHE_HOME"+        XdgState  -> os "XDG_STATE_HOME"+      case env of+        Just path | isAbsolute path -> pure path+        _ -> getXdgDirectoryFallback getHomeDirectory xdgDir++-- | Similar to 'getXdgDirectory' but retrieves the entire list of XDG+-- directories.+--+-- On Windows, 'XdgDataDirs' and 'XdgConfigDirs' usually map to the same list+-- of directories unless overridden.+--+-- Refer to the docs of 'XdgDirectoryList' for more details.+getXdgDirectoryList :: XdgDirectoryList -- ^ which special directory list+                    -> IO [OsPath]+getXdgDirectoryList xdgDirs =+  (`ioeAddLocation` "getXdgDirectoryList") `modifyIOError` do+    env <- lookupEnvOs $ case xdgDirs of+      XdgDataDirs   -> os "XDG_DATA_DIRS"+      XdgConfigDirs -> os "XDG_CONFIG_DIRS"+    case env of+      Nothing    -> getXdgDirectoryListFallback xdgDirs+      Just paths -> pure (splitSearchPath paths)++-- | Obtain the path to a special directory for storing user-specific+--   application data (traditional Unix location).  Newer applications may+--   prefer the the XDG-conformant location provided by 'getXdgDirectory'+--   (<https://github.com/haskell/directory/issues/6#issuecomment-96521020 migration guide>).+--+--   The argument is usually the name of the application.  Since it will be+--   integrated into the path, it must consist of valid path characters.+--+--   * On Unix-like systems, the path is @~\/./\<app\>/@.+--   * On Windows, the path is @%APPDATA%\//\<app\>/@+--     (e.g. @C:\/Users\//\<user\>/\/AppData\/Roaming\//\<app\>/@)+--+--   Note: the directory may not actually exist, in which case you would need+--   to create it.  It is expected that the parent directory exists and is+--   writable.+--+--   The operation may fail with:+--+--   * @UnsupportedOperation@+--     The operating system has no notion of application-specific data+--     directory.+--+--   * 'isDoesNotExistError'+--     The home directory for the current user does not exist, or cannot be+--     found.+--+getAppUserDataDirectory :: OsPath     -- ^ a relative path that is appended+                                        --   to the path+                        -> IO OsPath+getAppUserDataDirectory appName = do+  (`ioeAddLocation` "getAppUserDataDirectory") `modifyIOError` do+    getAppUserDataDirectoryInternal appName++{- | Returns the current user's document directory.++The directory returned is expected to be writable by the current user,+but note that it isn't generally considered good practice to store+application-specific data here; use 'getXdgDirectory' or+'getAppUserDataDirectory' instead.++On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@+environment variable.  On Windows, the system is queried for a+suitable path; a typical path might be @C:\/Users\//\<user\>/\/Documents@.++The operation may fail with:++* @UnsupportedOperation@+The operating system has no notion of document directory.++* 'isDoesNotExistError'+The document directory for the current user does not exist, or+cannot be found.+-}+getUserDocumentsDirectory :: IO OsPath+getUserDocumentsDirectory = do+  (`ioeAddLocation` "getUserDocumentsDirectory") `modifyIOError` do+    getUserDocumentsDirectoryInternal++{- | Returns the current directory for temporary files.++On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@+environment variable or \"\/tmp\" if the variable isn\'t defined.+On Windows, the function checks for the existence of environment variables in+the following order and uses the first path found:++*+TMP environment variable.++*+TEMP environment variable.++*+USERPROFILE environment variable.++*+The Windows directory++The operation may fail with:++* @UnsupportedOperation@+The operating system has no notion of temporary directory.++The function doesn\'t verify whether the path exists.+-}+getTemporaryDirectory :: IO OsPath+getTemporaryDirectory = getTemporaryDirectoryInternal++-- | Get the contents of the @PATH@ environment variable.+getExecSearchPath :: IO [OsPath]+getExecSearchPath = getPath
changelog.md view
@@ -1,6 +1,104 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.11.0 (May 2026)++  * Cabal flag `os-string` was removed in favor of `impl(ghc >= 9.2)`.+    ([#176](https://github.com/haskell/directory/issues/176))+  * Enable close-on-exec flag when copying files and relax `file-io` version+    bounds to support 0.2.0. Note that close-on-exec when copying is only+    enabled on `file-io` 0.2.0 or later.+    ([#203](https://github.com/haskell/directory/issues/203))+  * Relax `time` version bounds to support 1.16.++## 1.3.10.1 (Jan 2026)++  * Make `findExecutable` return `Nothing` on absolute paths that aren't+    executable.+    ([#187](https://github.com/haskell/directory/issues/187))+  * Ensure `removePathForcibly` removes write-protected files on all+    platforms.+    ([#194](https://github.com/haskell/directory/issues/194))++## 1.3.10.0 (Dec 2025)++  * Add `getExecSearchPath` as replacement for+    `System.FilePath.getSearchPath`.+    ([#198](https://github.com/haskell/directory/pull/198))+  * The [extended-length prefix][extended-length prefix] (`\\?\`) is no longer+    implicitly prepended to Windows UNC paths to avoid triggering a Win32+    implementation bug. Clients using long UNC paths should find alternatives+    to [enable long paths][enable long paths].+    ([#206](https://github.com/haskell/directory/issues/206))++[extended-length prefix]: https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation#:~:text=%5C%5C%3F%5C+[enable long paths]: https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation#enable-long-paths-in-windows-10-version-1607-and-later++## 1.3.9.0 (Oct 2024)++  * Rely on `file-io` for file I/O.+  * Drop support for `base` older than 4.12.0.+  * Resolve TOCTOU issue with `removeDirectoryRecursive` and+    `removePathForcibly` on POSIX systems.+    (part of [#97](https://github.com/haskell/directory/issues/97))+  * `findExecutable ""` now returns `Nothing`, matching non-Windows systems+    ([#180](https://github.com/haskell/directory/issues/180))++## 1.3.8.5 (May 2024)++  * Fix regression that causes copying of nonexistent files to create empty+    files.+    ([#177](https://github.com/haskell/directory/issues/177))++## 1.3.8.4 (Apr 2024)++  * Relax `time` version bounds to support 1.14.+    ([#171](https://github.com/haskell/directory/issues/171))+  * Relax `base` version bounds to support 4.20.+    ([#173](https://github.com/haskell/directory/issues/173))+  * Relax `filepath` version bounds to support 1.4.300 when `os-string` is+    unavailable.+    ([#175](https://github.com/haskell/directory/issues/175))++## 1.3.8.3 (Jan 2024)++  * Relax `Win32` version bounds to support 2.14.0.0.+    ([#166](https://github.com/haskell/directory/issues/166))+  * Fix regression in `canonicalizePath` on Windows UNC paths.+    ([#170](https://github.com/haskell/directory/issues/170))++## 1.3.8.2 (Dec 2023)++  * Relax `base` version bounds to support 4.19.+    ([#157](https://github.com/haskell/directory/pull/157))+  * Support filepath >= 1.5.0.0 and os-string.+    ([#164](https://github.com/haskell/directory/issues/164))++## 1.3.8.1 (Feb 2023)++  * Use CApiFFI for utimensat.+    ([#145](https://github.com/haskell/directory/pull/145))+  * Relax `base` version bounds to support 4.18.+    ([#151](https://github.com/haskell/directory/pull/151))++## 1.3.8.0 (Sep 2022)++  * Drop support for `base` older than 4.11.0.+  * Drop support for `filepath` older than 1.4.100.+  * Drop support for `time` older than 1.8.0.+  * Drop support for `unix` older than 2.8.0.+  * Drop support for `Win32` older than 2.13.3.+  * Modules in `directory` are no longer considered+    [Safe](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/safe_haskell.html)+    because the `System.OsPath` dependency is no longer Safe.+  * A new module, `System.Directory.OsPath`, has been introduced to support+    AFPP (`OsPath` and `OsString`) with an analogous API. The old module,+    `System.Directory`, shall be in maintenance mode as new features will no+    longer be accepted there.+    ([#136](https://github.com/haskell/directory/pull/136))+  * `removePathForcibly` no longer changes permissions of files on non-Windows+    systems.  ([#135](https://github.com/haskell/directory/issues/135))+ ## 1.3.7.1 (Jul 2022)    * Relax `time` version bounds to support 1.12.
− directory.buildinfo 
@@ -1,1 +0,0 @@-install-includes: HsDirectoryConfig.h
directory.cabal view
@@ -1,6 +1,7 @@+cabal-version:  2.2 name:           directory-version:        1.3.7.1-license:        BSD3+version:        1.3.11.0+license:        BSD-3-Clause license-file:   LICENSE maintainer:     libraries@haskell.org bug-reports:    https://github.com/haskell/directory/issues@@ -10,8 +11,7 @@   directories in a portable way. category:       System build-type:     Configure-cabal-version:  >= 1.10-tested-with:    GHC>=7.4.1+tested-with:    GHC == 8.10.7 || == 9.0.2 || == 9.2.4 || == 9.4.3  extra-tmp-files:     autom4te.cache@@ -19,16 +19,16 @@     config.status     HsDirectoryConfig.h +extra-doc-files:+    README.md+    changelog.md+ extra-source-files:     HsDirectoryConfig.h.in-    README.md     System/Directory/Internal/*.h-    changelog.md     configure     configure.ac-    directory.buildinfo     tests/*.hs-    tests/util.inl  source-repository head     type:     git@@ -36,12 +36,11 @@  Library     default-language: Haskell2010-    other-extensions:-        CPP-        Trustworthy+    other-extensions: CApiFFI, CPP      exposed-modules:         System.Directory+        System.Directory.OsPath         System.Directory.Internal         System.Directory.Internal.Prelude     other-modules:@@ -54,19 +53,26 @@     include-dirs: .      build-depends:-        base     >= 4.5 && < 4.18,-        time     >= 1.4 && < 1.13,-        filepath >= 1.3 && < 1.5+        base     >= 4.13.0 && < 4.23,+        file-io  >= 0.1.4 && < 0.3,+        time     >= 1.8.0 && < 1.17,     if os(windows)-        build-depends: Win32 >= 2.2.2 && < 2.14+        build-depends: Win32 >= 2.14.1.0 && < 2.15     else-        build-depends: unix >= 2.5.1 && < 2.9+        build-depends: unix >= 2.8.0 && < 2.9 +    if impl(ghc >= 9.2)+      build-depends: filepath >= 1.5.0 && < 1.6,+                     os-string >= 2.0.0 && < 2.1,+    else+      build-depends: filepath >= 1.4.100 && < 1.5+     ghc-options: -Wall  test-suite test     default-language: Haskell2010-    other-extensions: BangPatterns, CPP, Safe+    other-extensions: BangPatterns, CPP+    default-extensions: OverloadedStrings     ghc-options:      -Wall     hs-source-dirs:   tests     main-is:          Main.hs@@ -91,6 +97,7 @@         DoesDirectoryExist001         DoesPathExist         FileTime+        FindExecutable         FindFile001         GetDirContents001         GetDirContents002@@ -107,7 +114,6 @@         RenameDirectory         RenameFile001         RenamePath-        Safe         Simplify         T8482         WithCurrentDirectory
tests/CanonicalizePath.hs view
@@ -1,9 +1,14 @@ {-# LANGUAGE CPP #-} module CanonicalizePath where-#include "util.inl"-import System.FilePath ((</>), dropFileName, dropTrailingPathSeparator,-                        normalise, takeFileName)+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath import TestUtils+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>), dropFileName, dropTrailingPathSeparator,+                      normalise, takeFileName)  main :: TestEnv -> IO () main _t = do@@ -11,10 +16,10 @@   dot2 <- canonicalizePath "."   dot3 <- canonicalizePath "./"   dot4 <- canonicalizePath "./."-  T(expectEq) () dot (dropTrailingPathSeparator dot)-  T(expectEq) () dot dot2-  T(expectEq) () dot dot3-  T(expectEq) () dot dot4+  T.expectEq _t () dot (dropTrailingPathSeparator dot)+  T.expectEq _t () dot dot2+  T.expectEq _t () dot dot3+  T.expectEq _t () dot dot4    writeFile "bar" ""   bar <- canonicalizePath "bar"@@ -24,13 +29,13 @@   bar5 <- canonicalizePath "./bar"   bar6 <- canonicalizePath "./bar/"   bar7 <- canonicalizePath "./bar/."-  T(expectEq) () bar (normalise (dot </> "bar"))-  T(expectEq) () bar bar2-  T(expectEq) () bar bar3-  T(expectEq) () bar bar4-  T(expectEq) () bar bar5-  T(expectEq) () bar bar6-  T(expectEq) () bar bar7+  T.expectEq _t () bar (normalise (dot </> "bar"))+  T.expectEq _t () bar bar2+  T.expectEq _t () bar bar3+  T.expectEq _t () bar bar4+  T.expectEq _t () bar bar5+  T.expectEq _t () bar bar6+  T.expectEq _t () bar bar7    createDirectory "foo"   foo <- canonicalizePath "foo"@@ -39,12 +44,12 @@   foo4 <- canonicalizePath "foo/./"   foo5 <- canonicalizePath "./foo"   foo6 <- canonicalizePath "./foo/"-  T(expectEq) () foo (normalise (dot </> "foo"))-  T(expectEq) () foo foo2-  T(expectEq) () foo foo3-  T(expectEq) () foo foo4-  T(expectEq) () foo foo5-  T(expectEq) () foo foo6+  T.expectEq _t () foo (normalise (dot </> "foo"))+  T.expectEq _t () foo foo2+  T.expectEq _t () foo foo3+  T.expectEq _t () foo foo4+  T.expectEq _t () foo foo5+  T.expectEq _t () foo foo6    -- should not fail for non-existent paths   fooNon <- canonicalizePath "foo/non-existent"@@ -55,19 +60,19 @@   fooNon6 <- canonicalizePath "./foo/non-existent/"   fooNon7 <- canonicalizePath "./foo/./non-existent"   fooNon8 <- canonicalizePath "./foo/./non-existent/"-  T(expectEq) () fooNon (normalise (foo </> "non-existent"))-  T(expectEq) () fooNon fooNon2-  T(expectEq) () fooNon fooNon3-  T(expectEq) () fooNon fooNon4-  T(expectEq) () fooNon fooNon5-  T(expectEq) () fooNon fooNon6-  T(expectEq) () fooNon fooNon7-  T(expectEq) () fooNon fooNon8+  T.expectEq _t () fooNon (normalise (foo </> "non-existent"))+  T.expectEq _t () fooNon fooNon2+  T.expectEq _t () fooNon fooNon3+  T.expectEq _t () fooNon fooNon4+  T.expectEq _t () fooNon fooNon5+  T.expectEq _t () fooNon fooNon6+  T.expectEq _t () fooNon fooNon7+  T.expectEq _t () fooNon fooNon8    -- make sure ".." gets expanded properly by 'toExtendedLengthPath'   -- (turns out this test won't detect the problem because GetFullPathName   -- would expand them for us if we don't, but leaving it here anyway)-  T(expectEq) () foo =<< canonicalizePath (foo </> ".." </> "foo")+  T.expectEq _t () foo =<< canonicalizePath (foo </> ".." </> "foo")    supportsSymbolicLinks <- supportsSymlinks   when supportsSymbolicLinks $ do@@ -77,40 +82,40 @@     -- note: this also checks that "../bar" gets normalized to "..\\bar"     --       since Windows does not like "/" in symbolic links targets     createFileLink "../bar" "foo/bar"-    T(expectEq) () bar =<< canonicalizePath "foo/bar"-    T(expectEq) () barQux =<< canonicalizePath "foo/bar/qux"+    T.expectEq _t () bar =<< canonicalizePath "foo/bar"+    T.expectEq _t () barQux =<< canonicalizePath "foo/bar/qux"      createDirectoryLink "foo" "lfoo"-    T(expectEq) () foo =<< canonicalizePath "lfoo"-    T(expectEq) () foo =<< canonicalizePath "lfoo/"-    T(expectEq) () bar =<< canonicalizePath "lfoo/bar"-    T(expectEq) () barQux =<< canonicalizePath "lfoo/bar/qux"+    T.expectEq _t () foo =<< canonicalizePath "lfoo"+    T.expectEq _t () foo =<< canonicalizePath "lfoo/"+    T.expectEq _t () bar =<< canonicalizePath "lfoo/bar"+    T.expectEq _t () barQux =<< canonicalizePath "lfoo/bar/qux"      -- create a haphazard chain of links     createDirectoryLink "./../foo/../foo/." "./foo/./somelink3"     createDirectoryLink ".././foo/somelink3" "foo/somelink2"     createDirectoryLink "./foo/somelink2" "somelink"-    T(expectEq) () foo =<< canonicalizePath "somelink"+    T.expectEq _t () foo =<< canonicalizePath "somelink"      -- regression test for #64     createFileLink "../foo/non-existent" "foo/qux"     removeDirectoryLink "foo/somelink3" -- break the chain made earlier     qux <- canonicalizePath "foo/qux"-    T(expectEq) () qux =<< canonicalizePath "foo/non-existent"-    T(expectEq) () (foo </> "somelink3") =<< canonicalizePath "somelink"+    T.expectEq _t () qux =<< canonicalizePath "foo/non-existent"+    T.expectEq _t () (foo </> "somelink3") =<< canonicalizePath "somelink"      -- make sure it can handle loops     createFileLink "loop1" "loop2"     createFileLink "loop2" "loop1"     loop1 <- canonicalizePath "loop1"     loop2 <- canonicalizePath "loop2"-    T(expectEq) () loop1 (normalise (dot </> "loop1"))-    T(expectEq) () loop2 (normalise (dot </> "loop2"))+    T.expectEq _t () loop1 (normalise (dot </> "loop1"))+    T.expectEq _t () loop2 (normalise (dot </> "loop2"))      -- make sure ".." gets expanded properly by 'toExtendedLengthPath'     createDirectoryLink (foo </> ".." </> "foo") "foolink"     _ <- listDirectory "foolink" -- make sure directory is accessible-    T(expectEq) () foo =<< canonicalizePath "foolink"+    T.expectEq _t () foo =<< canonicalizePath "foolink"    caseInsensitive <-     (False <$ createDirectory "FOO")@@ -123,8 +128,8 @@   when caseInsensitive $ do     foo7 <- canonicalizePath "FOO"     foo8 <- canonicalizePath "FOO/"-    T(expectEq) () foo foo7-    T(expectEq) () foo foo8+    T.expectEq _t () foo foo7+    T.expectEq _t () foo foo8      fooNon9 <- canonicalizePath "FOO/non-existent"     fooNon10 <- canonicalizePath "fOo/non-existent/"@@ -134,28 +139,35 @@     fooNon14 <- canonicalizePath "./FOo/non-existent/"     cfooNon15 <- canonicalizePath "./FOO/./NON-EXISTENT"     cfooNon16 <- canonicalizePath "./FOO/./NON-EXISTENT/"-    T(expectEq) () fooNon fooNon9-    T(expectEq) () fooNon fooNon10-    T(expectEq) () fooNon fooNon11-    T(expectEq) () fooNon fooNon12-    T(expectEq) () fooNon fooNon13-    T(expectEq) () fooNon fooNon14-    T(expectEq) () fooNon (dropFileName cfooNon15 <>-                           (toLower <$> takeFileName cfooNon15))-    T(expectEq) () fooNon (dropFileName cfooNon16 <>-                           (toLower <$> takeFileName cfooNon16))-    T(expectNe) () fooNon cfooNon15-    T(expectNe) () fooNon cfooNon16+    T.expectEq _t () fooNon fooNon9+    T.expectEq _t () fooNon fooNon10+    T.expectEq _t () fooNon fooNon11+    T.expectEq _t () fooNon fooNon12+    T.expectEq _t () fooNon fooNon13+    T.expectEq _t () fooNon fooNon14+    T.expectEq _t () fooNon+      (dropFileName cfooNon15 <> os (toLower <$> so (takeFileName cfooNon15)))+    T.expectEq _t () fooNon+      (dropFileName cfooNon16 <> os (toLower <$> so (takeFileName cfooNon16)))+    T.expectNe _t () fooNon cfooNon15+    T.expectNe _t () fooNon cfooNon16      setCurrentDirectory "foo"     foo9 <- canonicalizePath "../FOO"     foo10 <- canonicalizePath "../FOO/"-    T(expectEq) () foo foo9-    T(expectEq) () foo foo10+    T.expectEq _t () foo foo9+    T.expectEq _t () foo foo10 -    -- Make sure long file names can be canonicalized too-    -- (i.e. GetLongPathName by itself won't work)-    createDirectory "verylongdirectoryname"-    vldn <- canonicalizePath "verylongdirectoryname"-    vldn2 <- canonicalizePath "VERYLONGDIRECTORYNAME"-    T(expectEq) () vldn vldn2+  let isWindows =+#if defined(mingw32_HOST_OS)+        True+#else+        False+#endif++  when isWindows $ do+    -- https://github.com/haskell/directory/issues/170+    T.expectEq _t () "\\\\localhost" =<< canonicalizePath "\\\\localhost"+    -- https://github.com/haskell/directory/issues/206+    T.expectEq _t () "\\\\localhost\\C$" =<<+      canonicalizePath "\\\\localhost\\C$\\.."
tests/CopyFile001.hs view
@@ -1,17 +1,29 @@-{-# LANGUAGE CPP #-} module CopyFile001 where-#include "util.inl"-import System.FilePath ((</>))+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>)) import qualified Data.List as List  main :: TestEnv -> IO () main _t = do   createDirectory dir-  writeFile (dir </> from) contents-  T(expectEq) () [from] . List.sort =<< listDirectory dir+  writeFile (so (dir </> from)) contents+  T.expectEq _t () [from] . List.sort =<< listDirectory dir   copyFile (dir </> from) (dir </> to)-  T(expectEq) () [from, to] . List.sort =<< listDirectory dir-  T(expectEq) () contents =<< readFile (dir </> to)+  T.expectEq _t () [from, to] . List.sort =<< listDirectory dir+  T.expectEq _t () contents =<< readFile (so (dir </> to))++  -- Regression test for https://github.com/haskell/directory/issues/177+  createDirectory "issue177"+  T.expectIOErrorType _t () isDoesNotExistError+    (copyFile "issue177/nonexistentSrc" "issue177/dst")+  T.expectEq _t () [] =<< listDirectory "issue177"+   where     contents = "This is the data\n"     from     = "source"
tests/CopyFile002.hs view
@@ -1,17 +1,22 @@-{-# LANGUAGE CPP #-} module CopyFile002 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import qualified Data.List as List  main :: TestEnv -> IO () main _t = do   -- Similar to CopyFile001 but moves a file in the current directory   -- (Bug #1652 on GHC Trac)-  writeFile from contents-  T(expectEq) () [from] . List.sort =<< listDirectory "."+  writeFile (so from) contents+  T.expectEq _t () [from] . List.sort =<< listDirectory "."   copyFile from to-  T(expectEq) () [from, to] . List.sort =<< listDirectory "."-  T(expectEq) () contents =<< readFile to+  T.expectEq _t () [from, to] . List.sort =<< listDirectory "."+  T.expectEq _t () contents =<< readFile (so to)   where     contents = "This is the data\n"     from     = "source"
tests/CopyFileWithMetadata.hs view
@@ -1,6 +1,11 @@-{-# LANGUAGE CPP #-} module CopyFileWithMetadata where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import qualified Data.List as List  main :: TestEnv -> IO ()@@ -14,18 +19,18 @@   perm <- getPermissions "a"    -- sanity check-  T(expectEq) () ["a", "b"] . List.sort =<< listDirectory "."+  T.expectEq _t () ["a", "b"] . List.sort =<< listDirectory "."    -- copy file   copyFileWithMetadata "a" "b"   copyFileWithMetadata "a" "c"    -- make sure we got the right results-  T(expectEq) () ["a", "b", "c"] . List.sort =<< listDirectory "."+  T.expectEq _t () ["a", "b", "c"] . List.sort =<< listDirectory "."   for_ ["b", "c"] $ \ f -> do-    T(expectEq) f perm =<< getPermissions f-    T(expectEq) f mtime =<< getModificationTime f-    T(expectEq) f contents =<< readFile f+    T.expectEq _t f perm =<< getPermissions f+    T.expectEq _t f mtime =<< getModificationTime f+    T.expectEq _t f contents =<< readFile (so f)    where     contents = "This is the data\n"@@ -33,9 +38,9 @@      cleanup = do       -- needed to ensure the test runner can clean up our mess-      modifyWritable True "a" `catchIOError` \ _ -> return ()-      modifyWritable True "b" `catchIOError` \ _ -> return ()-      modifyWritable True "c" `catchIOError` \ _ -> return ()+      modifyWritable True "a" `catchIOError` \ _ -> pure ()+      modifyWritable True "b" `catchIOError` \ _ -> pure ()+      modifyWritable True "c" `catchIOError` \ _ -> pure ()      modifyWritable b f = do       perm <- getPermissions f
tests/CreateDirectory001.hs view
@@ -1,9 +1,13 @@-{-# LANGUAGE CPP #-} module CreateDirectory001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do   createDirectory testdir-  T(expectIOErrorType) () isAlreadyExistsError (createDirectory testdir)+  T.expectIOErrorType _t () isAlreadyExistsError (createDirectory testdir)   where testdir = "dir"
tests/CreateDirectoryIfMissing001.hs view
@@ -1,8 +1,14 @@ {-# LANGUAGE CPP #-} module CreateDirectoryIfMissing001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import Data.Either (lefts)-import System.FilePath ((</>), addTrailingPathSeparator)+import System.OsPath ((</>), addTrailingPathSeparator)  main :: TestEnv -> IO () main _t = do@@ -10,7 +16,7 @@   createDirectoryIfMissing False testdir   cleanup -  T(expectIOErrorType) () isDoesNotExistError $+  T.expectIOErrorType _t () isDoesNotExistError $     createDirectoryIfMissing False testdir_a    createDirectoryIfMissing True  testdir_a@@ -20,21 +26,21 @@    createDirectoryIfMissing True  (addTrailingPathSeparator testdir_a) -  T(inform) "testing for race conditions ..."+  T.inform _t "testing for race conditions ..."   raceCheck1-  T(inform) "testing for race conditions ..."+  T.inform _t "testing for race conditions ..."   raceCheck2-  T(inform) "done."+  T.inform _t "done."   cleanup -  writeFile testdir testdir-  T(expectIOErrorType) () isAlreadyExistsError $+  writeFile (so testdir) (so testdir)+  T.expectIOErrorType _t () isAlreadyExistsError $     createDirectoryIfMissing False testdir   removeFile testdir   cleanup -  writeFile testdir testdir-  T(expectIOErrorType) () isNotADirectoryError $+  writeFile (so testdir) (so testdir)+  T.expectIOErrorType _t () isNotADirectoryError $     createDirectoryIfMissing True testdir_a   removeFile testdir   cleanup@@ -43,10 +49,10 @@      testname = "CreateDirectoryIfMissing001" -    testdir = testname <> ".d"+    testdir = os (testname <> ".d")     testdir_a = testdir </> "a" -    numRepeats = T.readArg _t testname "num-repeats" 10000+    numRepeats = T.readArg _t testname "num-repeats" 10     numThreads = T.readArg _t testname "num-threads" 4      forkPut mvar action = () <$ forkFinally action (putMVar mvar)@@ -60,18 +66,18 @@       forkPut m $ do         replicateM_ numRepeats cleanup       results <- replicateM 2 (takeMVar m)-      T(expectEq) () [] (show <$> lefts results)+      T.expectEq _t () [] (show <$> lefts results)      -- This test fails on Windows (see bug #2924 on GHC Trac):     raceCheck2 = do       m <- newEmptyMVar-      replicateM_ numThreads $+      replicateM_ numThreads $ do         forkPut m $ do           replicateM_ numRepeats $ do             create             cleanup       results <- replicateM numThreads (takeMVar m)-      T(expectEq) () [] (show <$> lefts results)+      T.expectEq _t () [] (show <$> lefts results)      -- createDirectoryIfMissing is allowed to fail with isDoesNotExistError if     -- another process/thread removes one of the directories during the process@@ -85,10 +91,10 @@          || isPermissionError e          || isInappropriateTypeError e          || ioeGetErrorType e == InvalidArgument-      then return ()+      then pure ()       else ioError e -    cleanup = removeDirectoryRecursive testdir `catchAny` \ _ -> return ()+    cleanup = removeDirectoryRecursive testdir `catchAny` \ _ -> pure ()      catchAny :: IO a -> (SomeException -> IO a) -> IO a     catchAny = catch
tests/CurrentDirectory001.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE CPP #-} module CurrentDirectory001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import qualified Data.List as List  main :: TestEnv -> IO ()@@ -8,6 +12,6 @@   prevDir <- getCurrentDirectory   createDirectory "dir"   setCurrentDirectory "dir"-  T(expectEq) () [".", ".."] . List.sort =<< getDirectoryContents "."+  T.expectEq _t () [".", ".."] . List.sort =<< getDirectoryContents "."   setCurrentDirectory prevDir   removeDirectory "dir"
tests/Directory001.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE CPP #-} module Directory001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do@@ -10,7 +14,7 @@   renameFile "foo/bar" "foo/baz"   renameDirectory "foo" "bar"   str' <- readFile "bar/baz"-  T(expectEq) () str' str+  T.expectEq _t () str' str   removeFile "bar/baz"   removeDirectory "bar"
tests/DoesDirectoryExist001.hs view
@@ -1,21 +1,26 @@ {-# LANGUAGE CPP #-} module DoesDirectoryExist001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do    -- [regression test] "/" was not recognised as a directory prior to GHC 6.1-  T(expect) () =<< doesDirectoryExist rootDir+  T.expect _t () =<< doesDirectoryExist rootDir    createDirectory "somedir" -  T(expect) () . not =<< doesDirectoryExist ""-  T(expect) () . not =<< doesDirectoryExist "nonexistent"-  T(expect) () =<< doesDirectoryExist "."-  T(expect) () =<< doesDirectoryExist "somedir"+  T.expect _t () . not =<< doesDirectoryExist ""+  T.expect _t () . not =<< doesDirectoryExist "nonexistent"+  T.expect _t () =<< doesDirectoryExist "."+  T.expect _t () =<< doesDirectoryExist "somedir" #if defined(mingw32_HOST_OS)-  T(expect) () =<< doesDirectoryExist "SoMeDiR"+  T.expect _t () =<< doesDirectoryExist "SoMeDiR" #endif    where
tests/DoesPathExist.hs view
@@ -1,27 +1,46 @@ {-# LANGUAGE CPP #-} module DoesPathExist where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils (supportsSymlinks)+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do -  T(expect) () =<< doesPathExist rootDir+  T.expect _t () =<< doesPathExist rootDir    createDirectory "somedir"   writeFile "somefile" "somedata"   writeFile "\x3c0\x42f\x97f3\xe6\x221e" "somedata" -  T(expect) () . not =<< doesPathExist ""-  T(expect) () . not =<< doesPathExist "nonexistent"-  T(expect) () =<< doesPathExist "."-  T(expect) () =<< doesPathExist "somedir"-  T(expect) () =<< doesPathExist "somefile"-  T(expect) () =<< doesPathExist "./somefile"+  T.expect _t () . not =<< doesPathExist ""+  T.expect _t () . not =<< doesPathExist "nonexistent"+  T.expect _t () =<< doesPathExist "."+  T.expect _t () =<< doesPathExist "somedir"+  T.expect _t () =<< doesPathExist "somefile"+  T.expect _t () =<< doesPathExist "./somefile" #if defined(mingw32_HOST_OS)-  T(expect) () =<< doesPathExist "SoMeDiR"-  T(expect) () =<< doesPathExist "sOmEfIlE"+  T.expect _t () =<< doesPathExist "SoMeDiR"+  T.expect _t () =<< doesPathExist "sOmEfIlE" #endif-  T(expect) () =<< doesPathExist "\x3c0\x42f\x97f3\xe6\x221e"+  T.expect _t () =<< doesPathExist "\x3c0\x42f\x97f3\xe6\x221e"++  supportsSymbolicLinks <- supportsSymlinks+  when supportsSymbolicLinks $ do++    createDirectoryLink "somedir" "somedirlink"+    createFileLink "somefile" "somefilelink"+    createFileLink "nonexistent" "nonexistentlink"++    T.expect _t () =<< doesFileExist "somefilelink"+    T.expect _t () . not =<< doesDirectoryExist "somefilelink"+    T.expect _t () =<< doesDirectoryExist "somedirlink"+    T.expect _t () . not =<< doesFileExist "somedirlink"+    T.expect _t () . not =<< doesDirectoryExist "nonexistentlink"+    T.expect _t () . not =<< doesFileExist "nonexistentlink"    where #if defined(mingw32_HOST_OS)
tests/FileTime.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE CPP #-} module FileTime where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import Data.Time.Clock (addUTCTime, getCurrentTime)  main :: TestEnv -> IO ()@@ -9,13 +13,13 @@   let someTimeAgo  = addUTCTime (-3600) now       someTimeAgo' = addUTCTime (-7200) now -  T(expectIOErrorType) () isDoesNotExistError $+  T.expectIOErrorType _t () isDoesNotExistError $     getAccessTime "nonexistent-file"-  T(expectIOErrorType) () isDoesNotExistError $+  T.expectIOErrorType _t () isDoesNotExistError $     setAccessTime "nonexistent-file" someTimeAgo-  T(expectIOErrorType) () isDoesNotExistError $+  T.expectIOErrorType _t () isDoesNotExistError $     getModificationTime "nonexistent-file"-  T(expectIOErrorType) () isDoesNotExistError $+  T.expectIOErrorType _t () isDoesNotExistError $     setModificationTime "nonexistent-file" someTimeAgo    writeFile  "foo" ""@@ -31,11 +35,11 @@     mtime2 <- getModificationTime file      -- modification time should be set with at worst 1 sec resolution-    T(expectNearTime) file mtime  mtime2 1+    T.expectNearTime _t file mtime  mtime2 1      -- access time should not change, although it may lose some precision     -- on POSIX systems without 'utimensat'-    T(expectNearTime) file atime1 atime2 1+    T.expectNearTime _t file atime1 atime2 1      setAccessTime file atime @@ -44,11 +48,11 @@      when setAtime $ do       -- access time should be set with at worst 1 sec resolution-      T(expectNearTime) file atime atime3 1+      T.expectNearTime _t file atime atime3 1      -- modification time should not change, although it may lose some precision     -- on POSIX systems without 'utimensat'-    T(expectNearTime) file mtime2 mtime3 1+    T.expectNearTime _t file mtime2 mtime3 1    where
+ tests/FindExecutable.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}+module FindExecutable where+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T++main :: TestEnv -> IO ()+main _t = do++  -- 'find' expected to exist on both Windows and POSIX,+  -- though we have no idea if it's writable+  Just _ <- findExecutable "find"++  T.expectEq _t () Nothing =<<+    findExecutable "__nonexistent_binary_gbowyxcejjawf7r6__"++  -- https://github.com/haskell/directory/issues/187+  T.expectEq _t () Nothing =<< findExecutable "/"+  T.expectEq _t () Nothing =<< findExecutable "//"+#if !defined(mingw32_HOST_OS)+  T.expectEq _t () Nothing =<< findExecutable "\\"+  T.expectEq _t () Nothing =<< findExecutable "\\\\"+  T.expectEq _t () Nothing =<< findExecutable "\\\\localhost\\c$"+#endif
tests/FindFile001.hs view
@@ -1,8 +1,13 @@-{-# LANGUAGE CPP #-} module FindFile001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import qualified Data.List as List-import System.FilePath ((</>))+import System.OsPath ((</>))  main :: TestEnv -> IO () main _t = do@@ -10,42 +15,44 @@   createDirectory "bar"   createDirectory "qux"   writeFile "foo" ""-  writeFile ("bar" </> "foo") ""-  writeFile ("qux" </> "foo") ":3"+  writeFile (so ("bar" </> "foo")) ""+  writeFile (so ("qux" </> "foo")) ":3"    -- make sure findFile is lazy enough-  T(expectEq) () (Just ("." </> "foo")) =<< findFile ("." : undefined) "foo"+  T.expectEq _t () (Just ("." </> "foo")) =<< findFile ("." : undefined) "foo"    -- make sure relative paths work-  T(expectEq) () (Just ("." </> "bar" </> "foo")) =<<+  T.expectEq _t () (Just ("." </> "bar" </> "foo")) =<<     findFile ["."] ("bar" </> "foo") -  T(expectEq) () (Just ("." </> "foo")) =<< findFile [".", "bar"] ("foo")-  T(expectEq) () (Just ("bar" </> "foo")) =<< findFile ["bar", "."] ("foo")+  T.expectEq _t () (Just ("." </> "foo")) =<< findFile [".", "bar"] "foo"+  T.expectEq _t () (Just ("bar" </> "foo")) =<< findFile ["bar", "."] "foo" -  let f fn = (== ":3") <$> readFile fn+  let f fn = (== ":3") <$> readFile (so fn)   for_ (List.permutations ["qux", "bar", "."]) $ \ ds -> do      let (match, noMatch) = List.partition (== "qux") ds+    match0 : _ <- pure match+    noMatch0 : _ <- pure noMatch -    T(expectEq) ds (Just (List.head match </> "foo")) =<<+    T.expectEq _t ds (Just (match0 </> "foo")) =<<       findFileWith f ds "foo" -    T(expectEq) ds ((</> "foo") <$> match) =<< findFilesWith f ds "foo"+    T.expectEq _t ds ((</> "foo") <$> match) =<< findFilesWith f ds "foo" -    T(expectEq) ds (Just (List.head noMatch </> "foo")) =<<+    T.expectEq _t ds (Just (noMatch0 </> "foo")) =<<       findFileWith ((not <$>) . f) ds "foo" -    T(expectEq) ds ((</> "foo") <$> noMatch) =<<+    T.expectEq _t ds ((</> "foo") <$> noMatch) =<<       findFilesWith ((not <$>) . f) ds "foo" -    T(expectEq) ds Nothing =<< findFileWith (\ _ -> return False) ds "foo"+    T.expectEq _t ds Nothing =<< findFileWith (\ _ -> pure False) ds "foo" -    T(expectEq) ds [] =<< findFilesWith (\ _ -> return False) ds "foo"+    T.expectEq _t ds [] =<< findFilesWith (\ _ -> pure False) ds "foo"    -- make sure absolute paths are handled properly irrespective of 'dirs'   -- https://github.com/haskell/directory/issues/72   absPath <- makeAbsolute ("bar" </> "foo")   absPath2 <- makeAbsolute ("bar" </> "nonexistent")-  T(expectEq) () (Just absPath) =<< findFile [] absPath-  T(expectEq) () Nothing =<< findFile [] absPath2+  T.expectEq _t () (Just absPath) =<< findFile [] absPath+  T.expectEq _t () Nothing =<< findFile [] absPath2
tests/GetDirContents001.hs view
@@ -1,23 +1,28 @@-{-# LANGUAGE CPP #-} module GetDirContents001 where-#include "util.inl"-import System.FilePath ((</>))+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>)) import qualified Data.List as List  main :: TestEnv -> IO () main _t = do   createDirectory dir-  T(expectEq) () specials . List.sort =<<+  T.expectEq _t () specials . List.sort =<<     getDirectoryContents dir-  T(expectEq) () [] . List.sort =<<+  T.expectEq _t () [] . List.sort =<<     listDirectory dir   names <- for [1 .. 100 :: Int] $ \ i -> do-    let name = 'f' : show i-    writeFile (dir </> name) ""-    return name-  T(expectEq) () (List.sort (specials <> names)) . List.sort =<<+    let name = "f" <> os (show i)+    writeFile (so (dir </> name)) ""+    pure name+  T.expectEq _t () (List.sort (specials <> names)) . List.sort =<<     getDirectoryContents dir-  T(expectEq) () (List.sort names) . List.sort =<<+  T.expectEq _t () (List.sort names) . List.sort =<<     listDirectory dir   where dir      = "dir"         specials = [".", ".."]
tests/GetDirContents002.hs view
@@ -1,8 +1,12 @@-{-# LANGUAGE CPP #-} module GetDirContents002 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do-  T(expectIOErrorType) () isDoesNotExistError $+  T.expectIOErrorType _t () isDoesNotExistError $     getDirectoryContents "nonexistent"
tests/GetFileSize.hs view
@@ -1,17 +1,19 @@-{-# LANGUAGE CPP #-} module GetFileSize where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do -  withBinaryFile "emptyfile" WriteMode $ \ _ -> do-    return ()-  withBinaryFile "testfile" WriteMode $ \ h -> do-    hPutStr h string+  writeFile "emptyfile" ""+  writeFile "testfile" string -  T(expectEq) () 0 =<< getFileSize "emptyfile"-  T(expectEq) () (fromIntegral (length string)) =<< getFileSize "testfile"+  T.expectEq _t () 0 =<< getFileSize "emptyfile"+  T.expectEq _t () (fromIntegral (length string)) =<< getFileSize "testfile"    where     string = "The quick brown fox jumps over the lazy dog."
tests/GetHomeDirectory001.hs view
@@ -1,16 +1,20 @@-{-# LANGUAGE CPP #-} module GetHomeDirectory001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do   homeDir <- getHomeDirectory-  T(expect) () (homeDir /= "") -- sanity check+  T.expect _t () (homeDir /= mempty) -- sanity check   _ <- getAppUserDataDirectory   "test"   _ <- getXdgDirectory XdgCache  "test"   _ <- getXdgDirectory XdgConfig "test"   _ <- getXdgDirectory XdgData   "test"-  _ <- getXdgDirectory XdgCache  "test"+  _ <- getXdgDirectory XdgState  "test"   _ <- getUserDocumentsDirectory   _ <- getTemporaryDirectory-  return ()+  pure ()
tests/GetHomeDirectory002.hs view
@@ -4,7 +4,12 @@ #if !defined(mingw32_HOST_OS) import System.Posix.Env #endif-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  -- Test that the getpwuid_r fallback works. -- This is only relevant on unix.@@ -14,4 +19,4 @@   unsetEnv "HOME" #endif   _ <- getHomeDirectory-  T(expect) () True -- avoid warnings about redundant imports+  T.expect _t () True -- avoid warnings about redundant imports
tests/GetPermissions001.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE CPP #-} module GetPermissions001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath import TestUtils+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do@@ -15,15 +18,15 @@   writeFile "foo.txt" ""   foo <- makeAbsolute "foo.txt"   modifyPermissions "foo.txt" (\ p -> p { writable = False })-  T(expect) () =<< not . writable <$> getPermissions "foo.txt"+  T.expect _t () =<< not . writable <$> getPermissions "foo.txt"   modifyPermissions "foo.txt" (\ p -> p { writable = True })-  T(expect) () =<< writable <$> getPermissions "foo.txt"+  T.expect _t () =<< writable <$> getPermissions "foo.txt"   modifyPermissions "foo.txt" (\ p -> p { writable = False })-  T(expect) () =<< not . writable <$> getPermissions "foo.txt"+  T.expect _t () =<< not . writable <$> getPermissions "foo.txt"   modifyPermissions foo (\ p -> p { writable = True })-  T(expect) () =<< writable <$> getPermissions foo+  T.expect _t () =<< writable <$> getPermissions foo   modifyPermissions foo (\ p -> p { writable = False })-  T(expect) () =<< not . writable <$> getPermissions foo+  T.expect _t () =<< not . writable <$> getPermissions foo    -- test empty path   modifyPermissions "" id@@ -34,31 +37,31 @@       -- since the current directory is created by the test runner,       -- it should be readable, writable, and searchable       p <- getPermissions "."-      T(expect) () (readable p)-      T(expect) () (writable p)-      T(expect) () (not (executable p))-      T(expect) () (searchable p)+      T.expect _t () (readable p)+      T.expect _t () (writable p)+      T.expect _t () (not (executable p))+      T.expect _t () (searchable p)      checkExecutable = do       -- 'find' expected to exist on both Windows and POSIX,       -- though we have no idea if it's writable       Just f <- findExecutable "find"       p <- getPermissions f-      T(expect) () (readable p)-      T(expect) () (executable p)-      T(expect) () (not (searchable p))+      T.expect _t () (readable p)+      T.expect _t () (executable p)+      T.expect _t () (not (searchable p))      checkOrdinary = do       writeFile "foo" ""       p <- getPermissions "foo"-      T(expect) () (readable p)-      T(expect) () (writable p)-      T(expect) () (not (executable p))-      T(expect) () (not (searchable p))+      T.expect _t () (readable p)+      T.expect _t () (writable p)+      T.expect _t () (not (executable p))+      T.expect _t () (not (searchable p))      -- [regression test] (issue #9)     -- Windows doesn't like trailing path separators     checkTrailingSlash = do       createDirectory "bar"       _ <- getPermissions "bar/"-      return ()+      pure ()
tests/LongPaths.hs view
@@ -1,8 +1,11 @@-{-# LANGUAGE CPP #-} module LongPaths where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath import TestUtils-import System.FilePath ((</>))+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>))  main :: TestEnv -> IO () main _t = do@@ -14,9 +17,9 @@       -- tests: [createDirectory]       createDirectory =<< makeAbsolute longName       createDirectory longDir-      return True+      pure True     `catchIOError` \ _ ->-      return False+      pure False    -- skip tests on file systems that do not support long paths   when supportsLongPaths $ do@@ -24,10 +27,10 @@     -- test relative paths     let relDir = longName </> mconcat (replicate 8 "yeah_its_long")     createDirectory relDir-    T(expect) () =<< doesDirectoryExist relDir-    T(expectEq) () [] =<< listDirectory relDir+    T.expect _t () =<< doesDirectoryExist relDir+    T.expectEq _t () [] =<< listDirectory relDir     setPermissions relDir emptyPermissions-    T(expectEq) () False =<< writable <$> getPermissions relDir+    T.expectEq _t () False =<< writable <$> getPermissions relDir      writeFile "foobar.txt" "^.^" -- writeFile does not support long paths yet @@ -38,13 +41,13 @@                          (longDir </> "foobar_copy.txt")      -- tests: [doesDirectoryExist], [doesFileExist], [doesPathExist]-    T(expect) () =<< doesDirectoryExist longDir-    T(expect) () =<< doesFileExist (longDir </> "foobar.txt")-    T(expect) () =<< doesPathExist longDir-    T(expect) () =<< doesPathExist (longDir </> "foobar.txt")+    T.expect _t () =<< doesDirectoryExist longDir+    T.expect _t () =<< doesFileExist (longDir </> "foobar.txt")+    T.expect _t () =<< doesPathExist longDir+    T.expect _t () =<< doesPathExist (longDir </> "foobar.txt")      -- tests: [getFileSize], [getModificationTime]-    T(expectEq) () 3 =<< getFileSize (longDir </> "foobar.txt")+    T.expectEq _t () 3 =<< getFileSize (longDir </> "foobar.txt")     _ <- getModificationTime (longDir </> "foobar.txt")      supportsSymbolicLinks <- supportsSymlinks@@ -54,8 +57,9 @@       -- also tests expansion of "." and ".."       createDirectoryLink "." (longDir </> "link")       _ <- listDirectory (longDir </> ".." </> longName </> "link")-      T(expectEq) () "." =<< getSymbolicLinkTarget (longDir </> "." </> "link")+      T.expectEq _t () "." =<<+        getSymbolicLinkTarget (longDir </> "." </> "link") -      return ()+      pure ()    -- [removeFile], [removeDirectory] are automatically tested by the cleanup
tests/Main.hs view
@@ -11,6 +11,7 @@ import qualified DoesDirectoryExist001 import qualified DoesPathExist import qualified FileTime+import qualified FindExecutable import qualified FindFile001 import qualified GetDirContents001 import qualified GetDirContents002@@ -27,7 +28,6 @@ import qualified RenameDirectory import qualified RenameFile001 import qualified RenamePath-import qualified Safe import qualified Simplify import qualified T8482 import qualified WithCurrentDirectory@@ -46,6 +46,7 @@   T.isolatedRun _t "DoesDirectoryExist001" DoesDirectoryExist001.main   T.isolatedRun _t "DoesPathExist" DoesPathExist.main   T.isolatedRun _t "FileTime" FileTime.main+  T.isolatedRun _t "FindExecutable" FindExecutable.main   T.isolatedRun _t "FindFile001" FindFile001.main   T.isolatedRun _t "GetDirContents001" GetDirContents001.main   T.isolatedRun _t "GetDirContents002" GetDirContents002.main@@ -62,7 +63,6 @@   T.isolatedRun _t "RenameDirectory" RenameDirectory.main   T.isolatedRun _t "RenameFile001" RenameFile001.main   T.isolatedRun _t "RenamePath" RenamePath.main-  T.isolatedRun _t "Safe" Safe.main   T.isolatedRun _t "Simplify" Simplify.main   T.isolatedRun _t "T8482" T8482.main   T.isolatedRun _t "WithCurrentDirectory" WithCurrentDirectory.main
tests/MakeAbsolute.hs view
@@ -1,10 +1,16 @@ {-# LANGUAGE CPP #-} module MakeAbsolute where-#include "util.inl"-import System.FilePath ((</>), addTrailingPathSeparator,-                        dropTrailingPathSeparator, normalise)+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>), addTrailingPathSeparator,+                      dropTrailingPathSeparator, normalise) #if defined(mingw32_HOST_OS)-import System.FilePath (takeDrive)+import System.Directory.Internal+import System.OsPath (takeDrive, toChar, unpack) #endif  main :: TestEnv -> IO ()@@ -12,35 +18,36 @@   dot <- makeAbsolute ""   dot2 <- makeAbsolute "."   dot3 <- makeAbsolute "./."-  T(expectEq) () dot (dropTrailingPathSeparator dot)-  T(expectEq) () dot dot2-  T(expectEq) () dot dot3+  T.expectEq _t () dot (dropTrailingPathSeparator dot)+  T.expectEq _t () dot dot2+  T.expectEq _t () dot dot3    sdot <- makeAbsolute "./"   sdot2 <- makeAbsolute "././"-  T(expectEq) () sdot (addTrailingPathSeparator sdot)-  T(expectEq) () sdot sdot2+  T.expectEq _t () sdot (addTrailingPathSeparator sdot)+  T.expectEq _t () sdot sdot2    foo <- makeAbsolute "foo"   foo2 <- makeAbsolute "foo/."   foo3 <- makeAbsolute "./foo"-  T(expectEq) () foo (normalise (dot </> "foo"))-  T(expectEq) () foo foo2-  T(expectEq) () foo foo3+  T.expectEq _t () foo (normalise (dot </> "foo"))+  T.expectEq _t () foo foo2+  T.expectEq _t () foo foo3    sfoo <- makeAbsolute "foo/"   sfoo2 <- makeAbsolute "foo/./"   sfoo3 <- makeAbsolute "./foo/"-  T(expectEq) () sfoo (normalise (dot </> "foo/"))-  T(expectEq) () sfoo sfoo2-  T(expectEq) () sfoo sfoo3+  T.expectEq _t () sfoo (normalise (dot </> "foo/"))+  T.expectEq _t () sfoo sfoo2+  T.expectEq _t () sfoo sfoo3  #if defined(mingw32_HOST_OS)   cwd <- getCurrentDirectory-  let driveLetter = toUpper (head (takeDrive cwd))+  cwdDriveLetter : _ <- pure (unpack (takeDrive cwd))+  let driveLetter = toUpper (toChar cwdDriveLetter)   let driveLetter' = if driveLetter == 'Z' then 'A' else succ driveLetter-  drp1 <- makeAbsolute (driveLetter : ":foobar")-  drp2 <- makeAbsolute (driveLetter' : ":foobar")-  T(expectEq) () drp1 =<< makeAbsolute "foobar"-  T(expectEq) () drp2 (driveLetter' : ":\\foobar")+  drp1 <- makeAbsolute (os (driveLetter : ":foobar"))+  drp2 <- makeAbsolute (os (driveLetter' : ":foobar"))+  T.expectEq _t () drp1 =<< makeAbsolute "foobar"+  T.expectEq _t () drp2 (os (driveLetter' : ":\\foobar")) #endif
tests/MinimizeNameConflicts.hs view
@@ -1,14 +1,19 @@ {-# LANGUAGE CPP #-} module MinimizeNameConflicts   ( main-  , module System.Directory+  , module System.Directory.OsPath #if defined(mingw32_HOST_OS)   , module System.Win32 #else   , module System.Posix #endif   ) where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T #if defined(mingw32_HOST_OS) import System.Win32 hiding   ( copyFile@@ -31,4 +36,4 @@ -- https://github.com/haskell/directory/issues/52 main :: TestEnv -> IO () main _t = do-  T(expect) "no-op" True+  T.expect _t ("no-op" :: String) True
tests/PathIsSymbolicLink.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE CPP #-} module PathIsSymbolicLink where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath import TestUtils+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do@@ -11,23 +14,23 @@     createFileLink "x" "y"     createDirectoryLink "a" "b" -    T(expect) () =<< pathIsSymbolicLink "y"-    T(expect) () =<< pathIsSymbolicLink "b"-    T(expectEq) () "x" =<< getSymbolicLinkTarget "y"-    T(expectEq) () "a" =<< getSymbolicLinkTarget "b"-    T(expectEq) () False =<< doesFileExist "y"-    T(expectEq) () False =<< doesDirectoryExist "b"+    T.expect _t () =<< pathIsSymbolicLink "y"+    T.expect _t () =<< pathIsSymbolicLink "b"+    T.expectEq _t () "x" =<< getSymbolicLinkTarget "y"+    T.expectEq _t () "a" =<< getSymbolicLinkTarget "b"+    T.expectEq _t () False =<< doesFileExist "y"+    T.expectEq _t () False =<< doesDirectoryExist "b"      writeFile "x" ""     createDirectory "a" -    T(expect) () =<< doesFileExist "y"-    T(expect) () =<< doesDirectoryExist "b"+    T.expect _t () =<< doesFileExist "y"+    T.expect _t () =<< doesDirectoryExist "b"      removeFile "y"     removeDirectoryLink "b" -    T(expectIOErrorType) () isDoesNotExistError (pathIsSymbolicLink "y")-    T(expectIOErrorType) () isDoesNotExistError (pathIsSymbolicLink "b")-    T(expectEq) () False =<< doesFileExist "y"-    T(expectEq) () False =<< doesDirectoryExist "b"+    T.expectIOErrorType _t () isDoesNotExistError (pathIsSymbolicLink "y")+    T.expectIOErrorType _t () isDoesNotExistError (pathIsSymbolicLink "b")+    T.expectEq _t () False =<< doesFileExist "y"+    T.expectEq _t () False =<< doesDirectoryExist "b"
tests/RemoveDirectoryRecursive001.hs view
@@ -1,9 +1,14 @@ {-# LANGUAGE CPP #-} module RemoveDirectoryRecursive001 where-#include "util.inl"-import System.FilePath ((</>), normalise)+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils (modifyPermissions, symlinkOrCopy)+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>), normalise) import qualified Data.List as List-import TestUtils  main :: TestEnv -> IO () main _t = do@@ -12,9 +17,9 @@   -- clean up junk from previous invocations    modifyPermissions (tmp "c") (\ p -> p { writable = True })-    `catchIOError` \ _ -> return ()+    `catchIOError` \ _ -> pure ()   removeDirectoryRecursive tmpD-    `catchIOError` \ _ -> return ()+    `catchIOError` \ _ -> pure ()    ------------------------------------------------------------   -- set up@@ -24,8 +29,8 @@   createDirectoryIfMissing True (tmp "a/z")   createDirectoryIfMissing True (tmp "b")   createDirectoryIfMissing True (tmp "c")-  writeFile (tmp "a/x/w/u") "foo"-  writeFile (tmp "a/t")     "bar"+  writeFile (so (tmp "a/x/w/u")) "foo"+  writeFile (so (tmp "a/t"))     "bar"   symlinkOrCopy (normalise "../a") (tmp "b/g")   symlinkOrCopy (normalise "../b") (tmp "c/h")   symlinkOrCopy (normalise "a")    (tmp "d")@@ -34,15 +39,15 @@   ------------------------------------------------------------   -- tests -  T(expectEq) () [".", "..", "a", "b", "c", "d"] . List.sort =<<+  T.expectEq _t () [".", "..", "a", "b", "c", "d"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "a")-  T(expectEq) () [".", "..", "g"] . List.sort =<<+  T.expectEq _t () [".", "..", "g"] . List.sort =<<     getDirectoryContents (tmp "b")-  T(expectEq) () [".", "..", "h"] . List.sort =<<+  T.expectEq _t () [".", "..", "h"] . List.sort =<<     getDirectoryContents (tmp "c")-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "d")    removeDirectoryRecursive (tmp "d")@@ -51,13 +56,13 @@     `catchIOError` \ _ -> removeDirectory (tmp "d") #endif -  T(expectEq) () [".", "..", "a", "b", "c"] . List.sort =<<+  T.expectEq _t () [".", "..", "a", "b", "c"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "a")-  T(expectEq) () [".", "..", "g"] . List.sort =<<+  T.expectEq _t () [".", "..", "g"] . List.sort =<<     getDirectoryContents (tmp "b")-  T(expectEq) () [".", "..", "h"] . List.sort =<<+  T.expectEq _t () [".", "..", "h"] . List.sort =<<     getDirectoryContents (tmp "c")    removeDirectoryRecursive (tmp "c")@@ -65,25 +70,25 @@       modifyPermissions (tmp "c") (\ p -> p { writable = True })       removeDirectoryRecursive (tmp "c") -  T(expectEq) () [".", "..", "a", "b"] . List.sort =<<+  T.expectEq _t () [".", "..", "a", "b"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<    getDirectoryContents (tmp "a")-  T(expectEq) () [".", "..", "g"] . List.sort =<<+  T.expectEq _t () [".", "..", "g"] . List.sort =<<     getDirectoryContents (tmp "b")    removeDirectoryRecursive (tmp "b") -  T(expectEq) () [".", "..", "a"] . List.sort =<<+  T.expectEq _t () [".", "..", "a"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "a")    removeDirectoryRecursive (tmp "a") -  T(expectEq) () [".", ".."] . List.sort =<<+  T.expectEq _t () [".", ".."] . List.sort =<<     getDirectoryContents  tmpD    where testName = "removeDirectoryRecursive001"-        tmpD  = testName ++ ".tmp"+        tmpD  = testName <> ".tmp"         tmp s = tmpD </> normalise s
tests/RemovePathForcibly.hs view
@@ -1,9 +1,13 @@-{-# LANGUAGE CPP #-} module RemovePathForcibly where-#include "util.inl"-import System.FilePath ((</>), normalise)+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils (hardLinkOrCopy, modifyPermissions, symlinkOrCopy)+import Util (TestEnv)+import qualified Util as T+import System.Directory.Internal+import System.OsPath ((</>), normalise) import qualified Data.List as List-import TestUtils  main :: TestEnv -> IO () main _t = do@@ -12,9 +16,9 @@   -- clean up junk from previous invocations    modifyPermissions (tmp "c") (\ p -> p { writable = True })-    `catchIOError` \ _ -> return ()+    `catchIOError` \ _ -> pure ()   removePathForcibly tmpD-    `catchIOError` \ _ -> return ()+    `catchIOError` \ _ -> pure ()    ------------------------------------------------------------   -- set up@@ -25,9 +29,9 @@   createDirectoryIfMissing True (tmp "b")   createDirectoryIfMissing True (tmp "c")   createDirectoryIfMissing True (tmp "f")-  writeFile (tmp "a/x/w/u") "foo"-  writeFile (tmp "a/t")     "bar"-  writeFile (tmp "f/s")     "qux"+  writeFile (so (tmp "a/x/w/u")) "foo"+  writeFile (so (tmp "a/t"))     "bar"+  writeFile (so (tmp "f/s"))     "qux"   symlinkOrCopy (normalise "../a") (tmp "b/g")   symlinkOrCopy (normalise "../b") (tmp "c/h")   symlinkOrCopy (normalise "a")    (tmp "d")@@ -40,49 +44,59 @@   removePathForcibly (tmp "f")   removePathForcibly (tmp "e") -- intentionally non-existent -  T(expectEq) () [".", "..", "a", "b", "c", "d"] . List.sort =<<+  T.expectEq _t () [".", "..", "a", "b", "c", "d"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "a")-  T(expectEq) () [".", "..", "g"] . List.sort =<<+  T.expectEq _t () [".", "..", "g"] . List.sort =<<     getDirectoryContents (tmp "b")-  T(expectEq) () [".", "..", "h"] . List.sort =<<+  T.expectEq _t () [".", "..", "h"] . List.sort =<<     getDirectoryContents (tmp "c")-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "d")    removePathForcibly (tmp "d") -  T(expectEq) () [".", "..", "a", "b", "c"] . List.sort =<<+  T.expectEq _t () [".", "..", "a", "b", "c"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "a")-  T(expectEq) () [".", "..", "g"] . List.sort =<<+  T.expectEq _t () [".", "..", "g"] . List.sort =<<     getDirectoryContents (tmp "b")-  T(expectEq) () [".", "..", "h"] . List.sort =<<+  T.expectEq _t () [".", "..", "h"] . List.sort =<<     getDirectoryContents (tmp "c")    removePathForcibly (tmp "c") -  T(expectEq) () [".", "..", "a", "b"] . List.sort =<<+  T.expectEq _t () [".", "..", "a", "b"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<    getDirectoryContents (tmp "a")-  T(expectEq) () [".", "..", "g"] . List.sort =<<+  T.expectEq _t () [".", "..", "g"] . List.sort =<<     getDirectoryContents (tmp "b")    removePathForcibly (tmp "b") -  T(expectEq) () [".", "..", "a"] . List.sort =<<+  T.expectEq _t () [".", "..", "a"] . List.sort =<<     getDirectoryContents  tmpD-  T(expectEq) () [".", "..", "t", "x", "y", "z"] . List.sort =<<+  T.expectEq _t () [".", "..", "t", "x", "y", "z"] . List.sort =<<     getDirectoryContents (tmp "a")    removePathForcibly (tmp "a") -  T(expectEq) () [".", ".."] . List.sort =<<+  T.expectEq _t () [".", ".."] . List.sort =<<     getDirectoryContents  tmpD +  ----------------------------------------------------------------------+  -- regression test for https://github.com/haskell/directory/issues/135+  +  writeFile "hl1" "hardlinked"+  setPermissions "hl1" emptyPermissions+  origPermissions <- getPermissions "hl1"+  hardLinkOrCopy "hl1" "hl2"+  removePathForcibly "hl2"+  T.expectEq _t () origPermissions =<< getPermissions "hl1"+   where testName = "removePathForcibly"-        tmpD  = testName ++ ".tmp"+        tmpD  = testName <> ".tmp"         tmp s = tmpD </> normalise s
tests/RenameDirectory.hs view
@@ -1,10 +1,14 @@-{-# LANGUAGE CPP #-} module RenameDirectory where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do   createDirectory "a"-  T(expectEq) () ["a"] =<< listDirectory "."+  T.expectEq _t () ["a"] =<< listDirectory "."   renameDirectory "a" "b"-  T(expectEq) () ["b"] =<< listDirectory "."+  T.expectEq _t () ["b"] =<< listDirectory "."
tests/RenameFile001.hs view
@@ -1,15 +1,20 @@-{-# LANGUAGE CPP #-} module RenameFile001 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do   writeFile tmp1 contents1-  renameFile tmp1 tmp2-  T(expectEq) () contents1 =<< readFile tmp2+  renameFile (os tmp1) (os tmp2)+  T.expectEq _t () contents1 =<< readFile tmp2   writeFile tmp1 contents2-  renameFile tmp2 tmp1-  T(expectEq) () contents1 =<< readFile tmp1+  renameFile (os tmp2) (os tmp1)+  T.expectEq _t () contents1 =<< readFile tmp1   where     tmp1 = "tmp1"     tmp2 = "tmp2"
tests/RenamePath.hs view
@@ -1,21 +1,26 @@-{-# LANGUAGE CPP #-} module RenamePath where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T  main :: TestEnv -> IO () main _t = do    createDirectory "a"-  T(expectEq) () ["a"] =<< listDirectory "."+  T.expectEq _t () ["a"] =<< listDirectory "."   renamePath "a" "b"-  T(expectEq) () ["b"] =<< listDirectory "."+  T.expectEq _t () ["b"] =<< listDirectory "."    writeFile tmp1 contents1-  renamePath tmp1 tmp2-  T(expectEq) () contents1 =<< readFile tmp2+  renamePath (os tmp1) (os tmp2)+  T.expectEq _t () contents1 =<< readFile tmp2   writeFile tmp1 contents2-  renamePath tmp2 tmp1-  T(expectEq) () contents1 =<< readFile tmp1+  renamePath (os tmp2) (os tmp1)+  T.expectEq _t () contents1 =<< readFile tmp1    where     tmp1 = "tmp1"
− tests/Safe.hs 
@@ -1,7 +0,0 @@--- Verify that System.Directory is indeed Safe (regression test for issue #30)-{-# LANGUAGE Safe #-}-module Safe where-import System.Directory ()--main :: a -> IO ()-main _ = return ()
tests/Simplify.hs view
@@ -1,39 +1,44 @@ {-# LANGUAGE CPP #-} module Simplify where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude import System.Directory.Internal (simplifyWindows)-import System.FilePath (normalise)+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T+import System.OsPath (normalise)  main :: TestEnv -> IO () main _t = do-  T(expectIOErrorType) () (const True) (setCurrentDirectory "")-  T(expectEq) () (simplifyWindows "") ""-  T(expectEq) () (simplifyWindows ".") "."-  T(expectEq) () (simplifyWindows "a///b") (normalise "a/b")-  T(expectEq) () (simplifyWindows "./a//b") (normalise "a/b")-  T(expectEq) () (simplifyWindows "a/../../../b/.") (normalise "../../b")-  T(expectEq) () (simplifyWindows "a/.././b/./") (normalise "b/")-  T(expectEq) () (simplifyWindows "C:/a/../b") (normalise "C:/b")-  T(expectEq) () (simplifyWindows "\\\\?\\./a\\../b") "\\\\?\\./a\\../b"-  T(expectEq) () (simplifyWindows "C:/a") (normalise "C:/a")-  T(expectEq) () (simplifyWindows "/a") (normalise "/a")+  T.expectIOErrorType _t () (const True) (setCurrentDirectory "")+  T.expectEq _t () (simplifyWindows "") ""+  T.expectEq _t () (simplifyWindows ".") "."+  T.expectEq _t () (simplifyWindows "a///b") (normalise "a/b")+  T.expectEq _t () (simplifyWindows "./a//b") (normalise "a/b")+  T.expectEq _t () (simplifyWindows "a/../../../b/.") (normalise "../../b")+  T.expectEq _t () (simplifyWindows "a/.././b/./") (normalise "b/")+  T.expectEq _t () (simplifyWindows "C:/a/../b") (normalise "C:/b")+  T.expectEq _t () (simplifyWindows "\\\\?\\./a\\../b") "\\\\?\\./a\\../b"+  T.expectEq _t () (simplifyWindows "C:/a") (normalise "C:/a")+  T.expectEq _t () (simplifyWindows "/a") (normalise "/a") #ifdef mingw32_HOST_OS-  T(expectEq) () (simplifyWindows "C:") "C:"-  T(expectEq) () (simplifyWindows "c:\\\\") "C:\\"-  T(expectEq) () (simplifyWindows "C:.") "C:"-  T(expectEq) () (simplifyWindows "C:.\\\\") "C:.\\"-  T(expectEq) () (simplifyWindows "C:..") "C:.."-  T(expectEq) () (simplifyWindows "C:..\\") "C:..\\"-  T(expectEq) () (simplifyWindows "C:\\.\\") "C:\\"-  T(expectEq) () (simplifyWindows "C:\\a") "C:\\a"-  T(expectEq) () (simplifyWindows "C:\\a\\\\b\\") "C:\\a\\b\\"-  T(expectEq) () (simplifyWindows "\\\\a\\b") "\\\\a\\b"-  T(expectEq) () (simplifyWindows "//a\\b/c/./d") "\\\\a\\b\\c\\d"-  T(expectEq) () (simplifyWindows "/.") "\\"-  T(expectEq) () (simplifyWindows "/./") "\\"-  T(expectEq) () (simplifyWindows "/../") "\\"-  T(expectEq) () (simplifyWindows "\\a\\.") "\\a"-  T(expectEq) () (simplifyWindows "//?") "\\\\?"-  T(expectEq) () (simplifyWindows "//?\\") "\\\\?\\"-  T(expectEq) () (simplifyWindows "//?/a/b") "\\\\?\\a/b"+  T.expectEq _t () (simplifyWindows "C:") "C:"+  T.expectEq _t () (simplifyWindows "c:\\\\") "C:\\"+  T.expectEq _t () (simplifyWindows "C:.") "C:"+  T.expectEq _t () (simplifyWindows "C:.\\\\") "C:.\\"+  T.expectEq _t () (simplifyWindows "C:..") "C:.."+  T.expectEq _t () (simplifyWindows "C:..\\") "C:..\\"+  T.expectEq _t () (simplifyWindows "C:\\.\\") "C:\\"+  T.expectEq _t () (simplifyWindows "C:\\a") "C:\\a"+  T.expectEq _t () (simplifyWindows "C:\\a\\\\b\\") "C:\\a\\b\\"+  T.expectEq _t () (simplifyWindows "\\\\a\\b") "\\\\a\\b"+  T.expectEq _t () (simplifyWindows "//a\\b/c/./d") "\\\\a\\b/c/./d"+  T.expectEq _t () (simplifyWindows "/.") "\\"+  T.expectEq _t () (simplifyWindows "/./") "\\"+  T.expectEq _t () (simplifyWindows "/../") "\\"+  T.expectEq _t () (simplifyWindows "\\a\\.") "\\a"+  T.expectEq _t () (simplifyWindows "//?") "\\\\?"+  T.expectEq _t () (simplifyWindows "//?\\") "\\\\?\\"+  T.expectEq _t () (simplifyWindows "//?/a/b") "\\\\?\\a/b" #endif
tests/T8482.hs view
@@ -1,18 +1,23 @@-{-# LANGUAGE CPP #-} module T8482 where-#include "util.inl"+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T -tmp1 :: FilePath+tmp1 :: OsPath tmp1 = "T8482.tmp1" -testdir :: FilePath+testdir :: OsPath testdir = "T8482.dir"  main :: TestEnv -> IO () main _t = do-  writeFile tmp1 "hello"+  writeFile (so tmp1) "hello"   createDirectory testdir-  T(expectIOErrorType) () (is InappropriateType) (renameFile testdir tmp1)-  T(expectIOErrorType) () (is InappropriateType) (renameFile tmp1    testdir)-  T(expectIOErrorType) () (is InappropriateType) (renameFile tmp1    ".")+  T.expectIOErrorType _t () (is InappropriateType) (renameFile testdir tmp1)+  T.expectIOErrorType _t () (is InappropriateType) (renameFile tmp1    testdir)+  T.expectIOErrorType _t () (is InappropriateType) (renameFile tmp1    ".")   where is t = (== t) . ioeGetErrorType
tests/TestUtils.hs view
@@ -1,17 +1,20 @@ {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-} -- | Utility functions specific to 'directory' tests module TestUtils   ( copyPathRecursive+  , hardLinkOrCopy   , modifyPermissions   , symlinkOrCopy   , supportsSymlinks   ) where import Prelude () import System.Directory.Internal.Prelude-import System.Directory-import System.FilePath ((</>), normalise, takeDirectory)+import System.Directory.Internal+import System.Directory.OsPath+import Data.String (IsString(fromString))+import System.OsPath ((</>), normalise, takeDirectory) #if defined(mingw32_HOST_OS)-import System.Directory.Internal (win32_getFinalPathNameByHandle) import qualified System.Win32 as Win32 #endif @@ -19,7 +22,7 @@ --   /path/ together with its contents and subdirectories. -- --   Warning: mostly untested and might not handle symlinks correctly.-copyPathRecursive :: FilePath -> FilePath -> IO ()+copyPathRecursive :: OsPath -> OsPath -> IO () copyPathRecursive source dest =   (`ioeSetLocation` "copyPathRecursive") `modifyIOError` do     dirExists <- doesDirectoryExist source@@ -31,7 +34,7 @@           [(source </> x, dest </> x) | x <- contents]       else copyFile source dest -modifyPermissions :: FilePath -> (Permissions -> Permissions) -> IO ()+modifyPermissions :: OsPath -> (Permissions -> Permissions) -> IO () modifyPermissions path modify = do   permissions <- getPermissions path   setPermissions path (modify permissions)@@ -52,11 +55,19 @@       _ -> ioError e #endif +-- | Create a hard link on Posix. On Windows, it just copies.+hardLinkOrCopy :: OsPath -> OsPath -> IO ()+#if defined(mingw32_HOST_OS)+hardLinkOrCopy = copyPathRecursive+#else+hardLinkOrCopy = createHardLink+#endif+ -- | Create a symbolic link.  On Windows, this falls back to copying if -- forbidden by Group Policy or is not supported.  On other platforms, there -- is no fallback.  Also, automatically detect if the source is a file or a -- directory and create the appropriate type of link.-symlinkOrCopy :: FilePath -> FilePath -> IO ()+symlinkOrCopy :: OsPath -> OsPath -> IO () symlinkOrCopy target link = do   let fullTarget = takeDirectory link </> target   handleSymlinkUnavail (copyPathRecursive fullTarget link) $ do@@ -69,19 +80,19 @@ supportsSymlinks = do   canCreate <- supportsLinkCreation   canDeref <- supportsLinkDeref-  return (canCreate && canDeref)+  pure (canCreate && canDeref)  -- | On Windows, test if symbolic link creation is supported and the user has -- the necessary privileges to create them.  On other platforms, this always -- returns 'True'. supportsLinkCreation :: IO Bool supportsLinkCreation = do-  let path = "_symlink_test.tmp"-  isSupported <- handleSymlinkUnavail (return False) $ do+  let path = os "_symlink_test.tmp"+  isSupported <- handleSymlinkUnavail (pure False) $ do     True <$ createFileLink path path   when isSupported $ do     removeFile path-  return isSupported+  pure isSupported  supportsLinkDeref :: IO Bool supportsLinkDeref = do@@ -89,8 +100,11 @@     True <$ win32_getFinalPathNameByHandle Win32.nullHANDLE 0   `catchIOError` \ e ->     case ioeGetErrorType e of-      UnsupportedOperation -> return False-      _ -> return True+      UnsupportedOperation -> pure False+      _ -> pure True #else-    return True+    pure True #endif++instance IsString OsString where+  fromString = os
tests/Util.hs view
@@ -1,17 +1,15 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} -- | A rudimentary testing framework module Util where import Prelude () import System.Directory.Internal.Prelude-import System.Directory+import System.Directory.Internal+import System.Directory.OsPath import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)-#if MIN_VERSION_base(4, 7, 0)+import GHC.Stack (CallStack, HasCallStack, callStack, getCallStack, srcLocFile,+                  srcLocStartLine) import System.Environment (getEnvironment, setEnv, unsetEnv)-#elif !defined(mingw32_HOST_OS)-import qualified System.Posix as Posix-#endif-import System.FilePath ((</>), normalise)+import System.OsPath ((</>), decodeFS, encodeFS, normalise) import qualified Data.List as List  modifyIORef' :: IORef a -> (a -> a) -> IO ()@@ -31,7 +29,7 @@   result <- timeout (round (1000000 * time)) action   case result of     Nothing -> throwIO (userError "timed out")-    Just x  -> return x+    Just x  -> pure x  data TestEnv =   TestEnv@@ -42,7 +40,7 @@   }  printInfo :: TestEnv -> [String] -> IO ()-printInfo TestEnv{testSilent = True}  _   = return ()+printInfo TestEnv{testSilent = True}  _   = pure () printInfo TestEnv{testSilent = False} msg = do   putStrLn (List.intercalate ": " msg)   hFlush stdout@@ -65,69 +63,72 @@ checkEither t prefix (Right msg) = printInfo t (prefix <> msg) checkEither t prefix (Left  msg) = printFailure t (prefix <> msg) -showContext :: Show a => String -> Integer -> a -> String-showContext file line context =-  file <> ":" <> show line <>+showContext :: Show a => CallStack -> a -> String+showContext stack context =+  case getCallStack stack of+    (_, l) : _ -> srcLocFile l <> ":" <> show (srcLocStartLine l)+    [] -> "<unknown caller>"+  <>   case show context of     "()" -> ""     s    -> ":" <> s -inform :: TestEnv -> String -> Integer -> String -> IO ()-inform t file line msg =-  printInfo t [showContext file line (), msg]+inform :: HasCallStack => TestEnv -> String -> IO ()+inform t msg =+  printInfo t [showContext callStack (), msg] -expect :: Show a => TestEnv -> String -> Integer -> a -> Bool -> IO ()-expect t file line context x =++expect :: (HasCallStack, Show a) => TestEnv -> a -> Bool -> IO ()+expect t context x =   check t x-  [showContext file line context]+  [showContext callStack context]   ["True"]   ["False, but True was expected"] -expectEq :: (Eq a, Show a, Show b) =>-            TestEnv -> String -> Integer -> b -> a -> a -> IO ()-expectEq t file line context x y =+expectEq :: (HasCallStack, Eq a, Show a, Show b) =>+            TestEnv -> b -> a -> a -> IO ()+expectEq t context x y =   check t (x == y)-  [showContext file line context]+  [showContext callStack context]   [show x <> " equals "     <> show y]   [show x <> " is not equal to " <> show y] -expectNe :: (Eq a, Show a, Show b) =>-            TestEnv -> String -> Integer -> b -> a -> a -> IO ()-expectNe t file line context x y =+expectNe :: (HasCallStack, Eq a, Show a, Show b) =>+            TestEnv -> b -> a -> a -> IO ()+expectNe t context x y =   check t (x /= y)-  [showContext file line context]+  [showContext callStack context]   [show x <> " is not equal to " <> show y]   [show x <> " equals "     <> show y] -expectNear :: (Num a, Ord a, Show a, Show b) =>-              TestEnv -> String -> Integer -> b -> a -> a -> a -> IO ()-expectNear t file line context x y diff =+expectNear :: (HasCallStack, Num a, Ord a, Show a, Show b) =>+              TestEnv -> b -> a -> a -> a -> IO ()+expectNear t context x y diff =   check t (abs (x - y) <= diff)-  [showContext file line context]+  [showContext callStack context]   [show x <> " is near "     <> show y]   [show x <> " is not near " <> show y] -expectNearTime :: Show a =>-                  TestEnv -> String -> Integer -> a ->+expectNearTime :: (HasCallStack, Show a) =>+                  TestEnv -> a ->                   UTCTime -> UTCTime -> NominalDiffTime -> IO ()-expectNearTime t file line context x y diff =+expectNearTime t context x y diff =   check t (abs (diffUTCTime x y) <= diff)-  [showContext file line context]+  [showContext callStack context]   [show x <> " is near "     <> show y]   [show x <> " is not near " <> show y] -expectIOErrorType :: Show a =>-                     TestEnv -> String -> Integer -> a-                  -> (IOError -> Bool) -> IO b -> IO ()-expectIOErrorType t file line context which action = do+expectIOErrorType :: (HasCallStack, Show a) =>+                     TestEnv -> a -> (IOError -> Bool) -> IO b -> IO ()+expectIOErrorType t context which action = do   result <- try action-  checkEither t [showContext file line context] $ case result of+  checkEither t [showContext callStack context] $ case result of     Left  e | which e   -> Right ["got expected exception (" <> show e <> ")"]             | otherwise -> Left  ["got wrong exception: ", show e]     Right _             -> Left  ["did not throw an exception"]  -- | Traverse the directory tree in preorder.-preprocessPathRecursive :: (FilePath -> IO ()) -> FilePath -> IO ()+preprocessPathRecursive :: (OsPath -> IO ()) -> OsPath -> IO () preprocessPathRecursive f path = do   dirExists <- doesDirectoryExist path   if dirExists@@ -136,57 +137,76 @@       f path       when (not isLink) $ do         names <- listDirectory path-        traverse_ (preprocessPathRecursive f) ((path </>) <$> names)+        for_ ((path </>) <$> names) (preprocessPathRecursive f)     else do       f path -withNewDirectory :: Bool -> FilePath -> IO a -> IO a+withNewDirectory :: Bool -> OsPath -> IO a -> IO a withNewDirectory keep dir action = do   dir' <- makeAbsolute dir   bracket_ (createDirectoryIfMissing True dir') (cleanup dir') action-  where cleanup dir' | keep      = return ()+  where cleanup dir' | keep      = pure ()                      | otherwise = removePathForcibly dir' +diffAsc' :: (j -> k -> Ordering)+         -> (u -> v -> Bool)+         -> [(j, u)]+         -> [(k, v)]+         -> ([(j, u)], [(k, v)])+diffAsc' cmp eq = go id id+  where+    go a b [] [] = (a [], b [])+    go a b jus [] = go (a . (jus <>)) b [] []+    go a b [] kvs = go a (b . (kvs <>)) [] []+    go a b jus@((j, u) : jus') kvs@((k, v) : kvs') =+      case cmp j k of+        LT -> go (a . ((j, u) :)) b jus' kvs+        GT -> go a (b . ((k, v) :)) jus kvs'+        EQ | eq u v -> go a b jus' kvs'+           | otherwise -> go (a . ((j, u) :)) (b . ((k, v) :)) jus' kvs'++diffAsc :: (Ord k, Eq v) => [(k, v)] -> [(k, v)] -> ([(k, v)], [(k, v)])+diffAsc = diffAsc' compare (==)++-- Environment variables may be sensitive, so don't log their values.+scrubEnv :: (String, String) -> (String, String)+scrubEnv (k, v)+  -- Allowlist for nonsensitive variables.+  | k `elem` ["XDG_CONFIG_HOME"] = (k, v)+  | otherwise = (k, "<" <> show (length v) <> " chars>")+ isolateEnvironment :: IO a -> IO a isolateEnvironment = bracket getEnvs setEnvs . const   where-    getEnvs = List.sort . filter (\(k, _) -> k /= "") <$> getEnvironment+    -- Duplicate environment variables will cause problems for this code.+    -- https://github.com/haskell/cabal/issues/10718+    getEnvs = List.sort . filter (\(k, _) -> not (null k)) <$> getEnvironment     setEnvs target = do       current <- getEnvs-      updateEnvs current target+      let (deletions, insertions) = diffAsc current target+      updateEnvs deletions insertions       new <- getEnvs       when (target /= new) $ do-        -- Environment variables may be sensitive, so don't log them.-        throwIO (userError "isolateEnvironment.setEnvs failed")-    updateEnvs kvs1@((k1, v1) : kvs1') kvs2@((k2, v2) : kvs2') =-      case compare k1 k2 of-        LT -> unsetEnv k1 *> updateEnvs kvs1' kvs2-        EQ | v1 == v2 -> updateEnvs kvs1' kvs2'-           | otherwise -> setEnv k1 v2 *> updateEnvs kvs1' kvs2'-        GT -> setEnv k2 v2 *> updateEnvs kvs1 kvs2'-    updateEnvs [] [] = pure ()-    updateEnvs kvs1 [] = for_ kvs1 (unsetEnv . fst)-    updateEnvs [] kvs2 = for_ kvs2 (uncurry setEnv)-#if MIN_VERSION_base(4, 7, 0)-#elif !defined(mingw32_HOST_OS)-    getEnvironment = Posix.getEnvironment-    setEnv k v = Posix.setEnv k v True-    unsetEnv = Posix.unsetEnv-#else-    getEnvironment = pure []-    setEnv _ _ = pure ()-    unsetEnv _ = pure ()-#endif+        let (missing, extraneous) = diffAsc target new+        throwIO (userError ("isolateEnvironment.setEnvs failed:" <>+                            " deletions=" <> show (scrubEnv <$> deletions) <>+                            " insertions=" <> show (scrubEnv <$> insertions) <>+                            " missing=" <> show (scrubEnv <$> missing) <>+                            " extraneous=" <> show (scrubEnv <$> extraneous)))+    updateEnvs deletions insertions = do+      for_ deletions (unsetEnv . fst)+      for_ insertions (uncurry setEnv) -isolateWorkingDirectory :: Bool -> FilePath -> IO a -> IO a+isolateWorkingDirectory :: Bool -> OsPath -> IO a -> IO a isolateWorkingDirectory keep dir action = do-  when (normalise dir `List.elem` [".", "./"]) $+  normalisedDir <- decodeFS (normalise dir)+  when (normalisedDir `List.elem` [".", "./"]) $     throwIO (userError ("isolateWorkingDirectory cannot be used " <>                         "with current directory"))   dir' <- makeAbsolute dir   removePathForcibly dir'-  withNewDirectory keep dir' $-    withCurrentDirectory dir' $+  withNewDirectory keep dir' $ do+    withCurrentDirectory dir' $ do       action  run :: TestEnv -> String -> (TestEnv -> IO ()) -> IO ()@@ -194,14 +214,14 @@   result <- tryAny (action t)   case result of     Left  e  -> check t False [name] [] ["exception", show e]-    Right () -> return ()+    Right () -> pure ()  isolatedRun :: TestEnv -> String -> (TestEnv -> IO ()) -> IO ()-isolatedRun t@TestEnv{testKeepDirs = keep} name = run t name . (isolate .)+isolatedRun t@TestEnv{testKeepDirs = keep} name action = do+  workDir <- encodeFS ("dist-newstyle/tmp/test-" <> name <> ".tmp")+  run t name (isolate workDir . action)   where-    isolate =-      isolateEnvironment .-      isolateWorkingDirectory keep ("dist/test-" <> name <> ".tmp")+    isolate workDir = isolateEnvironment . isolateWorkingDirectory keep workDir  tryRead :: Read a => String -> Maybe a tryRead s =@@ -239,7 +259,7 @@           , testArgs     = args           }   action t-  n <- readIORef (counter)+  n <- readIORef counter   unless (n == 0) $ do     putStrLn ("[" <> show n <> " failures]")     hFlush stdout
tests/WithCurrentDirectory.hs view
@@ -1,22 +1,27 @@-{-# LANGUAGE CPP #-} module WithCurrentDirectory where-#include "util.inl"-import System.FilePath ((</>))+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.Internal+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T+import System.OsPath ((</>)) import qualified Data.List as List  main :: TestEnv -> IO () main _t = do   createDirectory dir   -- Make sure we're starting empty-  T(expectEq) () [] . List.sort =<< listDirectory dir+  T.expectEq _t () [] . List.sort =<< listDirectory dir   cwd <- getCurrentDirectory-  withCurrentDirectory dir (writeFile testfile contents)+  withCurrentDirectory dir (writeFile (so testfile) contents)   -- Are we still in original directory?-  T(expectEq) () cwd =<< getCurrentDirectory+  T.expectEq _t () cwd =<< getCurrentDirectory   -- Did the test file get created?-  T(expectEq) () [testfile] . List.sort =<< listDirectory dir+  T.expectEq _t () [testfile] . List.sort =<< listDirectory dir   -- Does the file contain what we expected to write?-  T(expectEq) () contents =<< readFile (dir </> testfile)+  T.expectEq _t () contents =<< readFile (so (dir </> testfile))   where     testfile = "testfile"     contents = "some data\n"
tests/Xdg.hs view
@@ -1,14 +1,17 @@ {-# LANGUAGE CPP #-} module Xdg where-#if MIN_VERSION_base(4, 7, 0)+import Prelude ()+import System.Directory.Internal.Prelude+import System.Directory.OsPath+import TestUtils ()+import Util (TestEnv)+import qualified Util as T import qualified Data.List as List import System.Environment (setEnv, unsetEnv) import System.FilePath (searchPathSeparator) #if !defined(mingw32_HOST_OS)-import System.FilePath ((</>))-#endif+import System.OsPath ((</>)) #endif-#include "util.inl"  main :: TestEnv -> IO () main _t = do@@ -17,14 +20,13 @@   _ <- getXdgDirectoryList XdgDataDirs   _ <- getXdgDirectoryList XdgConfigDirs -  T(expect) () True -- avoid warnings about redundant imports+  T.expect _t () True -- avoid warnings about redundant imports    -- setEnv, unsetEnv require base 4.7.0.0+-#if MIN_VERSION_base(4, 7, 0) #if !defined(mingw32_HOST_OS)   unsetEnv "XDG_CONFIG_HOME"   home <- getHomeDirectory-  T(expectEq) () (home </> ".config/mow") =<< getXdgDirectory XdgConfig "mow"+  T.expectEq _t () (home </> ".config/mow") =<< getXdgDirectory XdgConfig "mow" #endif    -- unset variables, so env doesn't affect test running@@ -42,10 +44,10 @@   setEnv "XDG_CONFIG_HOME" "aw"   setEnv "XDG_CACHE_HOME"  "ba"   setEnv "XDG_STATE_HOME"  "uw"-  T(expectEq) () xdgData   =<< getXdgDirectory XdgData   "ff"-  T(expectEq) () xdgConfig =<< getXdgDirectory XdgConfig "oo"-  T(expectEq) () xdgCache  =<< getXdgDirectory XdgCache  "rk"-  T(expectEq) () xdgState  =<< getXdgDirectory XdgState  "aa"+  T.expectEq _t () xdgData   =<< getXdgDirectory XdgData   "ff"+  T.expectEq _t () xdgConfig =<< getXdgDirectory XdgConfig "oo"+  T.expectEq _t () xdgCache  =<< getXdgDirectory XdgCache  "rk"+  T.expectEq _t () xdgState  =<< getXdgDirectory XdgState  "aa"    unsetEnv "XDG_CONFIG_DIRS"   unsetEnv "XDG_DATA_DIRS"@@ -53,14 +55,11 @@   _xdgDataDirs <- getXdgDirectoryList XdgDataDirs  #if !defined(mingw32_HOST_OS)-  T(expectEq) () ["/etc/xdg"] _xdgConfigDirs-  T(expectEq) () ["/usr/local/share/", "/usr/share/"] _xdgDataDirs+  T.expectEq _t () ["/etc/xdg"] _xdgConfigDirs+  T.expectEq _t () ["/usr/local/share/", "/usr/share/"] _xdgDataDirs #endif    setEnv "XDG_DATA_DIRS" (List.intercalate [searchPathSeparator] ["/a", "/b"])   setEnv "XDG_CONFIG_DIRS" (List.intercalate [searchPathSeparator] ["/c", "/d"])-  T(expectEq) () ["/a", "/b"] =<< getXdgDirectoryList XdgDataDirs-  T(expectEq) () ["/c", "/d"] =<< getXdgDirectoryList XdgConfigDirs-#endif--  return ()+  T.expectEq _t () ["/a", "/b"] =<< getXdgDirectoryList XdgDataDirs+  T.expectEq _t () ["/c", "/d"] =<< getXdgDirectoryList XdgConfigDirs
− tests/util.inl 
@@ -1,9 +0,0 @@-#define T(f) (T.f _t __FILE__ __LINE__)--import Prelude ()-import System.Directory.Internal.Prelude-import System.Directory-import Util (TestEnv)-import qualified Util as T--- This comment prevents "T" above from being treated as the function-like--- macro defined earlier.