    {- 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