darcsden-1.1: src/DarcsDen/Pages/Repository.hs
{-# OPTIONS_GHC -F -pgmF trhsx #-}
{-# LANGUAGE RecordWildCards #-}
module DarcsDen.Pages.Repository where
import Data.Digest.Pure.MD5 (md5)
import Data.List (sortBy)
import Data.Maybe (fromJust)
import Data.Time (UTCTime, formatTime)
import HSP
import System.Locale (defaultTimeLocale)
import qualified Data.ByteString as BS
import DarcsDen.Handler.Repository.Browse (RepoItem(..))
import DarcsDen.Handler.Repository.Changes
( FileChange(..)
, PatchLog(..)
, PatchChange(..)
, Summary(..)
)
import DarcsDen.Handler.Repository.Forks (Fork(..), canMerge)
import DarcsDen.Pages.HSPage ( HSPage )
import DarcsDen.Pages.Base
import DarcsDen.Pages.Util ( repoForkSourceDescription, links, links' )
import DarcsDen.Settings
import DarcsDen.State.Comment
import DarcsDen.State.Issue
import DarcsDen.State.Repository
import DarcsDen.State.Session
import DarcsDen.State.User
import DarcsDen.Util hiding (paginate)
repoBase' :: User -> Bool -> Repository -> String -> HSP XML -> HSP XML -> HSP XML -> HSPage
repoBase' _ i r t b c l s = base
t
i
<span>
<a href=(repoOwnerURL r)><% rOwner r %></a> ->
<a href=(repoURL r) class=(if rIsPrivate r then "private-repo" else "public-repo")><% rName r %></a>
<% b %>
</span>
<div><% l %></div>
<div class="repo">
<div class="content">
<p class="repo-desc">
<% rDescription r %>
<% repoForkSourceDescription r %>
<%
if rWebsite r /= ""
then
<%
<span class="repo-website"> (<a href=(rWebsite r) rel="nofollow"><% rWebsite r %></a>)</span>
%>
else <% "" %>
%>
</p>
<% c %>
</div>
</div>
s
repoBase :: User -> Bool -> Repository -> String -> HSP XML -> HSP XML -> HSPage
repoBase u i r t b c s = repoBase' u i r t b c (links r (Just (rOwner r) == sUser s)) s
init :: [(String, String)] -> HSPage
init is = base
"init"
False
<span>init</span>
<div></div>
<div class="init">
<h2>initialize</h2>
<form action=(baseUrl ++ "init") method="post">
<fieldset>
<% field (input' is "name") "name" "" %>
<% field (input' is "description") "description" "" %>
<% field (input' is "website") "website" "" %>
-- <% field (input' is "bootstrap") "bootstrap" "" %>
<% field (checkbox' is "private") "private?" "" %>
<% submit "create repository" %>
</fieldset>
</form>
</div>
repo :: User -> Repository -> [RepoItem] -> [RepoItem] -> Maybe String -> Bool -> HSPage
repo u r files path readme member sess = repoBase' u True r
(uName u ++ "'s " ++ rName r)
<span> -> files</span>
(filesList (null files))
lks
sess
where
lks = if (member || (Just (rOwner r) == sUser sess))
then links' r [ <li class="edit"><a href=(repoURL r ++ "/edit")>repository settings</a></li>
, <li class="delete"><a href=(repoURL r ++ "/delete")>delete</a></li>
, <li class="create"><a href=(repoURL r ++ "/add-file" ++ (if null path then "" else iPath.last $ path))>add file</a></li>
]
else links r False
filesList :: Bool -> HSP XML
filesList True =
<div class="repo-browse no-files">
<h2>nothing here yet!</h2>
<%
if Just (rOwner r) == sUser sess
then ownerMessage
else if member
then memberMessage
else otherMessage
%>
</div>
where
ownerMessage =
<p class="repo-empty">
push your code to <code><% uName u %>@<% hostname %>:<% rName r %></code> to get started
</p>
memberMessage =
<p class="repo-empty">
push your code to <code><% fromJust (sUser sess) %><% hostname %>:<% rOwner r %>/<% rName r %></code> to get started
</p>
otherMessage =
<p class="repo-empty">move along, citizen</p>
filesList False =
<div class="repo-browse">
<h2 class="path">
<a href=(repoURL r ++ "/browse")>root</a>
<% map (\p -> <span class="path-item"> / <a href=(repoURL r ++ "/browse" ++ iPath p)><% iName p %></a></span>) path %>
</h2>
<ul class="repo-files">
<% map file files %>
</ul>
<%
case readme of
Nothing -> <% "" %>
Just s ->
<%
<div class="repo-readme">
<div class="markdown">
<% cdata s %>
</div>
</div>
%>
%>
</div>
file :: RepoItem -> HSP XML
file f =
<li class=(if iIsDirectory f then "directory" else "file")>
<a href=(repoURL r ++ "/browse" ++ iPath f)><% iName f %></a>
</li>
edit :: User -> Repository -> [User] -> [(String, String)] -> HSPage
edit u r ms is = repoBase u False r
"edit"
<span> -> edit</span>
<div class="repo-edit">
<form action=(repoURL r ++ "/edit") method="post">
<fieldset>
<% field (input "name" (rName r)) "name" "" %>
<% field (input "description" (rDescription r)) "description" "" %>
<% field (input "website" (rWebsite r)) "website" "" %>
<% if issuetrackers
then <% field (checkbox (rIssueTracker r) is "issuetracker") "issue tracker ?" "" %>
else <% "" %>
%>
<% field (checkbox (rIsPrivate r) is "private") "private ?" "" %>
<% field (input' is "add-members") "add members" "comma separated" %>
<%
if not (null ms)
then
<%
<div class="field">
<ul>
<% map (\m@(User { uID = Just uid }) ->
<li>
<input type="checkbox" name=("remove-" ++ show uid) />
<% cdata " " %>
<a href=(baseUrl ++ uName m)><% uName m %></a>
</li>) ms %>
</ul>
<label for="remove-members">remove members</label>
<br />
</div>
%>
else <% "" %>
%>
<% submit "update repository" %>
</fieldset>
</form>
<a href=(repoURL r ++ "/packs") style="border: thin solid #ccc; border-radius: 8px; float: right;">
<p style="padding: 20px;"> Build Packs </p>
</a>
</div>
delete :: User -> Repository -> HSPage
delete u r = repoBase u False r
"delete"
<span> -> delete</span>
<div class="repo-delete">
<h2>are you sure you want to delete this repository?</h2>
<p class="blurb">this action cannot be undone.</p>
<form action=(repoURL r ++ "/delete") method="post">
<fieldset>
<div class="cancel-buttons">
<input type="submit" value="yes, delete this repository" />
<span class="cancel-text"> or <a href=(repoURL r) class="cancel">cancel</a></span>
<br />
</div>
</fieldset>
</form>
</div>
fork :: User -> Repository -> String -> HSPage
fork u r n = repoBase u False r
"fork"
<span> -> fork</span>
<div class="repo-fork">
<h2>you already have a repository named "<a href=(userURL u ++ "/" ++ n)><% n %></a>"</h2>
<p class="blurb">please create an alternative name:</p>
<form action=(repoURL r ++ "/fork-as") method="post">
<fieldset>
<% field (input "name" (n ++ "-")) "new name" "" %>
<% submit "fork!" %>
</fieldset>
</form>
</div>
issues :: User -> Repository -> String -> [Issue] -> HSPage
issues u r t is s = repoBase u True r
t
<span> -> <% t %></span>
<div class="repo-issues">
<% issueLinks r %>
<%
if not (null is)
then
<ul class="issues-list">
<% map (renderIssue r) is %>
</ul>
else
<div class="no-issues">
<h2>no issues!</h2>
<p class="blurb">there don't seem to be any issues for this project.</p>
</div>
%>
</div>
s
issuesByTags :: User -> Repository -> [Issue] -> [[String]] -> HSPage
issuesByTags u r is ts s = repoBase u False r
("issues tagged with " ++ humanOr ts)
<span> -> issues</span>
<div class="repo-issues">
<% issueLinks r %>
<%
if not (null is)
then
<ul class="issues-list">
<h2>issues tagged with <% humanOr ts %></h2>
<% map (renderIssue r) is %>
</ul>
else
<div class="no-issues">
<h2>no issues tagged with <% humanOr ts %></h2>
<p class="blurb">there don't seem to be any issues with <% if length ts == 1 then "that tag" else "those tags" %>.</p>
</div>
%>
</div>
s
where
humanAnd [] = ""
humanAnd [t] = t
humanAnd [a, b] = a ++ " and " ++ b
humanAnd (x:ys) = x ++ ", " ++ humanAnd ys
humanOr [] = ""
humanOr [t] = humanAnd t
humanOr [a, b] = humanAnd a ++ " or " ++ humanAnd b
humanOr (x:ys) = humanAnd x ++ ", " ++ humanOr ys
issueLinks :: Repository -> HSP XML
issueLinks r =
<div>
<a href=(repoURL r ++ "/issues") class="open-issues button">open</a>
<a href=(repoURL r ++ "/issues/closed") class="closed-issues button">closed</a>
<a href=(repoURL r ++ "/issues/all") class="all-issues button">all</a>
<a href=(repoURL r ++ "/new-issue") class="new-issue button">new issue</a>
</div>
renderIssue :: Repository -> Issue -> HSP XML
renderIssue r i =
<li class="issue">
<table>
<tr>
<td class="number"><a href=(issueURL r i)>#<% show $ iNumber i %></a></td>
<td class="details">
<div class="name">
<a href=(issueURL r i)><% iSummary i %></a>
<% if not (null (iTags i))
then
<%
<ul class="tags">
<% map (\t -> <li><a href=(tagURL r t)><% t %></a></li>) (iTags i) %>
</ul>
%>
else <% "" %>
%>
</div>
<div class="meta">
reported by <% iOwner i %>
<% cdata " " %>
<span class="relatize date"><% formatTime defaultTimeLocale "%c" (iCreated i) %></span>
<% if not (iCreated i == iUpdated i)
then <% <span class="updated-date">, updated <span class="relatize date"><% formatTime defaultTimeLocale "%c" (iUpdated i) %></span></span> %>
else <% "" %>
%>
</div>
</td>
</tr>
</table>
</li>
issue :: User -> Repository -> Issue -> [Comment] -> HSPage
issue u r i cs s = repoBase u True r
("#" ++ show (iNumber i) ++ ": " ++ iSummary i)
<span> -> issue</span>
<div class="issue">
<h2>
<span class="number">
#<% show $ iNumber i %>
</span>
<% iSummary i %>
</h2>
<div class="description markdown">
<% do
mo <- getUser (iOwner i)
case mo of
Just o ->
<div class="user-info">
<a href=(userURL o)><img src=(gravatar o 64) /></a>
<a href=(userURL o)><% if not (null (uFullName o)) then uFullName o else uName o %></a>
</div>
Nothing ->
<div class="user-info unknown">unknown</div>
%>
<% cdata $ doMarkdown (iDescription i) %>
<div class="clear"></div>
</div>
<ul class="issue-comments">
<% map renderComment cs %>
</ul>
<%
case sUser s of
Just _ ->
<div class="issue-revise">
<div class="issue-tags">
{-
<label for="assign">assign to:</label>
<select id="assign">
<option value=""></option>
<option value=(rOwner r)><% rOwner r %></option>
<% map (\m -> <option value=m><% m %></option>) (rMembers r) %>
</select>
<label for="type">set type:</label>
<select id="type">
<option value=""></option>
<option value="bug">bug</option>
<option value="enhancement">enhancement</option>
</select>
-}
<ul class="tags">
<% map (\t -> <li><a href="javascript:void(0)" class="kill"></a><a href=(tagURL r t)><% t %></a></li>) (iTags i) %>
</ul>
<form id="add-tag" action="javascript:void(0)">
<input type="text" id="tag-name" name="add-tag" placeholder="tag:value" />
<input type="submit" id="add-tag-submit" maxlength="1000" value="add" />
</form>
</div>
<form class="issue-comment" action=add method="post">
<fieldset>
<div class="field">
<textarea name="comment" id="comment" rows="12"></textarea>
</div>
<h3>revise issue</h3>
<div class="revise-fields">
<div class="field">
<textarea name="summary" id="summary" rows="2"><% iSummary i %></textarea>
</div>
<div class="field">
<textarea name="description" id="description" rows="12"><% iDescription i %></textarea>
</div>
</div>
<div class="buttons">
<input type="submit" name="submit" id="submit-comment" value="comment" />
<input type="submit" name="submit" id="submit-close" value=(if iIsClosed i then "and reopen" else "and close") />
</div>
<input type="hidden" name="tags" id="tags" />
</fieldset>
</form>
</div>
Nothing ->
<span class="please-login">
please <a href=(baseUrl ++ "login")>log in</a> to comment
</span>
%>
</div>
s
where
add = issueURL r i ++ "/comment"
renderComment c =
<li class="comment">
<% do
ma <- getUser (cAuthor c)
case ma of
Just a ->
<div class="user-info">
<a href=(userURL a)><img src=(gravatar a 24) /></a>
<a href=(userURL a) class="name"><% if not (null (uFullName a)) then uFullName a else uName a %></a>
</div>
Nothing ->
<div class="user-info unknown">unknown</div>
%>
<%
if not (null (cChanges c))
then
<%
<ul class="changes">
<% map renderChange (cChanges c) %>
</ul>
%>
else <% "" %>
%>
<div class="markdown">
<% cdata (doMarkdown (cBody c)) %>
</div>
</li>
renderChange (AddTag t) =
<li>added tag <strong><% t %></strong></li>
renderChange (RemoveTag t) =
<li>removed tag <strong><% t %></strong></li>
renderChange (Summary _ t) =
<li>summary changed to <strong>"<% t %>"</strong></li>
renderChange (Description _ _) =
<li>description updated</li>
renderChange (Closed True) =
<li>status set to <strong>closed</strong></li>
renderChange (Closed False) =
<li>status set to <strong>open</strong></li>
newIssue :: User -> Repository -> HSPage
newIssue u r = repoBase u False r
"new issue"
<span> -> new issue</span>
<div class="issue-new">
<h2>new issue</h2>
<div class="issue-tags">
{- disable hard-coded assignment & issue type fields, don't want to encourage enhancement issues right now
<label for="assign">assign to:</label>
<select id="assign">
<option value=""></option>
<option value=(rOwner r)><% rOwner r %></option>
<% map (\m -> <option value=m><% m %></option>) (rMembers r) %>
</select>
<label for="type">set type:</label>
<select id="type">
<option value=""></option>
<option value="bug">bug</option>
<option value="enhancement">enhancement</option>
</select>
-}
<ul class="tags">
</ul>
<form id="add-tag" action="javascript:void(0)">
<input type="text" id="tag-name" name="add-tag" placeholder="tag:value" />
<input type="submit" id="add-tag-submit" maxlength="1000" value="add" />
</form>
</div>
<form class="issue-body" action=(repoURL r ++ "/new-issue") method="post">
<fieldset>
<div class="field">
<textarea name="summary" id="summary" rows="2"></textarea>
</div>
<div class="field">
<textarea name="description" id="description" rows="12"></textarea>
</div>
<div class="buttons">
<input type="submit" name="submit" value="create issue" />
</div>
<input type="hidden" name="tags" id="tags" />
</fieldset>
</form>
</div>
patches :: User
-> Repository
-> [Fork] -- ^public forks
-> [Fork] -- ^private forks owned by the current user
-> HSPage
patches u r fs opfs s = repoBase u True r
"branches"
<span> -> branches</span>
<div class="repo-patches">
<% patchesForm %>
</div>
s
where
mergeablepatchesexist = any (not . null . fPatches) $ fs ++ opfs
canmerge = canMerge (sUser s) r
patchesForm :: HSP XML
patchesForm =
<form action=(repoURL r ++ "/merge") class="dependencies" method="post">
<fieldset>
<% map fork' opfs %>
<% map fork' fs %>
<%
if mergeablepatchesexist && canmerge
then
<%
<div class="merge-button">
<br />
<% submit "merge selected" %>
</div>
%>
else <% "" %>
%>
</fieldset>
<%
if mergeablepatchesexist
then <% "" %>
else <%
<div class="no-patches">
<p class="blurb">There doesn't seem to be anything new.</p>
</div>
%>
%>
</form>
fork' (Fork f cs) =
<%
<div class="fork">
<h3><a href=(repoURL f)><% rOwner f %>'s <% rName f %></a></h3>
<table class="fork-log">
<% map (change' f) cs %>
</table>
</div>
%>
change' :: Repository -> PatchLog -> HSP XML
change' f p =
<tr id=("change-" ++ pID p) class=("change" ++ concatMap (" depends-on-" ++) (pDepends p))>
<%
if canmerge
then
<%
<td class="merge">
<input type="checkbox" name=("merge:" ++ show (fromJust (rID f)) ++ ":" ++ pID p) />
</td>
%>
else <% "" %>
%>
<td class="name">
<p><a href=(repoURL f ++ "/patch/" ++ pID p)><% pName p %></a></p>
</td>
<td class="author">
<% author p %>
</td>
<td class="date">
<span class="relatize date"><% formatTime defaultTimeLocale "%c" (pDate p) %></span>
</td>
</tr>
changes :: User -> Repository -> [PatchLog] -> Int -> Int -> HSPage
changes u r cs p tp = repoBase u True r
"changes"
<span> -> changes</span>
<div class="repo-changes">
<% paginate (repoURL r ++ "/changes") p tp %>
<table class="repo-log">
<% map (change r) cs %>
</table>
<% paginate (repoURL r ++ "/changes") p tp %>
</div>
change :: Repository -> PatchLog -> HSP XML
change f p =
<tr id=("change-" ++ pID p) class=("change" ++ concatMap (" depends-on-" ++) (pDepends p))>
-- <%
-- if canmerge
-- then
-- <%
-- <td class="merge">
-- <input type="checkbox" name=("merge:" ++ show (fromJust (rID f)) ++ ":" ++ pID p) />
-- </td>
-- %>
-- else <% "" %>
-- %>
<td class="name-note">
<p><a class="name" href=(repoURL f ++ "/patch/" ++ pID p)><% pName p %></a></p>
<%
if not (null (pLog p))
then
<%
<div class="patch-notes markdown">
<% cdata (pLog p) %>
</div>
%>
else <% "" %>
%>
</td>
<td class="author">
<% author p %>
</td>
<td class="date">
<span class="relatize date"><% formatTime defaultTimeLocale "%c" (pDate p) %></span>
</td>
</tr>
author :: PatchLog -> HSP XML
author p | pIsUser p = <a href=(baseUrl ++ pAuthor p)><% pAuthor p %></a>
| otherwise = <span class="author"><% pAuthor p %></span>
changesAtom :: User -> Repository -> [PatchLog] -> HSPage
changesAtom u r cs _ =
<feed xmlns="http://www.w3.org/2005/Atom">
<title><% uName u %>/<% rName r %> changes</title>
<id><% repoURL r ++ "/changes/atom" %></id>
<%
if not (null cs)
then
<%
<updated><% asAtomDate latest %></updated>
%>
else <% "" %>
%>
<author>
<name><% uName u %></name>
<uri><% userURL u %></uri>
</author>
<link href=(repoURL r ++ "/changes/atom") rel="self" />
<link href=(repoURL r ++ "/changes") />
<% map entry cs %>
</feed>
where
asAtomDate :: UTCTime -> String
asAtomDate = formatTime defaultTimeLocale "%FT%TZ"
latest :: UTCTime
latest = head . sortBy (flip compare) . map pDate $ cs
entry :: PatchLog -> HSP XML
entry p =
<entry>
<title><% pName p %></title>
<id><% repoURL r ++ "/patch/" ++ pID p %></id>
<updated><% asAtomDate (pDate p) %></updated>
<author>
<name><% pAuthor p %></name>
<%
if pIsUser p
then <% <uri><% baseUrl ++ pAuthor p %></uri> %>
else <% "" %>
%>
</author>
<summary>
<% pName p %>
</summary>
<link href=(repoURL r ++ "/patch/" ++ pID p) />
</entry>
blob :: User -> Repository -> [RepoItem] -> Maybe (Either String BS.ByteString) -> HSPage
blob u r fs b s = repoBase' u False r
(iName file)
<span> -> files</span>
<div class="repo-blob">
<h2 class="path">
<a href=(repoURL r ++ "/browse")>root</a>
<% map (\f -> <% <span class="path-item"> / <a href=(repoURL r ++ "/browse" ++ iPath f)><% iName f %></a></span> %>) (Prelude.init fs) %>
<span class="path-item"> / <a href=(repoURL r ++ "/raw" ++ iPath file)><% iName file %></a></span>
</h2>
<%
case b of
Nothing ->
<p class="blurb">sorry! this file is too gigantic to display. click the filename above to view the source.</p>
Just (Left md) ->
<div class="markdown">
<% cdata md %>
</div>
Just (Right source) ->
<div class="code">
<% cdata . fromBS $ source %>
</div>
%>
</div>
lns
s
where
file :: RepoItem
file = last fs
member = case sUser s of
Just un -> (un `elem` rOwner r:rMembers r)
Nothing -> False
lns = if member
then links' r [<li class="edit"><a href=(repoURL r ++ "/edit-file" ++ iPath file)>edit file</a></li>]
else links' r []
addFile :: User -> Repository -> [RepoItem] -> HSPage
addFile u r fs = repoBase u False r
file
<span> -> add file/directory </span>
<div class="repo-blob">
<h2 class="path">
<a href=(repoURL r ++ "/browse")>root</a>
<% map (\f -> <% <span class="path-item"> / <a href=(repoURL r ++ "/browse" ++ iPath f)><% iName f %></a></span> %>) fs %>
</h2>
<%
<form class="addfile" action=(repoURL r ++ "/add-file") method="post">
<fieldset>
<input type="hidden" name="filepath" id="filepath" value=file></input>
<% field (input "filename" "") "File Name" "" %>
<% field ft_opts "File type" "" %>
<% field (input "message" "") "Message" "" %>
<% submit "Create file/directory" %>
</fieldset>
</form>
%>
</div>
where
file = if null fs then "" else tail $ iPath $ last $ fs
ft_opts = <div class="choices">
<input type="radio" name="type" id="type" value="file" /> file <br />
<input type="radio" name="type" id="type" value="directory" /> directory <br />
</div>
editFile :: User -> Repository -> [RepoItem] -> String -> String -> HSPage
editFile u r fs mime contents = repoBase u False r
(iName file)
<span> -> edit file</span>
<div class="repo-blob">
<h2 class="path">
<a href=(repoURL r ++ "/browse")>root</a>
<% map (\f -> <% <span class="path-item"> / <a href=(repoURL r ++ "/browse" ++ iPath f)><% iName f %></a></span> %>) (Prelude.init fs) %>
<span class="path-item"> / <a href=(repoURL r ++ "/raw" ++ iPath file)><% iName file %></a></span>
</h2>
<%
<form class="editfile" action=(repoURL r ++ "/edit-file" ++ iPath file) method="post">
<fieldset>
<textarea name="editor" id="editor"><% pcdata contents %></textarea><br />
<% field (input "message" "") "Message" "" %>
<% submit "Update code" %>
</fieldset>
</form>
%>
<script> load_editor(<% show $ mime %>) </script>
</div>
where
file :: RepoItem
file = last fs
explore :: [(Repository, [Repository])] -> Int -> Int -> HSPage
explore rs p tp = base
"all repos"
True
<span>all repos</span>
<div></div>
<div class="explore">
<h2>all repositories</h2>
<% paginate (baseUrl ++ "explore") p tp %>
<ul class="repo-list">
<% map repo' rs %>
</ul>
<% paginate (baseUrl ++ "explore") p tp %>
</div>
where
repo' :: (Repository, [Repository]) -> HSP XML
repo' (r, fs) =
<li>
<div class="repo-name-owner">
<a class="name" href=(repoURL r)><% rName r %></a> :: <a href=(repoOwnerURL r)><% rOwner r %></a>
</div>
<p class="repo-desc">
<% rDescription r %>
</p>
<%
if length fs > 0
then
<%
<div class="repo-forks-wrap">
<p><a href=(repoURL r ++ "/patches")>forks</a>:</p>
<ul class="repo-forks">
<% map (\f -> <% <li><a href=(repoURL f)><% rOwner f %>'s <span class="name"><% rName f %></span></a></li> %>) fs %>
</ul>
<div class="clear"></div>
</div>
%>
else <% "" %>
%>
</li>
patch :: User -> Repository -> String -> HSPage
patch u r pId =
repoBase u False r
"patch"
<span> -> patch</span>
<div class="repo-patch">
<p>Fetching patch details... <img src="/public/images/spinner.gif" style="vertical-align:middle;" /></p>
<script type="text/javascript">
$(document).ready(function() {
$('div.repo-patch').load(
'<% rpurl %>',
function(response, status, xhr) {
if (status == "error") {
var msg = "Sorry, fetching this patch timed out (or there was some other error)."; // + xhr.status + " " + xhr.statusText
$('div.repo-patch').html(msg);
}
});
});
</script>
</div>
where
rpurl = repoURL r ++ "/renderedpatch/" ++ pId
renderedpatchHtml :: User -> Repository -> PatchLog -> [Summary] -> [PatchChange]-> HSPage
renderedpatchHtml _ r p ss cs _ = do
<div>
<h2>patch</h2>
<ul class="repo-log">
<% change r p %>
</ul>
<%
if not (null ss)
then <% summaries ss %>
else <% "" %>
%>
<%
if not (null cs)
then <% diffs cs %>
else <% "" %>
%>
</div>
where
summaries :: [Summary] -> HSP XML
summaries ss' =
<div class="summary">
<h3>summary</h3>
<ul class="patch-summary">
<% map summary ss' %>
</ul>
</div>
summary :: Summary -> HSP XML
summary (Removed n) =
<li class="summary-removed"><% n %></li>
summary (Added n) =
<li class="summary-added">
<a href=(repoURL r ++ "/browse/" ++ n)><% n %></a>
</li>
summary (Replaced n f t) =
<li class="summary-replaced">
<a href=(repoURL r ++ "/browse/" ++ n)><% n %></a>
replaced <code><% f %></code> with <code><% t %></code>
</li>
summary (Modified f) =
<li class="summary-modified">
<a href=("#" ++ f)><% f %></a>
</li>
summary (Preference n f t) =
<li class="summary-preference">
changed "<% n %>" preference
from "<% f %>"
to "<% t %>"
</li>
diffs :: [PatchChange] -> HSP XML
diffs cs' =
<div class="patch-diffs">
<h3>changes</h3>
<ul class="patch-changes">
<% map diff displayablecs %>
<% if numelided > 0
then <% <li><% "(and " ++ show numelided ++ " more hunks...)" %></li> %>
else <% "" %>
%>
</ul>
</div>
where
(displayablecs, numelided) = takeUpTo maxPatchDisplaySize cs'
takeUpTo :: Int -> [PatchChange] -> ([PatchChange],Int)
takeUpTo m ps = (reverse ds, length es) where (ds, es) = takeUpTo' m [] ps
-- XXX likely inefficient
takeUpTo' :: Int -> [PatchChange] -> [PatchChange] -> ([PatchChange],[PatchChange])
takeUpTo' _ ds [] = (ds, [])
takeUpTo' m ds (e:es)
| size > m = (ds, (e:es))
| otherwise = (takeUpTo' m ds' es)
where
size = sum $ map hunkSize ds'
ds' = e:ds
hunkSize :: PatchChange -> Int
hunkSize (FileChange{cfType=FileHunk{..}}) = BS.length fchRemove + BS.length fchAdd
hunkSize _ = 0
diff :: PatchChange -> HSP XML
diff c =
<li id=(cfName c) class="diff">
<a class="name" href=(repoURL r ++ "/browse/" ++ cfName c)><% cfName c %></a>
<% cdata " :: " %>
<span class="line">line <% show (fchLine (cfType c)) %></span>
<div class="removed"><% cdata . fromBS $ fchRemove (cfType c) %></div>
<div class="added"><% cdata . fromBS $ fchAdd (cfType c) %></div>
</li>
gravatar :: User -> Int -> String
gravatar u s =
"http://gravatar.com/avatar/" ++ email ++ "?s=" ++ show s ++ "&d=identicon"
where
email = show . md5 . toLBS $ uEmail u
tagURL :: Repository -> String -> String
tagURL r t = repoURL r ++ "/issues/tag/" ++ t