    {- directory traversal and manipulation
     -
     - Copyright 2011-2014 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -fno-warn-tabs #-}

    module Utility.Directory (
            module Utility.Directory,
            module Utility.SystemDirectory
    ) where

    import System.IO.Error
    import Control.Monad
    import System.FilePath
    import System.PosixCompat.Files
    import Control.Applicative
    import System.IO.Unsafe (unsafeInterleaveIO)
    import Data.Maybe
    import Prelude

    #ifndef mingw32_HOST_OS
    import Utility.SafeCommand
    import Control.Monad.IfElse
    #endif

    import Utility.SystemDirectory
    import Utility.Tmp
    import Utility.Exception
    import Utility.Monad
    import Utility.Applicative

    dirCruft :: FilePath -> Bool
    dirCruft "." = True
    dirCruft ".." = True
    dirCruft _ = False

    {- Lists the contents of a directory.
     - Unlike getDirectoryContents, paths are not relative to the directory. -}
    dirContents :: FilePath -> IO [FilePath]
    dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d

    {- Gets files in a directory, and then its subdirectories, recursively,
     - and lazily.
     -
     - Does not follow symlinks to other subdirectories.
     -
     - When the directory does not exist, no exception is thrown,
     - instead, [] is returned. -}
    dirContentsRecursive :: FilePath -> IO [FilePath]
    dirContentsRecursive = dirContentsRecursiveSkipping (const False) True

    {- Skips directories whose basenames match the skipdir. -}
    dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
    dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
      where
            go [] = return []
            go (dir:dirs)
                    | skipdir (takeFileName dir) = go dirs
                    | otherwise = unsafeInterleaveIO $ do
                            (files, dirs') <- collect [] []
                                    =<< catchDefaultIO [] (dirContents dir)
                            files' <- go (dirs' ++ dirs)
                            return (files ++ files')
            collect files dirs' [] = return (reverse files, reverse dirs')
            collect files dirs' (entry:entries)
                    | dirCruft entry = collect files dirs' entries
                    | otherwise = do
                            let skip = collect (entry:files) dirs' entries
                            let recurse = collect files (entry:dirs') entries
                            ms <- catchMaybeIO $ getSymbolicLinkStatus entry
                            case ms of
                                    (Just s)
                                            | isDirectory s -> recurse
                                            | isSymbolicLink s && followsubdirsymlinks ->
                                                    ifM (doesDirectoryExist entry)
                                                            ( recurse
                                                            , skip
                                                            )
                                    _ -> skip

    {- Gets the directory tree from a point, recursively and lazily,
     - with leaf directories **first**, skipping any whose basenames
     - match the skipdir. Does not follow symlinks. -}
    dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
    dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
      where
            go c [] = return c
            go c (dir:dirs)
                    | skipdir (takeFileName dir) = go c dirs
                    | otherwise = unsafeInterleaveIO $ do
                            subdirs <- go []
                                    =<< filterM (isDirectory <$$> getSymbolicLinkStatus)
                                    =<< catchDefaultIO [] (dirContents dir)
                            go (subdirs++dir:c) dirs

    {- Moves one filename to another.
     - First tries a rename, but falls back to moving across devices if needed. -}
    moveFile :: FilePath -> FilePath -> IO ()
    moveFile src dest = tryIO (rename src dest) >>= onrename
      where
            onrename (Right _) = noop
            onrename (Left e)
                    | isPermissionError e = rethrow
                    | isDoesNotExistError e = rethrow
                    | otherwise = viaTmp mv dest ""
              where
                    rethrow = throwM e

                    mv tmp _ = do
                    -- copyFile is likely not as optimised as
                    -- the mv command, so we'll use the command.
                    --
                    -- But, while Windows has a "mv", it does not seem very
                    -- reliable, so use copyFile there.
    #ifndef mingw32_HOST_OS
                            -- If dest is a directory, mv would move the file
                            -- into it, which is not desired.
                            whenM (isdir dest) rethrow
                            ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
                            let e' = e
    #else
                            r <- tryIO $ copyFile src tmp
                            let (ok, e') = case r of
                                    Left err -> (False, err)
                                    Right _ -> (True, e)
    #endif
                            unless ok $ do
                                    -- delete any partial
                                    _ <- tryIO $ removeFile tmp
                                    throwM e'

    #ifndef mingw32_HOST_OS
            isdir f = do
                    r <- tryIO $ getFileStatus f
                    case r of
                            (Left _) -> return False
                            (Right s) -> return $ isDirectory s
    #endif

    {- Removes a file, which may or may not exist, and does not have to
     - be a regular file.
     -
     - Note that an exception is thrown if the file exists but
     - cannot be removed. -}
    nukeFile :: FilePath -> IO ()
    nukeFile file = void $ tryWhenExists go
      where
    #ifndef mingw32_HOST_OS
            go = removeLink file
    #else
            go = removeFile file
    #endif