--------------------------------------------------------------------------------
-- | Implements a basic static file server for previewing options
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Preview.Server
    ( staticServer
    ) where


--------------------------------------------------------------------------------
import           Data.String
import qualified Network.Wai.Handler.Warp       as Warp
import qualified Network.Wai.Application.Static as Static
import qualified Network.Wai                    as Wai
import           Network.HTTP.Types.Status      (Status)

--------------------------------------------------------------------------------
import           Hakyll.Core.Logger    (Logger)
import qualified Hakyll.Core.Logger    as Logger

staticServer :: Logger               -- ^ Logger
             -> FilePath             -- ^ Directory to serve
             -> String               -- ^ Host to bind on
             -> Int                  -- ^ Port to listen on
             -> IO ()                -- ^ Blocks forever
staticServer :: Logger -> FilePath -> FilePath -> Int -> IO ()
staticServer Logger
logger FilePath
directory FilePath
host Int
port = do
    Logger -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> FilePath -> m ()
Logger.header Logger
logger (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Listening on http://" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
host FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
port
    Logger -> IO ()
Logger.flush Logger
logger -- ensure this line is logged before Warp errors
    Settings -> Application -> IO ()
Warp.runSettings Settings
warpSettings (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$
        StaticSettings -> Application
Static.staticApp (FilePath -> StaticSettings
Static.defaultFileServerSettings FilePath
directory)
  where
    warpSettings :: Settings
warpSettings = (Request -> Status -> Maybe Integer -> IO ())
-> Settings -> Settings
Warp.setLogger Request -> Status -> Maybe Integer -> IO ()
noLog
        (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ HostPreference -> Settings -> Settings
Warp.setHost (FilePath -> HostPreference
forall a. IsString a => FilePath -> a
fromString FilePath
host)
        (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ Int -> Settings -> Settings
Warp.setPort Int
port Settings
Warp.defaultSettings

noLog :: Wai.Request -> Status -> Maybe Integer -> IO ()
noLog :: Request -> Status -> Maybe Integer -> IO ()
noLog Request
_ Status
_ Maybe Integer
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()