git.iko.soy/hakyll
on master help sign in
Make static server configurable
88b823eJasper Van der Jeugt
src/Hakyll/Network/Server.hs+26−10
compare with master
unifiedsplit
@@ -1,6 +1,10 @@
1-- | Implements a basic static file server for previewing options
1-- | Implements a basic static file server for previewing options
2--
2--
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4+module Hakyll.Network.Server
5+ ( staticServer
6+ ) where
7+
4import Control.Monad.Trans (liftIO)
8import Control.Monad.Trans (liftIO)
5import Control.Applicative ((<$>))
9import Control.Applicative ((<$>))
6import Codec.Binary.UTF8.String
10import Codec.Binary.UTF8.String
@@ -8,9 +12,11 @@ import System.FilePath ((</>))
8import System.Directory (doesFileExist)
12import System.Directory (doesFileExist)
9
13
10import qualified Data.ByteString as SB
14import qualified Data.ByteString as SB
11−import Snap.Util.FileServe
15+import Snap.Util.FileServe (fileServeSingle)
12−import Snap.Types
16+import Snap.Types (Snap, rqURI, getRequest, writeBS)
13−import Snap.Http.Server
17+import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen
18+ , ConfigListen (..), emptyConfig
19+ )
14
20
15import Hakyll.Web.Util.String (replaceAll)
21import Hakyll.Web.Util.String (replaceAll)
16
22
@@ -24,10 +30,10 @@ findFile (x : xs) = do
24
30
25-- | Serve a given directory
31-- | Serve a given directory
26--
32--
27−site :: FilePath -- ^ Directory to serve
33+static :: FilePath -- ^ Directory to serve
28− -> (FilePath -> IO ()) -- ^ Pre-serve hook
34+ -> (FilePath -> IO ()) -- ^ Pre-serve hook
29− -> Snap ()
35+ -> Snap ()
30−site directory preServe = do
36+static directory preServe = do
31 -- Obtain the path
37 -- Obtain the path
32 uri <- rqURI <$> getRequest
38 uri <- rqURI <$> getRequest
33 let filePath = replaceAll "\\?$" (const "") -- Remove trailing ?
39 let filePath = replaceAll "\\?$" (const "") -- Remove trailing ?
@@ -50,7 +56,17 @@ site directory preServe = do
50 liftIO $ preServe f
56 liftIO $ preServe f
51 fileServeSingle f
57 fileServeSingle f
52
58
53−-- | Main method, runs snap
59+-- | Main method, runs a static server in the given directory
54--
60--
55−main :: IO ()
61+staticServer :: FilePath -- ^ Directory to serve
56−main = httpServe defaultConfig $ site "." (\f -> putStrLn $ "Serving " ++ f)
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