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) 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:

View file

@ -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

View file

@ -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

View file

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