Add option to include WAI middleware for the preview server. Include …

…middleware which adds `Refresh` headers as an option.

lib/Hakyll/Commands.hs

@@ -77,7 +77,7 @@ preview :: Configuration -> Logger -> Rules a -> Int -> IO ()
 #ifdef PREVIEW_SERVER
 preview conf logger rules port  = do
     deprecatedMessage
-    watch conf logger "0.0.0.0" port True rules
+    watch conf{previewHost = "0.0.0.0", previewPort = port} logger True rules
   where
     deprecatedMessage = mapM_ putStrLn [ "The preview command has been deprecated."
                                        , "Use the watch command for recompilation and serving."
@@ -90,9 +90,9 @@ preview _ _ _ _ = previewServerDisabled
 --------------------------------------------------------------------------------
 -- | Watch and recompile for changes
 
-watch :: Configuration -> Logger -> String -> Int -> Bool -> Rules a -> IO ()
+watch :: Configuration -> Logger -> Bool -> Rules a -> IO ()
 #ifdef WATCH_SERVER
-watch conf logger host port runServer rules = do
+watch conf logger runServer rules = do
 #ifndef mingw32_HOST_OS
     _ <- forkIO $ watchUpdates conf update
 #else
@@ -108,7 +108,7 @@ watch conf logger host port runServer rules = do
         (_, ruleSet) <- run RunModeNormal conf logger rules
         return $ rulesPattern ruleSet
     loop = threadDelay 100000 >> loop
-    server' = if runServer then server conf logger host port else loop
+    server' = if runServer then server conf logger else loop
 #else
 watch _ _ _ _ _ _ = watchServerDisabled
 #endif
@@ -121,11 +121,9 @@ rebuild conf logger rules =
 
 --------------------------------------------------------------------------------
 -- | Start a server
-server :: Configuration -> Logger -> String -> Int -> IO ()
+server :: Configuration -> Logger -> IO ()
 #ifdef PREVIEW_SERVER
-server conf logger host port = do
-    let settings = previewSettings conf $ destinationDirectory conf
-    staticServer logger settings host port
+server conf logger = staticServer conf logger
 #else
 server _ _ _ _ = previewServerDisabled
 #endif

lib/Hakyll/Core/Configuration.hs

@@ -1,16 +1,23 @@
 --------------------------------------------------------------------------------
--- | Exports a datastructure for the top-level hakyll configuration
+-- | Exports a data structure for the top-level Hakyll configuration.
+{-# LANGUAGE OverloadedStrings #-}
 module Hakyll.Core.Configuration
-    ( Configuration (..)
+    ( -- * Configuration
+      defaultConfiguration
+    , Configuration (..)
+      -- * Utilities
     , shouldIgnoreFile
     , shouldWatchIgnore
-    , defaultConfiguration
+      -- * Middleware for the preview server
+    , middlewareRefresh
     ) where
 
 
 --------------------------------------------------------------------------------
 import           Data.Default     (Default (..))
 import           Data.List        (isPrefixOf, isSuffixOf)
+import           Data.String      (fromString)
+import           Network.Wai      (Middleware, mapResponseHeaders)
 import qualified Network.Wai.Application.Static as Static
 import           System.Directory (canonicalizePath)
 import           System.Exit      (ExitCode)
@@ -21,6 +28,14 @@ import           System.Process   (system)
 
 
 --------------------------------------------------------------------------------
+-- | Specifies the configuration for a Hakyll application.
+--
+-- Prefer to update record fields from 'defaultConfiguration'
+-- instead of constructing a 'Configuration' value directly.
+-- For example,
+--
+-- >>> let config = defaultConfiguration { destinationDirectory = "..." }
+--
 data Configuration = Configuration
     { -- | Directory in which the output written
       destinationDirectory :: FilePath
@@ -96,14 +111,17 @@ data Configuration = Configuration
     , -- | Override other settings used by the preview server. Default is
       -- 'Static.defaultFileServerSettings'.
       previewSettings      :: FilePath -> Static.StaticSettings
+    , -- | WAI middleware which can sit between the preview server
+      -- and the file serving.  Default is to do nothing.
+      previewMiddleware    :: Middleware
     }
 
 --------------------------------------------------------------------------------
 instance Default Configuration where
     def = defaultConfiguration
 
 --------------------------------------------------------------------------------
--- | Default configuration for a hakyll application
+-- | Default configuration for a Hakyll application.
 defaultConfiguration :: Configuration
 defaultConfiguration = Configuration
     { destinationDirectory = "_site"
@@ -119,6 +137,7 @@ defaultConfiguration = Configuration
     , previewHost          = "127.0.0.1"
     , previewPort          = 8000
     , previewSettings      = Static.defaultFileServerSettings
+    , previewMiddleware    = id
     }
   where
     ignoreFile' path
@@ -161,3 +180,23 @@ shouldWatchIgnore conf = do
     return (\path ->
               let path' = makeRelative fullProviderDir path
               in (|| watchIgnore conf path') <$> shouldIgnoreFile conf path)
+
+
+--------------------------------------------------------------------------------
+-- | WAI middleware which tells clients that they should refresh loaded content
+-- periodically.  Can be used to avoid having to manually reload content.
+--
+-- For example, the following can be used to have content reloaded
+-- every 10 seconds during preview:
+--
+-- >>> let config = defaultConfiguration { previewMiddleware = middlewareRefresh 10 }
+middlewareRefresh
+  -- | Seconds between refreshes.
+  :: Int
+  -- | Middleware which adds the @Refresh@ header to HTTP responses.
+  -> Middleware
+middlewareRefresh seconds app req respond = app req respond'
+  where
+    respond' = respond . autoRefresh
+    autoRefresh = mapResponseHeaders addRefresh
+    addRefresh rs = ("Refresh", fromString $ show seconds) : rs

lib/Hakyll/Main.hs

@@ -110,10 +110,11 @@ invokeCommands args conf check logger rules =
         Deploy         -> Commands.deploy conf
         Preview p      -> Commands.preview conf logger rules p >> ok
         Rebuild        -> Commands.rebuild conf logger rules
-        Server  _ _    -> Commands.server conf logger (host args) (port args) >> ok
-        Watch   _ p s  -> Commands.watch conf logger (host args) p (not s) rules >> ok
+        Server  _ _    -> Commands.server serverConf{Config.previewPort = port args} logger >> ok
+        Watch   _ p s  -> Commands.watch serverConf{Config.previewPort = p} logger (not s) rules >> ok
     where
         ok = return ExitSuccess
+        serverConf = conf{Config.previewHost = host args}
 
 
 --------------------------------------------------------------------------------

lib/Hakyll/Preview/Server.hs

@@ -14,19 +14,23 @@ import qualified Network.Wai                    as Wai
 import           Network.HTTP.Types.Status      (Status)
 
 --------------------------------------------------------------------------------
-import           Hakyll.Core.Logger    (Logger)
-import qualified Hakyll.Core.Logger    as Logger
+import           Hakyll.Core.Configuration (Configuration(..))
+import           Hakyll.Core.Logger        (Logger)
+import qualified Hakyll.Core.Logger        as Logger
 
-staticServer :: Logger               -- ^ Logger
-             -> Static.StaticSettings -- ^ Static file server settings
-             -> String               -- ^ Host to bind on
-             -> Int                  -- ^ Port to listen on
-             -> IO ()                -- ^ Blocks forever
-staticServer logger settings host port = do
+staticServer :: Configuration         -- ^ Hakyll configuration
+             -> Logger                -- ^ Logger
+             -> IO ()                 -- ^ Blocks forever
+staticServer config logger = do
     Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port
     Logger.flush logger -- ensure this line is logged before Warp errors
-    Warp.runSettings warpSettings $ Static.staticApp settings
+    Warp.runSettings warpSettings app
   where
+    host = previewHost config
+    port = previewPort config
+    settings = previewSettings config $ destinationDirectory config
+    app = previewMiddleware config $ serverApp
+    serverApp = Static.staticApp settings
     warpSettings = Warp.setLogger noLog
         $ Warp.setHost (fromString host)
         $ Warp.setPort port Warp.defaultSettings