{-# LANGUAGE OverloadedStrings #-} module DarcsDen.WebUtils where import Control.Exception import Control.Monad.Trans import Data.List (find) import Data.Maybe (isNothing) import Data.Monoid (mconcat) import HSP (XML, evalHSP, renderXML, renderAsHTML) import Snap.Core import Snap.Util.FileServe import System.FilePath import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 (pack) import qualified Data.Map as M import DarcsDen.Pages.HSPage ( HSPage ) import DarcsDen.State.Session import DarcsDen.State.Repository (getRepository) import DarcsDen.State.Util (repoDir) import DarcsDen.Util (fromBS, toBS) type Page = Session -> Snap () notFound :: Snap () notFound = notFoundPage "" notFoundPage :: BS.ByteString -> Snap () notFoundPage msg = do putResponse $ setResponseStatus 404 "Not Found" $ setContentType "text/html; charset=utf-8" emptyResponse r <- getRequest writeBS $ errorPageLayout r "background-color:#ffe; color:orange;" "not found" msg withResponse finishWith tobs :: String -> BS.ByteString tobs = B8.pack exceptionPage :: SomeException -> Snap () exceptionPage e = do r <- getRequest errorPage' $ errorPageLayout r "background-color:#fee; color:red;" "error" (tobs $ show e) errorPage :: BS.ByteString -> Snap () errorPage msg = do r <- getRequest errorPage' $ errorPageLayout r "background-color:#fee; color:red;" "error" msg errorPageLayout :: Request -> BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString errorPageLayout req style title content = BS.intercalate "\n" $ ["" ,"
" ,mconcat ["" ,mconcat ["Sorry.. your ", B8.pack $ show $ rqMethod req, " request to ", rqURI req, " failed. The details have been logged."] ,"
" ,"" ,humaniseError content ,"" ,"