@@ -1,6 +1,10 @@
11-- | Implements a basic static file server for previewing options
22--
33{-# LANGUAGE OverloadedStrings #-}
4+module Hakyll.Network.Server
5+ ( staticServer
6+ ) where
7+
48import Control.Monad.Trans (liftIO)
59import Control.Applicative ((<$>))
610import Codec.Binary.UTF8.String
@@ -8,9 +12,11 @@ import System.FilePath ((</>))
812import System.Directory (doesFileExist)
913
1014import qualified Data.ByteString as SB
11−import Snap.Util.FileServe
12−import Snap.Types
13−import Snap.Http.Server
15+import Snap.Util.FileServe (fileServeSingle)
16+import Snap.Types (Snap, rqURI, getRequest, writeBS)
17+import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen
18+ , ConfigListen (..), emptyConfig
19+ )
1420
1521import Hakyll.Web.Util.String (replaceAll)
1622
@@ -24,10 +30,10 @@ findFile (x : xs) = do
2430
2531-- | Serve a given directory
2632--
27−site :: FilePath -- ^ Directory to serve
28− -> (FilePath -> IO ()) -- ^ Pre-serve hook
29− -> Snap ()
30−site directory preServe = do
33+static :: FilePath -- ^ Directory to serve
34+ -> (FilePath -> IO ()) -- ^ Pre-serve hook
35+ -> Snap ()
36+static directory preServe = do
3137 -- Obtain the path
3238 uri <- rqURI <$> getRequest
3339 let filePath = replaceAll "\\?$" (const "") -- Remove trailing ?
@@ -50,7 +56,17 @@ site directory preServe = do
5056 liftIO $ preServe f
5157 fileServeSingle f
5258
53−-- | Main method, runs snap
59+-- | Main method, runs a static server in the given directory
5460--
55−main :: IO ()
56−main = httpServe defaultConfig $ site "." (\f -> putStrLn $ "Serving " ++ f)
61+staticServer :: FilePath -- ^ Directory to serve
62+ -> (FilePath -> IO ()) -- ^ Pre-serve hook
63+ -> Int -- ^ Port to listen on
64+ -> IO () -- ^ Blocks forever
65+staticServer directory preServe port =
66+ httpServe config $ static directory preServe
67+ where
68+ -- Snap server config
69+ config = addListen (ListenHttp "0.0.0.0" port)
70+ $ setAccessLog Nothing
71+ $ setErrorLog Nothing
72+ $ emptyConfig