    --------------------------------------------------------------------------------
    {-# 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 :: Configuration -> IO Pattern -> IO ()
    watchUpdates conf :: Configuration
    conf update :: IO Pattern
    update = do
        let providerDir :: FilePath
    providerDir = Configuration -> FilePath
    providerDirectory Configuration
    conf
        MVar Event
    shouldBuild     <- IO (MVar Event)
    forall a. IO (MVar a)
    newEmptyMVar
        Pattern
    pattern         <- IO Pattern
    update
        FilePath
    fullProviderDir <- FilePath -> IO FilePath
    canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ Configuration -> FilePath
    providerDirectory Configuration
    conf
        WatchManager
    manager         <- IO WatchManager
    FSNotify.startManager

        let allowed :: Event -> IO Bool
    allowed event :: Event
    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 :: FilePath
    path       = Event -> FilePath
    FSNotify.eventPath Event
    event
                    relative :: FilePath
    relative   = (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> FilePath -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` FilePath
    pathSeparators) (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $
                        Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    drop (FilePath -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    fullProviderDir) FilePath
    path
                    identifier :: Identifier
    identifier = FilePath -> Identifier
    fromFilePath FilePath
    relative

                Bool
    shouldIgnore <- Configuration -> FilePath -> IO Bool
    shouldIgnoreFile Configuration
    conf FilePath
    path
                Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not Bool
    shouldIgnore Bool -> Bool -> Bool
    && Pattern -> Identifier -> Bool
    matches Pattern
    pattern Identifier
    identifier

        -- This thread continually watches the `shouldBuild` MVar and builds
        -- whenever a value is present.
        ThreadId
    _ <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Event
    event <- MVar Event -> IO Event
    forall a. MVar a -> IO a
    takeMVar MVar Event
    shouldBuild
            (SomeException -> IO ()) -> IO () -> IO ()
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle
                (\e :: SomeException
    e -> case SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
                    Nothing    -> FilePath -> IO ()
    putStrLn (SomeException -> FilePath
    forall a. Show a => a -> FilePath
    show SomeException
    e)
                    Just async :: AsyncException
    async -> AsyncException -> IO ()
    forall a e. Exception e => e -> a
    throw (AsyncException
    async :: AsyncException))
                (Event -> FilePath -> IO ()
    forall p p. p -> p -> IO ()
    update' Event
    event FilePath
    providerDir)

        -- Send an event whenever something occurs so that the thread described
        -- above will do a build.
        IO (IO ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
    FSNotify.watchTree WatchManager
    manager FilePath
    providerDir (Bool -> Bool
    not (Bool -> Bool) -> ActionPredicate -> ActionPredicate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActionPredicate
    isRemove) (Action -> IO (IO ())) -> Action -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ \event :: Event
    event -> do
            Bool
    allowed' <- Event -> IO Bool
    allowed Event
    event
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    allowed' (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Bool -> IO ()) -> IO Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MVar Event -> Event -> IO Bool
    forall a. MVar a -> a -> IO Bool
    tryPutMVar MVar Event
    shouldBuild Event
    event
      where
    #ifndef mingw32_HOST_OS
        update' :: p -> p -> IO ()
    update' _     _        = IO Pattern -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void IO Pattern
    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 :: ActionPredicate
    isRemove (FSNotify.Removed {}) = Bool
    True
    isRemove _                     = Bool
    False