Merge remote-tracking branch 'upstream/master'

This commit is contained in:
Lorenzo 2016-07-22 17:02:04 +02:00
commit 7a1989d288
4 changed files with 24 additions and 42 deletions

View file

@ -177,8 +177,10 @@ Library
If flag(previewServer)
Build-depends:
snap-core >= 0.6 && < 0.10,
snap-server >= 0.6 && < 0.10,
wai >= 3.2 && < 3.3,
warp >= 3.2 && < 3.3,
wai-app-static >= 3.1 && < 3.2,
http-types >= 0.9 && < 0.10,
fsnotify >= 0.2 && < 0.3,
system-filepath >= 0.4.6 && <= 0.5
Cpp-options:
@ -268,8 +270,10 @@ Test-suite hakyll-tests
If flag(previewServer)
Build-depends:
snap-core >= 0.6 && < 0.10,
snap-server >= 0.6 && < 0.10,
wai >= 3.2 && < 3.3,
warp >= 3.2 && < 3.3,
wai-app-static >= 3.1 && < 3.2,
http-types >= 0.9 && < 0.10,
fsnotify >= 0.2 && < 0.3,
system-filepath >= 0.4.6 && <= 0.5
Cpp-options:

View file

@ -121,9 +121,7 @@ server :: Configuration -> Logger -> String -> Int -> IO ()
#ifdef PREVIEW_SERVER
server conf logger host port = do
let destination = destinationDirectory conf
staticServer logger destination preServeHook host port
where
preServeHook _ = return ()
staticServer logger destination host port
#else
server _ _ _ _ = previewServerDisabled
#endif

View file

@ -7,48 +7,28 @@ module Hakyll.Preview.Server
--------------------------------------------------------------------------------
import Control.Monad.Trans (liftIO)
import qualified Data.ByteString.Char8 as B
import qualified Snap.Core as Snap
import qualified Snap.Http.Server as Snap
import qualified Snap.Util.FileServe as Snap
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
--------------------------------------------------------------------------------
-- | 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
-> FilePath -- ^ Directory to serve
-> (FilePath -> IO ()) -- ^ Pre-serve hook
-> String -- ^ Host to bind on
-> Int -- ^ Port to listen on
-> 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
Snap.httpServe config $ static directory preServe
where
-- Snap server config
config = Snap.setBind (B.pack host)
$ Snap.setPort port
$ Snap.setAccessLog Snap.ConfigNoLog
$ Snap.setErrorLog Snap.ConfigNoLog
$ Snap.setVerbose False
$ Snap.emptyConfig
let settings = Warp.setLogger noLog
$ Warp.setHost (fromString host)
$ Warp.setPort port Warp.defaultSettings
waiApp = Static.staticApp (Static.defaultWebAppSettings directory)
Warp.runSettings settings waiApp
noLog :: Wai.Request -> Status -> Maybe Integer -> IO ()
noLog _ _ _ = return ()

View file

@ -35,7 +35,7 @@ compressCss = compressSeparators . stripComments . compressWhitespace
compressSeparators :: String -> String
compressSeparators =
replaceAll "; *}" (const "}") .
replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .
replaceAll " *([{};]) *" (take 1 . dropWhile isSpace) .
replaceAll ";+" (const ";")