{- 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 Control.Applicative
import Control.Concurrent
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Maybe
import Prelude

#ifdef mingw32_HOST_OS
import qualified System.Win32 as Win32
#else
import qualified System.Posix as Posix
import Utility.SafeCommand
import Control.Monad.IfElse
#endif

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

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

fsCruft :: FilePath -> Bool
fsCruft "lost+found" = True
fsCruft d = dirCruft d

{- 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 c
                                =<< filterM (isDirectory <$$> getSymbolicLinkStatus)
                                =<< catchDefaultIO [] (dirContents dir)
                        go (subdirs++[dir]) 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

#ifndef mingw32_HOST_OS
data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
#else
data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
#endif

type IsOpen = MVar () -- full when the handle is open

openDirectory :: FilePath -> IO DirectoryHandle
openDirectory path = do
#ifndef mingw32_HOST_OS
        dirp <- Posix.openDirStream path
        isopen <- newMVar ()
        return (DirectoryHandle isopen dirp)
#else
        (h, fdat) <- Win32.findFirstFile (path </> "*")
        -- Indicate that the fdat contains a filename that readDirectory
        -- has not yet returned, by making the MVar be full.
        -- (There's always at least a "." entry.)
        alreadyhave <- newMVar ()
        isopen <- newMVar ()
        return (DirectoryHandle isopen h fdat alreadyhave)
#endif

closeDirectory :: DirectoryHandle -> IO ()
#ifndef mingw32_HOST_OS
closeDirectory (DirectoryHandle isopen dirp) =
        whenOpen isopen $
                Posix.closeDirStream dirp
#else
closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
        whenOpen isopen $ do
                _ <- tryTakeMVar alreadyhave
                Win32.findClose h
#endif
  where
        whenOpen :: IsOpen -> IO () -> IO ()
        whenOpen mv f = do
                v <- tryTakeMVar mv
                when (isJust v) f

{- |Reads the next entry from the handle. Once the end of the directory
is reached, returns Nothing and automatically closes the handle.
-}
readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
#ifndef mingw32_HOST_OS
readDirectory hdl@(DirectoryHandle _ dirp) = do
        e <- Posix.readDirStream dirp
        if null e
                then do
                        closeDirectory hdl
                        return Nothing
                else return (Just e)
#else
readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
        -- If the MVar is full, then the filename in fdat has
        -- not yet been returned. Otherwise, need to find the next
        -- file.
        r <- tryTakeMVar mv
        case r of
                Just () -> getfn
                Nothing -> do
                        more <- Win32.findNextFile h fdat
                        if more
                                then getfn
                                else do
                                        closeDirectory hdl
                                        return Nothing
  where
        getfn = do
                filename <- Win32.getFindDataFileName fdat
                return (Just filename)
#endif

-- True only when directory exists and contains nothing.
-- Throws exception if directory does not exist.
isDirectoryEmpty :: FilePath -> IO Bool
isDirectoryEmpty d = testDirectory d dirCruft

-- | True if the directory does not exist or contains nothing.
-- Ignores "lost+found" which can exist in an empty filesystem.
isUnpopulated :: FilePath -> IO Bool
isUnpopulated d = catchDefaultIO True $ testDirectory d fsCruft

-- | Run test on entries found in directory, return False as soon as the
-- test returns False, else return True.  Throws exception if directory does
-- not exist.
testDirectory :: FilePath -> (FilePath -> Bool) -> IO Bool
testDirectory d test = bracket (openDirectory d) closeDirectory check
  where
        check h = do
                v <- readDirectory h
                case v of
                        Nothing -> return True
                        Just f
                                | not (test f) -> return False
                                | otherwise -> check h