summaryrefslogtreecommitdiff
path: root/src/Hakyll/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Network')
-rw-r--r--src/Hakyll/Network/Server.hs36
1 files changed, 26 insertions, 10 deletions
diff --git a/src/Hakyll/Network/Server.hs b/src/Hakyll/Network/Server.hs
index 44f2607..0e25959 100644
--- a/src/Hakyll/Network/Server.hs
+++ b/src/Hakyll/Network/Server.hs
@@ -1,6 +1,10 @@
-- | Implements a basic static file server for previewing options
--
{-# LANGUAGE OverloadedStrings #-}
+module Hakyll.Network.Server
+ ( staticServer
+ ) where
+
import Control.Monad.Trans (liftIO)
import Control.Applicative ((<$>))
import Codec.Binary.UTF8.String
@@ -8,9 +12,11 @@ import System.FilePath ((</>))
import System.Directory (doesFileExist)
import qualified Data.ByteString as SB
-import Snap.Util.FileServe
-import Snap.Types
-import Snap.Http.Server
+import Snap.Util.FileServe (fileServeSingle)
+import Snap.Types (Snap, rqURI, getRequest, writeBS)
+import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen
+ , ConfigListen (..), emptyConfig
+ )
import Hakyll.Web.Util.String (replaceAll)
@@ -24,10 +30,10 @@ findFile (x : xs) = do
-- | Serve a given directory
--
-site :: FilePath -- ^ Directory to serve
- -> (FilePath -> IO ()) -- ^ Pre-serve hook
- -> Snap ()
-site directory preServe = do
+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 ?
@@ -50,7 +56,17 @@ site directory preServe = do
liftIO $ preServe f
fileServeSingle f
--- | Main method, runs snap
+-- | Main method, runs a static server in the given directory
--
-main :: IO ()
-main = httpServe defaultConfig $ site "." (\f -> putStrLn $ "Serving " ++ f)
+staticServer :: FilePath -- ^ Directory to serve
+ -> (FilePath -> IO ()) -- ^ Pre-serve hook
+ -> Int -- ^ Port to listen on
+ -> IO () -- ^ Blocks forever
+staticServer directory preServe port =
+ httpServe config $ static directory preServe
+ where
+ -- Snap server config
+ config = addListen (ListenHttp "0.0.0.0" port)
+ $ setAccessLog Nothing
+ $ setErrorLog Nothing
+ $ emptyConfig