{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-- | HTML.hs
-- A module which contain static html.
module HTML (
errorPageTemplate,
fullPageTemplate,
pagesTemplate,
threadTemplate,
omittedTemplate,
opPostTemplate,
replyTemplate
) where
import Board
import HSP
-- RAGE!!!
-- http://hackage.haskell.org/packages/archive/old-time/1.0.0.1/doc/html/src/System-Time.html#ClockTime
-- > FIXME: This is arguably wrong, since we can't
-- > get the current timezone without being in the IO monad.
import System.IO.Unsafe
import System.Time
import Data.Time
import System.Locale ( defaultTimeLocale )
import Data.List.Utils
import Text.Regex.Posix
-- Some vars.
title = "Гнездовье Жабрача"
errorPageTemplate :: String -> HSP XML
errorPageTemplate err =
<html>
<head>
<title><% err %></title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<meta http-equiv="Pragma" content="no-cache" />
<link rel="shortcut icon" href="/_static/favicon.ico" />
</head>
<body>
<center>
<h1><% err %></h1>
<img src="/_static/primula_404.jpg" />
</center>
</body>
</html>
fullPageTemplate :: Bool -> String -> [HSP XML] -> HSP XML
fullPageTemplate isThread tagsStr xml =
<html>
<head>
<title><% fullTitle %></title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<meta http-equiv="Pragma" content="no-cache" />
<link rel="shortcut icon" href="/_static/favicon.ico" />
<link rel="stylesheet" type="text/css" href="/_static/styles/futaba.css" title="Futaba" />
</head>
<body>
<% boardsListTemplate False %>
<br />
<div class="logo"><% fullTitle %></div>
<% xml %>
<% boardsListTemplate isThread %>
<p class="footer">
- <a href="http://kagami.touhou.ru/projects/show/primula">primula</a> + <a href="http://wakaba.c3.cx/">wakaba</a> + <a href="http://www.1chan.net/futallaby/">futallaby</a> + <a href="http://www.2chan.net/">futaba</a> -
</p>
</body>
</html>
where
fullTitle = "/" ++ tagsStr ++ "/ — " ++ title
threadTemplate :: Bool -> String -> String -> [HSP XML] -> HSP XML
threadTemplate True tag num xml =
<div class="thread">
<br />
<div class="theader">
Просмотр треда №<% num %>. [<a href=("/"++tag)>Назад</a>]
</div>
<hr />
<% xml %>
</div>
threadTemplate False tag _ xml =
<div class="thread">
<br />
<hr />
<a href=("/"++tag) class="section"><% tag %></a>
<% xml %>
</div>
opPostTemplate :: Bool -> Post -> HSP XML
opPostTemplate shortLinks post =
<table class="oppost"><tbody><tr>
<% postTemplate "post" shortLinks post %>
</tr></tbody></table>
omittedTemplate :: Int -> HSP XML
omittedTemplate omitted =
if omitted == 0
then return $ pcdata ""
else
<span class="omittedposts">Пропущено: <% show omitted %>.</span>
replyTemplate :: Bool -> Post -> HSP XML
replyTemplate shortLinks post =
<table class="replypost"><tbody><tr>
<td class="doubledash"><% pcdata ">>" %></td>
<% postTemplate "reply" shortLinks post %>
</tr></tbody></table>
pagesTemplate :: String -> (Int, Int) -> HSP XML
pagesTemplate tag (page, pages) =
<div class="pageshtml">
<br /><hr />
<table class="pages"><tbody><tr>
<% pagePrev %>
<% pagesBefore %>
<% pageCurrent %>
<% pagesAfter %>
<% pageNext %>
</tr></tbody></table>
<br />
</div>
where
pagePrev :: HSP XML
pagePrev = if page > 0
then <td>[<a href=(link (page-1))><% pcdata "<<" %></a>]</td>
else return $ pcdata ""
pagesBefore = generatePages [0..page-1]
pageCurrent = <td>[<% show page %>]</td>
pagesAfter = generatePages [page+1..pages]
pageNext :: HSP XML
pageNext = if page < pages
then <td>[<a href=(link (page+1))><% pcdata ">>" %></a>]</td>
else return $ pcdata ""
generatePages :: [Int] -> [HSP XML]
generatePages ns =
map (\n -> <td>[<a href=(link n)><% show n %></a>]</td>) ns
link n = "/"++tag++"/"++show n
---
boardsListTemplate :: Bool -> HSP XML
boardsListTemplate needHr =
<div class="boards">
<% if needHr then <hr /> else (return $ pcdata "") %>
[ <a href="/a/">/a/</a> <a href="/b/">/b/</a> <a href="/d/">/d/</a> <a href="/s/">/s/</a> <a href="/vg/">/vg/</a> ]
[ <a href="/*/">Главная</a> ]
[ <a href="/_static/rules.txt">Правила</a> <a href="http://touhou.ru/kagami/primula/specification.ru.txt">Спецификация</a> <a href="http://kagami.touhou.ru/projects/show/primula">Сорцы</a> ]
</div>
postTemplate :: String -> Bool -> Post -> HSP XML
postTemplate class' shortLinks post =
<td class=class'>
<a name=num></a>
<label>
<% date %>
</label>
<% cdata " " %>
<a href=link class="reflink"><% pcdata ">>" %><% num %></a>
<br />
<% img %>
<div class="message">
<% reply %>
<% cdata $ nl2br $ formating $ pbody post %>
</div>
</td>
where
num = show $ pnumber post
link = doLink shortLinks (pthread post, pnumber post)
numReply = show $ preplyto post
linkReply = doLink shortLinks (pthread post, preplyto post)
date = formatCalendarTime
defaultTimeLocale
"%Y-%m-%d %H:%M:%S"
(unsafePerformIO $ toCalendarTime $ pdatetime post)
img = maybe (return $ pcdata "") imgXML $ pimgurl post
reply = if (preplyto post == 0) || (preplyto post == pthread post)
then return $ pcdata ""
else replyXML linkReply numReply
imgXML :: String -> HSP XML
imgXML url =
<div class="filehtml">
<div class="fileinfo">
Нажмите на картинку для просмотра оригинальной версии.<br />
</div>
<div class="file">
<a href=url target="_blank">
<% img %>
</a>
</div>
</div>
where
(width', thumb) = getThumb url
img = if width' == 0
then <img src=thumb />
else <img src=thumb width=width' />
getThumb :: String -> (Int, String)
getThumb url | url =~ "radikal\\.ru" =
(0, (init $ reverse $ dropWhile (/='.') $ reverse url)++"t.jpg")
getThumb url = (200, url)
replyXML :: String -> String -> HSP XML
replyXML link num =
<div class="replylink">
<a href=link class="replyto"><% pcdata ">>" %><% num %></a>
</div>
doLink :: Bool -> (Int, Int) -> String
doLink isShort (thread, post) =
let sPost = '#':(show post)
in if isShort
then sPost
else "/"++(show thread)++sPost
-- Add formatting to post.
nl2br :: String -> String
nl2br = concat . map (\c -> if c == '\n' then "<br />" else [c])
formating :: String -> String
formating = replace "anonymous@" "radiochan@"