{-# LANGUAGE OverloadedStrings #-}

module Server (
  servePages
) where

import Control.Applicative ((<|>))
import Network.Wai (Application, Response, responseLBS, Request (pathInfo))
import Network.Wai.Handler.Warp (run)
import qualified Network.HTTP.Types as H
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Text as T

import TemplatePage (PageContext, PageTemplate, buildPage)

import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import Control.Concurrent (MVar, readMVar, tryPutMVar)

app :: Map String PageTemplate -> MVar PageContext -> MVar () -> Application
app templates context updateNotify request respond = do
   let path = T.unpack $ T.intercalate "/" $ filter (not . T.null) $ pathInfo request
       slashPath = if path /= "" then '/' : path else path
       indexPath = slashPath ++ "/index.html"
       template = Map.lookup path templates <|> Map.lookup indexPath templates

   putStrLn $ "Page requested: " ++ slashPath
   context' <- readMVar context

   -- Unblock pageview cache if waiting for a request.
   _ <- tryPutMVar updateNotify ()

   respond $ respMaybe $ buildPage context' <$> template

respMaybe :: Maybe ByteString -> Response
respMaybe Nothing = notFound
respMaybe (Just text) = responseLBS H.status200 [("content-type", "text/html")] $ BS.fromStrict text

notFound :: Response
notFound = responseLBS H.status404 [(H.hContentType, "text/plain")] "404 - File not found"

servePages :: Int -> Map String PageTemplate -> MVar PageContext -> MVar () -> IO ()
servePages port templates context updateNotify = run port $ app templates context updateNotify