--------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Hakyll.Preview.Poll
    ( watchUpdates
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent             (forkIO)
import           Control.Concurrent.MVar        (newEmptyMVar, takeMVar,
                                                 tryPutMVar)
import           Control.Exception              (AsyncException, fromException,
                                                 handle, throw)
import           Control.Monad                  (forever, void, when)
import           System.Directory               (canonicalizePath)
import           System.FilePath                (pathSeparators)
import qualified System.FSNotify                as FSNotify

#ifdef mingw32_HOST_OS
import           Control.Concurrent             (threadDelay)
import           Control.Exception              (IOException, throw, try)
import           System.Directory               (doesFileExist)
import           System.Exit                    (exitFailure)
import           System.FilePath                ((</>))
import           System.IO                      (Handle, IOMode (ReadMode),
                                                 hClose, openFile)
import           System.IO.Error                (isPermissionError)
#endif


--------------------------------------------------------------------------------
import           Hakyll.Core.Configuration
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern


--------------------------------------------------------------------------------
-- | A thread that watches for updates in a 'providerDirectory' and recompiles
-- a site as soon as any changes occur
watchUpdates :: Configuration -> IO Pattern -> IO ()
watchUpdates conf update = do
    let providerDir = providerDirectory conf
    shouldBuild     <- newEmptyMVar
    pattern         <- update
    fullProviderDir <- canonicalizePath $ providerDirectory conf
    manager         <- FSNotify.startManager

    let allowed event = do
            -- Absolute path of the changed file. This must be inside provider
            -- dir, since that's the only dir we're watching.
            let path       = FSNotify.eventPath event
                relative   = dropWhile (`elem` pathSeparators) $
                    drop (length fullProviderDir) path
                identifier = fromFilePath relative

            shouldIgnore <- shouldIgnoreFile conf path
            return $ not shouldIgnore && matches pattern identifier

    -- This thread continually watches the `shouldBuild` MVar and builds
    -- whenever a value is present.
    _ <- forkIO $ forever $ do
        event <- takeMVar shouldBuild
        handle
            (\e -> case fromException e of
                Nothing    -> putStrLn (show e)
                Just async -> throw (async :: AsyncException))
            (update' event providerDir)

    -- Send an event whenever something occurs so that the thread described
    -- above will do a build.
    void $ FSNotify.watchTree manager providerDir (not . isRemove) $ \event -> do
        allowed' <- allowed event
        when allowed' $ void $ tryPutMVar shouldBuild event
  where
#ifndef mingw32_HOST_OS
    update' _     _        = void update
#else
    update' event provider = do
        let path = provider </> FSNotify.eventPath event
        -- on windows, a 'Modified' event is also sent on file deletion
        fileExists <- doesFileExist path

        when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10

    -- continuously attempts to open the file in between sleep intervals
    -- handler is run only once it is able to open the file
    waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> Integer -> IO r
    waitOpen _    _    _       0 = do
        putStrLn "[ERROR] Failed to retrieve modified file for regeneration"
        exitFailure
    waitOpen path mode handler retries = do
        res <- try $ openFile path mode :: IO (Either IOException Handle)
        case res of
            Left ex -> if isPermissionError ex
                       then do
                           threadDelay 100000
                           waitOpen path mode handler (retries - 1)
                       else throw ex
            Right h -> do
                handled <- handler h
                hClose h
                return handled
#endif


--------------------------------------------------------------------------------
isRemove :: FSNotify.Event -> Bool
isRemove (FSNotify.Removed {}) = True
isRemove _                     = False