{-# LANGUAGE CPP #-}

--------------------------------------------------------------------------------
module Hakyll.Preview.Poll
    ( watchUpdates
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent.MVar        (newMVar, putMVar, takeMVar)
import           Control.Monad                  (when, void)
import           Filesystem.Path.CurrentOS      (decodeString, encodeString)
import           System.Directory               (canonicalizePath)
import           System.FilePath                (pathSeparators, (</>))
import           System.FSNotify                (Event (..), WatchConfig (..),
                                                 startManagerConf, watchTree)

#ifdef mingw32_HOST_OS
import           System.IO                      (IOMode(ReadMode), Handle, openFile,
                                                 hClose)
import           System.IO.Error                (isPermissionError)
import           Control.Concurrent             (threadDelay)
import           Control.Exception              (IOException, throw, try)
import           System.Exit                    (exitFailure)
import           System.Directory               (doesFileExist)
#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 = decodeString $ providerDirectory conf
    lock            <- newMVar ()
    pattern         <- update
    fullProviderDir <- canonicalizePath $ providerDirectory conf
    manager         <- startManagerConf (Debounce 0.1)

    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       = eventPath event
                relative   = dropWhile (`elem` pathSeparators) $
                    drop (length fullProviderDir) path
                identifier = fromFilePath relative

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

    watchTree manager providerDir (not . isRemove) $ \event -> do
        ()       <- takeMVar lock
        allowed' <- allowed event
        when allowed' $ update' event (encodeString providerDir)
        putMVar lock ()
    where
#ifndef mingw32_HOST_OS
      update' _     _        = void update
#else
      update' event provider = do
          let path = provider </> 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

--------------------------------------------------------------------------------
eventPath :: Event -> FilePath
eventPath evt = encodeString $ evtPath evt
  where
    evtPath (Added p _)    = p
    evtPath (Modified p _) = p
    evtPath (Removed p _)  = p


--------------------------------------------------------------------------------
isRemove :: Event -> Bool
isRemove (Removed _ _) = True
isRemove _             = False