Merge pull request #447 from Arguggi/master
Switch preview server from Snap to Warp
This commit is contained in:
commit
cb07202f5a
3 changed files with 23 additions and 41 deletions
12
hakyll.cabal
12
hakyll.cabal
|
@ -177,8 +177,10 @@ Library
|
||||||
|
|
||||||
If flag(previewServer)
|
If flag(previewServer)
|
||||||
Build-depends:
|
Build-depends:
|
||||||
snap-core >= 0.6 && < 0.10,
|
wai >= 3.2 && < 3.3,
|
||||||
snap-server >= 0.6 && < 0.10,
|
warp >= 3.2 && < 3.3,
|
||||||
|
wai-app-static >= 3.1 && < 3.2,
|
||||||
|
http-types >= 0.9 && < 0.10,
|
||||||
fsnotify >= 0.2 && < 0.3,
|
fsnotify >= 0.2 && < 0.3,
|
||||||
system-filepath >= 0.4.6 && <= 0.5
|
system-filepath >= 0.4.6 && <= 0.5
|
||||||
Cpp-options:
|
Cpp-options:
|
||||||
|
@ -268,8 +270,10 @@ Test-suite hakyll-tests
|
||||||
|
|
||||||
If flag(previewServer)
|
If flag(previewServer)
|
||||||
Build-depends:
|
Build-depends:
|
||||||
snap-core >= 0.6 && < 0.10,
|
wai >= 3.2 && < 3.3,
|
||||||
snap-server >= 0.6 && < 0.10,
|
warp >= 3.2 && < 3.3,
|
||||||
|
wai-app-static >= 3.1 && < 3.2,
|
||||||
|
http-types >= 0.9 && < 0.10,
|
||||||
fsnotify >= 0.2 && < 0.3,
|
fsnotify >= 0.2 && < 0.3,
|
||||||
system-filepath >= 0.4.6 && <= 0.5
|
system-filepath >= 0.4.6 && <= 0.5
|
||||||
Cpp-options:
|
Cpp-options:
|
||||||
|
|
|
@ -121,9 +121,7 @@ server :: Configuration -> Logger -> String -> Int -> IO ()
|
||||||
#ifdef PREVIEW_SERVER
|
#ifdef PREVIEW_SERVER
|
||||||
server conf logger host port = do
|
server conf logger host port = do
|
||||||
let destination = destinationDirectory conf
|
let destination = destinationDirectory conf
|
||||||
staticServer logger destination preServeHook host port
|
staticServer logger destination host port
|
||||||
where
|
|
||||||
preServeHook _ = return ()
|
|
||||||
#else
|
#else
|
||||||
server _ _ _ _ = previewServerDisabled
|
server _ _ _ _ = previewServerDisabled
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -7,48 +7,28 @@ module Hakyll.Preview.Server
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
import Control.Monad.Trans (liftIO)
|
import Data.String
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Network.Wai.Handler.Warp as Warp
|
||||||
import qualified Snap.Core as Snap
|
import qualified Network.Wai.Application.Static as Static
|
||||||
import qualified Snap.Http.Server as Snap
|
import qualified Network.Wai as Wai
|
||||||
import qualified Snap.Util.FileServe as Snap
|
import Network.HTTP.Types.Status (Status)
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
import Hakyll.Core.Logger (Logger)
|
import Hakyll.Core.Logger (Logger)
|
||||||
import qualified Hakyll.Core.Logger as Logger
|
import qualified Hakyll.Core.Logger as Logger
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Serve a given directory
|
|
||||||
static :: FilePath -- ^ Directory to serve
|
|
||||||
-> (FilePath -> IO ()) -- ^ Pre-serve hook
|
|
||||||
-> Snap.Snap ()
|
|
||||||
static directory preServe =
|
|
||||||
Snap.serveDirectoryWith directoryConfig directory
|
|
||||||
where
|
|
||||||
directoryConfig :: Snap.DirectoryConfig Snap.Snap
|
|
||||||
directoryConfig = Snap.fancyDirectoryConfig
|
|
||||||
{ Snap.preServeHook = liftIO . preServe
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Main method, runs a static server in the given directory
|
|
||||||
staticServer :: Logger -- ^ Logger
|
staticServer :: Logger -- ^ Logger
|
||||||
-> FilePath -- ^ Directory to serve
|
-> FilePath -- ^ Directory to serve
|
||||||
-> (FilePath -> IO ()) -- ^ Pre-serve hook
|
|
||||||
-> String -- ^ Host to bind on
|
-> String -- ^ Host to bind on
|
||||||
-> Int -- ^ Port to listen on
|
-> Int -- ^ Port to listen on
|
||||||
-> IO () -- ^ Blocks forever
|
-> IO () -- ^ Blocks forever
|
||||||
staticServer logger directory preServe host port = do
|
staticServer logger directory host port = do
|
||||||
Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port
|
Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port
|
||||||
Snap.httpServe config $ static directory preServe
|
let settings = Warp.setLogger noLog
|
||||||
where
|
$ Warp.setHost (fromString host)
|
||||||
-- Snap server config
|
$ Warp.setPort port Warp.defaultSettings
|
||||||
config = Snap.setBind (B.pack host)
|
waiApp = Static.staticApp (Static.defaultWebAppSettings directory)
|
||||||
$ Snap.setPort port
|
Warp.runSettings settings waiApp
|
||||||
$ Snap.setAccessLog Snap.ConfigNoLog
|
|
||||||
$ Snap.setErrorLog Snap.ConfigNoLog
|
noLog :: Wai.Request -> Status -> Maybe Integer -> IO ()
|
||||||
$ Snap.setVerbose False
|
noLog _ _ _ = return ()
|
||||||
$ Snap.emptyConfig
|
|
||||||
|
|
Loading…
Reference in a new issue