diff options
| -rw-r--r-- | hakyll.cabal | 45 | ||||
| -rw-r--r-- | src/Hakyll/Core/Logger.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Web/Preview/Server.hs | 57 |
3 files changed, 37 insertions, 69 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 9446fe5..46379a0 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -55,30 +55,27 @@ Library Hs-Source-Dirs: src Build-Depends: - base >= 4 && < 5, - binary >= 0.5, - blaze-html >= 0.4, - bytestring >= 0.9, - containers == 0.*, - directory == 1.*, - filepath == 1.*, - hamlet >= 0.7, - hopenssl >= 1.4, - HTTP >= 4000, - mtl >= 1, - old-locale == 1.*, - old-time == 1.*, - pandoc == 1.*, - process >= 1.0, - regex-base >= 0.93, - regex-pcre >= 0.93, - snap-core >= 0.4, - snap-server >= 0.4, - strict-concurrency >= 0.2, - tagsoup >= 0.12, - time >= 1.1, - unix >= 2.4, - utf8-string >= 0.3 + base >= 4 && < 5, + binary >= 0.5 && < 1.0, + blaze-html >= 0.4 && < 0.6, + bytestring >= 0.9 && < 1.0, + containers >= 0.3 && < 1.0, + directory >= 1.0 && < 1.3, + filepath >= 1.0 && < 2.0, + hamlet >= 0.7 && < 0.9, + hopenssl >= 1.4 && < 1.7, + mtl >= 1 && < 3.0, + old-locale >= 1.0 && < 2.0, + old-time >= 1.0 && < 1.3, + pandoc >= 1.6 && < 2.0, + process >= 1.0 && < 1.4, + regex-base >= 0.93 && < 1.0, + regex-pcre >= 0.93 && < 1.0, + snap-core >= 0.5.1 && < 0.6, + snap-server >= 0.5.1 && < 0.6, + tagsoup >= 0.12 && < 0.13, + time >= 1.1 && < 1.3, + unix >= 2.4 && < 2.6 Exposed-Modules: Hakyll diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs index 912cc98..fb9b276 100644 --- a/src/Hakyll/Core/Logger.hs +++ b/src/Hakyll/Core/Logger.hs @@ -15,8 +15,8 @@ import Control.Monad (forever) import Control.Monad.Trans (MonadIO, liftIO) import Control.Applicative (pure, (<$>), (<*>)) import Control.Concurrent (forkIO) -import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan) -import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar) +import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) +import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar) import Text.Printf (printf) import Data.Time (getCurrentTime, diffUTCTime) diff --git a/src/Hakyll/Web/Preview/Server.hs b/src/Hakyll/Web/Preview/Server.hs index 4269509..22d48ad 100644 --- a/src/Hakyll/Web/Preview/Server.hs +++ b/src/Hakyll/Web/Preview/Server.hs @@ -6,56 +6,27 @@ module Hakyll.Web.Preview.Server ) where import Control.Monad.Trans (liftIO) -import Control.Applicative ((<$>)) -import Codec.Binary.UTF8.String -import Network.HTTP.Base (urlDecode) -import System.FilePath ((</>)) -import System.Directory (doesFileExist) -import qualified Data.ByteString as SB -import Snap.Util.FileServe (serveFile) -import Snap.Types (Snap, rqURI, getRequest, writeBS) -import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen - , ConfigListen (..), emptyConfig +import Snap.Types (Snap) +import Snap.Util.FileServe ( DirectoryConfig (..), fancyDirectoryConfig + , serveDirectoryWith + ) +import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog + , setPort, emptyConfig ) -import Hakyll.Core.Util.String (replaceAll) - --- | The first file in the list that actually exists is returned --- -findFile :: [FilePath] -> IO (Maybe FilePath) -findFile [] = return Nothing -findFile (x : xs) = do - exists <- doesFileExist x - if exists then return (Just x) else findFile xs - -- | Serve a given directory -- static :: FilePath -- ^ Directory to serve -> (FilePath -> IO ()) -- ^ Pre-serve hook -> Snap () -static directory preServe = do - -- Obtain the path - uri <- rqURI <$> getRequest - let filePath = replaceAll "\\?.*$" (const "") -- Remove trailing ? - $ replaceAll "#[^#]*$" (const "") -- Remove #section - $ replaceAll "^/" (const "") -- Remove leading / - $ urlDecode $ decode $ SB.unpack uri - - -- Try to find the requested file - r <- liftIO $ findFile $ map (directory </>) $ - [ filePath - , filePath </> "index.htm" - , filePath </> "index.html" - ] - - case r of - -- Not found, error - Nothing -> writeBS "Not found" - -- Found, serve - Just f -> do - liftIO $ preServe f - serveFile f +static directory preServe = + serveDirectoryWith directoryConfig directory + where + directoryConfig :: DirectoryConfig Snap + directoryConfig = fancyDirectoryConfig + { preServeHook = liftIO . preServe + } -- | Main method, runs a static server in the given directory -- @@ -67,7 +38,7 @@ staticServer directory preServe port = httpServe config $ static directory preServe where -- Snap server config - config = addListen (ListenHttp "0.0.0.0" port) + config = setPort port $ setAccessLog Nothing $ setErrorLog Nothing $ emptyConfig |