{-# LANGUAGE CPP #-}

-- |
-- Module: Filesystem.Enumerator
-- Copyright: 2011 John Millikin
--            2011 Michael Snoyman
-- License: MIT
--
-- Maintainer: jmillikin@gmail.com
-- Portability: portable
--
-- Enumerator-based API for manipulating the filesystem.
module Filesystem.Enumerator
	( traverse
	, enumDirectory
	) where

import           Prelude hiding (FilePath)

import           Control.Exception (finally)
import           Control.Monad.IO.Class (MonadIO)
import           Data.Enumerator
import           Filesystem
import           Filesystem.Path ((</>))
import           Filesystem.Path.CurrentOS (FilePath, encodeString, decodeString)

#ifdef CABAL_OS_WINDOWS
import qualified System.Win32 as Win32
#else
import qualified System.Posix as Posix
#endif

-- | Starting at some root directory, traverse the filesystem and enumerate
-- every file (or symlink to a file) found.
--
-- Note: the option of whether to follow symlinks is currently only checked
-- on POSIX platforms, as the @Win32@ package does not support querying
-- symlink status. On Windows, symlinks will always be followed.
traverse :: MonadIO m
         => Bool -- ^ Follow directory symlinks (only used on POSIX platforms)
         -> FilePath -- ^ Root directory
         -> Enumerator FilePath m a
traverse followSymlinks root s = tryIO (listDirectory root) >>= (\ps -> loop ps s) where
	loop (p:ps) step@(Continue k) = do
		isFile' <- tryIO (isFile p)
		if isFile'
			then k (Chunks [p]) >>== loop ps
			else do
				follow' <- tryIO (follow p)
				if follow'
					then traverse followSymlinks p step >>== loop ps
					else loop ps step
	loop _ step = returnI step

	follow :: FilePath -> IO Bool
#ifdef CABAL_OS_WINDOWS
	follow = isDirectory
#else
	follow p = do
		let path = encodeString p
		stat <- if followSymlinks
			then Posix.getFileStatus path
			else Posix.getSymbolicLinkStatus path
		return (Posix.isDirectory stat)
#endif

-- | Enumerate entries in a directory. Entries are returned with their full
-- path. Entries are read from the directory handle as needed, so this is safe
-- to use with very large directories.
enumDirectory :: FilePath -> Enumerator FilePath IO a
enumDirectory root step = do
	let boring str = str == "." || str == ".."
	
#ifdef CABAL_OS_WINDOWS
	let search = root </> decodeString "*"
	(h, findData) <- tryIO (Win32.findFirstFile (encodeString search))
	let close = Win32.findClose h
	let iter = checkContinue0 $ \loop k -> do
		raw <- tryIO (Win32.getFindDataFileName findData)
		let path = root </> decodeString raw
		let checkNext s = do
			hasNext <- tryIO (Win32.findNextFile h findData)
			if hasNext
				then loop s
				else returnI s
		if boring raw
			then checkNext (Continue k)
			else k (Chunks [path]) >>== checkNext
#else
	dir <- tryIO (Posix.openDirStream (encodeString root))
	let close = Posix.closeDirStream dir
	let iter = checkContinue0 $ \loop k -> do
		raw <- tryIO (Posix.readDirStream dir)
		let path = root </> decodeString raw
		case raw of
			"" -> continue k
			_ | boring raw -> loop (Continue k)
			_ ->  k (Chunks [path]) >>== loop
#endif
	Iteratee (finally (runIteratee (iter step)) close)