From 67ecff7ad383640bc73d64edc2506c7cc648a134 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 19 Jun 2017 11:57:23 +0200 Subject: Move src/ to lib/, put Init.hs in src/ --- src/Hakyll/Preview/Poll.hs | 119 ------------------------------------------- src/Hakyll/Preview/Server.hs | 35 ------------- 2 files changed, 154 deletions(-) delete mode 100644 src/Hakyll/Preview/Poll.hs delete mode 100644 src/Hakyll/Preview/Server.hs (limited to 'src/Hakyll/Preview') diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs deleted file mode 100644 index e197d3f..0000000 --- a/src/Hakyll/Preview/Poll.hs +++ /dev/null @@ -1,119 +0,0 @@ --------------------------------------------------------------------------------- -{-# 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 System.FSNotify (Event (..), startManager, - watchTree) - -#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 <- 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 = 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 $ 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 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 = evtPath evt - where - evtPath (Added p _) = p - evtPath (Modified p _) = p - evtPath (Removed p _) = p - - --------------------------------------------------------------------------------- -isRemove :: Event -> Bool -isRemove (Removed _ _) = True -isRemove _ = False diff --git a/src/Hakyll/Preview/Server.hs b/src/Hakyll/Preview/Server.hs deleted file mode 100644 index a84016a..0000000 --- a/src/Hakyll/Preview/Server.hs +++ /dev/null @@ -1,35 +0,0 @@ --------------------------------------------------------------------------------- --- | Implements a basic static file server for previewing options -{-# LANGUAGE OverloadedStrings #-} -module Hakyll.Preview.Server - ( staticServer - ) where - - --------------------------------------------------------------------------------- -import Data.String -import qualified Network.Wai.Handler.Warp as Warp -import qualified Network.Wai.Application.Static as Static -import qualified Network.Wai as Wai -import Network.HTTP.Types.Status (Status) - --------------------------------------------------------------------------------- -import Hakyll.Core.Logger (Logger) -import qualified Hakyll.Core.Logger as Logger - -staticServer :: Logger -- ^ Logger - -> FilePath -- ^ Directory to serve - -> String -- ^ Host to bind on - -> Int -- ^ Port to listen on - -> IO () -- ^ Blocks forever -staticServer logger directory host port = do - Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port - Warp.runSettings warpSettings $ - Static.staticApp (Static.defaultFileServerSettings directory) - where - warpSettings = Warp.setLogger noLog - $ Warp.setHost (fromString host) - $ Warp.setPort port Warp.defaultSettings - -noLog :: Wai.Request -> Status -> Maybe Integer -> IO () -noLog _ _ _ = return () -- cgit v1.2.3