UI: Re-enable ticket page, some pieces still missing, mostly buttons

This commit is contained in:
fr33domlover 2022-09-17 17:42:04 +00:00
parent e69d775f3f
commit 1db56ced39
7 changed files with 139 additions and 117 deletions

View file

@ -27,6 +27,8 @@ module Vervis.Handler.Person
, postPersonFollowR , postPersonFollowR
, postPersonUnfollowR , postPersonUnfollowR
, postReplyR
) )
where where
@ -417,3 +419,6 @@ postPersonFollowR _ = error "Temporarily disabled"
postPersonUnfollowR :: KeyHashid Person -> Handler () postPersonUnfollowR :: KeyHashid Person -> Handler ()
postPersonUnfollowR _ = error "Temporarily disabled" postPersonUnfollowR _ = error "Temporarily disabled"
postReplyR :: KeyHashid Message -> Handler ()
postReplyR _ = error "Temporarily disabled"

View file

@ -24,6 +24,10 @@ module Vervis.Handler.Ticket
, getTicketDepR , getTicketDepR
, postTicketFollowR
, postTicketUnfollowR
, postTicketReplyR
@ -99,6 +103,7 @@ import Text.HTML.SanitizeXSS
import Yesod.Auth (requireAuthId, maybeAuthId) import Yesod.Auth (requireAuthId, maybeAuthId)
import Yesod.Core hiding (logWarn) import Yesod.Core hiding (logWarn)
import Yesod.Core.Handler import Yesod.Core.Handler
import Yesod.Core.Widget
import Yesod.Form.Functions (runFormGet, runFormPost) import Yesod.Form.Functions (runFormGet, runFormPost)
import Yesod.Form.Types (FormResult (..)) import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404) import Yesod.Persist.Core (runDB, get404, getBy404)
@ -136,7 +141,6 @@ import Vervis.Data.Actor
import Vervis.Discussion import Vervis.Discussion
import Vervis.FedURI import Vervis.FedURI
import Vervis.Foundation import Vervis.Foundation
import Vervis.Handler.Discussion
--import Vervis.GraphProxy (ticketDepGraph) --import Vervis.GraphProxy (ticketDepGraph)
import Vervis.Model import Vervis.Model
import Vervis.Model.Ident import Vervis.Model.Ident
@ -151,6 +155,9 @@ import Vervis.Ticket
import Vervis.TicketFilter (filterTickets) import Vervis.TicketFilter (filterTickets)
import Vervis.Time (showDate) import Vervis.Time (showDate)
import Vervis.Web.Actor import Vervis.Web.Actor
import Vervis.Web.Discussion
import Vervis.Widget.Discussion
import Vervis.Widget.Person
getTicketR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent getTicketR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketR deckHash ticketHash = do getTicketR deckHash ticketHash = do
@ -237,47 +244,51 @@ getTicketR deckHash ticketHash = do
, AP.ticketAttachment = Nothing , AP.ticketAttachment = Nothing
} }
provideHtmlAndAP' authorHost ticketAP $ redirectToPrettyJSON here provideHtmlAndAP' authorHost ticketAP getTicketHtml
where where
here = TicketR deckHash ticketHash getTicketHtml = do
mpid <- maybeAuthId
{- (ticket, author, tparams, eparams, cparams) <- handlerToWidget $ runDB $ do
mpid <- maybeAuthId (_deck, _ticketdeck, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr) <-
( wshr, wfl, getTicket404 deckHash ticketHash
author, massignee, mresolved, ticket, lticket, tparams, eparams, cparams) <- (ticket,,,,)
runDB $ do <$> bitraverse
(Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _etcl, _etpl, author, resolved) <- getProjectTicket404 shar proj ltkhid (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
tparams <- getTicketTextParams tid wid p <- getJust personID
eparams <- getTicketEnumParams tid wid (Entity personID p,) <$> getJust (personActor p)
cparams <- getTicketClasses tid wid )
return (\ (Entity _ (TicketAuthorRemote _ remoteActorID _)) -> do
( wshr, wfl ra <- getJust remoteActorID
, author', massignee, mresolved, ticket, lticket ro <- getJust $ remoteActorIdent ra
, tparams, eparams, cparams i <- getJust $ remoteObjectInstance ro
) return (i, ro, ra)
let desc :: Widget )
desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket author
discuss = <*> getTicketTextParams ticketID --wid
discussionW <*> getTicketEnumParams ticketID --wid
(return $ localTicketDiscuss lticket) <*> getTicketClasses ticketID --wid
(ProjectTicketTopReplyR shar proj ltkhid) hashMessageKey <- handlerToWidget getEncodeKeyHashid
(ProjectTicketReplyR shar proj ltkhid . encodeHid) let desc :: Widget
cRelevant <- newIdent desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket
cIrrelevant <- newIdent discuss =
let relevant filt = discussionW
bool cIrrelevant cRelevant $ (return $ ticketDiscuss ticket)
case ticketStatus ticket of (TicketReplyR deckHash ticketHash)
TSNew -> wffNew filt (ReplyR . hashMessageKey)
TSTodo -> wffTodo filt cRelevant <- newIdent
TSClosed -> wffClosed filt cIrrelevant <- newIdent
provideHtmlAndAP' host ticketAP $ let relevant filt =
bool cIrrelevant cRelevant $
case ticketStatus ticket of
TSNew -> wffNew filt
TSTodo -> wffTodo filt
TSClosed -> wffClosed filt
let followButton = let followButton =
followW followW
(ProjectTicketFollowR shar proj ltkhid) (TicketFollowR deckHash ticketHash)
(ProjectTicketUnfollowR shar proj ltkhid) (TicketUnfollowR deckHash ticketHash)
(return $ localTicketFollowers lticket) (ticketFollowers ticket)
in $(widgetFile "ticket/one") $(widgetFile "ticket/one")
-}
getTicketDiscussionR getTicketDiscussionR
:: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
@ -408,6 +419,29 @@ getTicketDepR _ _ _ = do
tdc tdc
-} -}
postTicketFollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
postTicketFollowR _ = error "Temporarily disabled"
postTicketUnfollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
postTicketUnfollowR _ = error "Temporarily disabled"
postTicketReplyR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler Html
postTicketReplyR _ _ = error "Temporarily disabled"
{-
hLocal <- getsYesod $ appInstanceHost . appSettings
postTopReply
hLocal
[ProjectR shr prj]
[ ProjectFollowersR shr prj
, ProjectTicketParticipantsR shr prj ltkhid
, ProjectTicketTeamR shr prj ltkhid
]
(ProjectTicketR shr prj ltkhid)
(ProjectR shr prj)
(ProjectTicketDiscussionR shr prj ltkhid)
(const $ ProjectTicketR shr prj ltkhid)
-}
@ -774,22 +808,6 @@ selectDiscussionId shr prj ltkhid = do
(_es, _ej, _et, Entity _ lticket, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid (_es, _ej, _et, Entity _ lticket, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
return $ localTicketDiscuss lticket return $ localTicketDiscuss lticket
postProjectTicketDiscussionR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketDiscussionR shr prj ltkhid = do
hLocal <- getsYesod $ appInstanceHost . appSettings
postTopReply
hLocal
[ProjectR shr prj]
[ ProjectFollowersR shr prj
, ProjectTicketParticipantsR shr prj ltkhid
, ProjectTicketTeamR shr prj ltkhid
]
(ProjectTicketR shr prj ltkhid)
(ProjectR shr prj)
(ProjectTicketDiscussionR shr prj ltkhid)
(const $ ProjectTicketR shr prj ltkhid)
getMessageR :: ShrIdent -> KeyHashid LocalMessage -> Handler TypedContent getMessageR :: ShrIdent -> KeyHashid LocalMessage -> Handler TypedContent
getMessageR shr hid = do getMessageR shr hid = do
lmid <- decodeKeyHashid404 hid lmid <- decodeKeyHashid404 hid

View file

@ -18,7 +18,7 @@ module Vervis.Ticket
( (
getTicketSummaries getTicketSummaries
--, getTicketDepEdges --, getTicketDepEdges
{-
, WorkflowFieldFilter (..) , WorkflowFieldFilter (..)
, WorkflowFieldSummary (..) , WorkflowFieldSummary (..)
, TicketTextParamValue (..) , TicketTextParamValue (..)
@ -30,7 +30,7 @@ module Vervis.Ticket
, getTicketEnumParams , getTicketEnumParams
, TicketClassParam (..) , TicketClassParam (..)
, getTicketClasses , getTicketClasses
-}
, getTicket , getTicket
, getTicket404 , getTicket404
@ -165,7 +165,6 @@ getTicketSummaries mfilt morder offlim deckID = do
, tsComments = r , tsComments = r
} }
{-
-- | Get the child-parent ticket number pairs of all the ticket dependencies -- | Get the child-parent ticket number pairs of all the ticket dependencies
-- in the given project, in ascending order by child, and then ascending order -- in the given project, in ascending order by child, and then ascending order
-- by parent. -- by parent.
@ -265,14 +264,14 @@ toTParam
_ -> error "Impossible" _ -> error "Impossible"
} }
getTicketTextParams :: TicketId -> WorkflowId -> AppDB [TicketTextParam] getTicketTextParams :: TicketId {--> WorkflowId-} -> AppDB [TicketTextParam]
getTicketTextParams tid wid = fmap (map toTParam) $ getTicketTextParams tid {-wid-} = fmap (map toTParam) $
E.select $ E.from $ \ (p `E.RightOuterJoin` f) -> do E.select $ E.from $ \ (p `E.RightOuterJoin` f) -> do
E.on $ E.on $
p E.?. TicketParamTextField E.==. E.just (f E.^. WorkflowFieldId) E.&&. p E.?. TicketParamTextField E.==. E.just (f E.^. WorkflowFieldId) E.&&.
p E.?. TicketParamTextTicket E.==. E.just (E.val tid) p E.?. TicketParamTextTicket E.==. E.just (E.val tid)
E.where_ $ E.where_ $
f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. --f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&.
f E.^. WorkflowFieldType E.==. E.val WFTText E.&&. f E.^. WorkflowFieldType E.==. E.val WFTText E.&&.
E.isNothing (f E.^. WorkflowFieldEnm) E.isNothing (f E.^. WorkflowFieldEnm)
return return
@ -365,14 +364,14 @@ toEParam
_ -> error "Impossible" _ -> error "Impossible"
} }
getTicketEnumParams :: TicketId -> WorkflowId -> AppDB [TicketEnumParam] getTicketEnumParams :: TicketId {--> WorkflowId-} -> AppDB [TicketEnumParam]
getTicketEnumParams tid wid = fmap (map toEParam) $ getTicketEnumParams tid {-wid-} = fmap (map toEParam) $
E.select $ E.from $ \ (p `E.InnerJoin` c `E.RightOuterJoin` f `E.InnerJoin` e) -> do E.select $ E.from $ \ (p `E.InnerJoin` c `E.RightOuterJoin` f `E.InnerJoin` e) -> do
E.on $ E.on $
e E.^. WorkflowEnumWorkflow E.==. E.val wid E.&&. --e E.^. WorkflowEnumWorkflow E.==. E.val wid E.&&.
f E.^. WorkflowFieldEnm E.==. E.just (e E.^. WorkflowEnumId) f E.^. WorkflowFieldEnm E.==. E.just (e E.^. WorkflowEnumId)
E.on $ E.on $
f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. --f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&.
f E.^. WorkflowFieldType E.==. E.val WFTEnum E.&&. f E.^. WorkflowFieldType E.==. E.val WFTEnum E.&&.
p E.?. TicketParamEnumField E.==. E.just (f E.^. WorkflowFieldId) E.&&. p E.?. TicketParamEnumField E.==. E.just (f E.^. WorkflowFieldId) E.&&.
c E.?. WorkflowEnumCtorEnum E.==. f E.^. WorkflowFieldEnm c E.?. WorkflowEnumCtorEnum E.==. f E.^. WorkflowFieldEnm
@ -438,14 +437,14 @@ toCParam
, tcpValue = mp , tcpValue = mp
} }
getTicketClasses :: TicketId -> WorkflowId -> AppDB [TicketClassParam] getTicketClasses :: TicketId {--> WorkflowId-} -> AppDB [TicketClassParam]
getTicketClasses tid wid = fmap (map toCParam) $ getTicketClasses tid {-wid-} = fmap (map toCParam) $
E.select $ E.from $ \ (p `E.RightOuterJoin` f) -> do E.select $ E.from $ \ (p `E.RightOuterJoin` f) -> do
E.on $ E.on $
p E.?. TicketParamClassField E.==. E.just (f E.^. WorkflowFieldId) E.&&. p E.?. TicketParamClassField E.==. E.just (f E.^. WorkflowFieldId) E.&&.
p E.?. TicketParamClassTicket E.==. E.just (E.val tid) p E.?. TicketParamClassTicket E.==. E.just (E.val tid)
E.where_ $ E.where_ $
f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. --f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&.
f E.^. WorkflowFieldType E.==. E.val WFTClass E.&&. f E.^. WorkflowFieldType E.==. E.val WFTClass E.&&.
E.isNothing (f E.^. WorkflowFieldEnm) E.isNothing (f E.^. WorkflowFieldEnm)
return return
@ -459,7 +458,6 @@ getTicketClasses tid wid = fmap (map toCParam) $
, f E.^. WorkflowFieldFilterClosed , f E.^. WorkflowFieldFilterClosed
, p E.?. TicketParamClassId , p E.?. TicketParamClassId
) )
-}
getTicket getTicket
:: MonadIO m :: MonadIO m

View file

@ -13,7 +13,7 @@
- <http://creativecommons.org/publicdomain/zero/1.0/>. - <http://creativecommons.org/publicdomain/zero/1.0/>.
-} -}
module Vervis.Handler.Discussion module Vervis.Web.Discussion
( getDiscussion ( getDiscussion
--, getTopReply --, getTopReply
--, postTopReply --, postTopReply

View file

@ -1,6 +1,7 @@
$# This file is part of Vervis. $# This file is part of Vervis.
$# $#
$# Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>. $# Written in 2016, 2018, 2019, 2020, 2022
$# by fr33domlover <fr33domlover@riseup.net>.
$# $#
$# ♡ Copying is an act of love. Please copy, reuse and share. $# ♡ Copying is an act of love. Please copy, reuse and share.
$# $#
@ -16,53 +17,51 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<div> <div>
Created on #{showDate $ ticketCreated ticket} by Created on #{showDate $ ticketCreated ticket} by
^{sharerLinkFedW author} ^{personLinkFedW author}
<div> <div>
<span> <span>
<a href=@{ProjectTicketParticipantsR shar proj ltkhid}> <a href=@{TicketFollowersR deckHash ticketHash}>
[🐤 Followers] [🐤 Followers]
<span> <span>
<a href=@{ProjectTicketDepsR shar proj ltkhid}> <a href=@{TicketDepsR deckHash ticketHash}>
[⤴ Dependencies] [⤴ Dependencies]
<span> <span>
<a href=@{ProjectTicketReverseDepsR shar proj ltkhid}> <a href=@{TicketReverseDepsR deckHash ticketHash}>
[⤷ Dependants] [⤷ Dependants]
<span> <span>
<a href=@{ClaimRequestsTicketR shar proj ltkhid}>
[✋ Claim requests] [✋ Claim requests]
<span> <span>
<a href=@{ProjectTicketEditR shar proj ltkhid}>
[✏ Edit] [✏ Edit]
^{followButton} ^{followButton}
<div>^{desc} <div>^{desc}
$if ticketStatus ticket /= TSClosed $# $if ticketStatus ticket /= TSClosed
<p> $# <p>
$maybe (assignee, me) <- massignee $# $maybe (assignee, me) <- massignee
$if me $# $if me
Assigned to you. $# Assigned to you.
$#
^{buttonW POST "Unclaim this ticket" (ProjectTicketUnclaimR shar proj ltkhid)} $# ^{buttonW POST "Unclaim this ticket" (ProjectTicketUnclaimR deckHash ticketHash)}
$else $# $else
Assigned to ^{sharerLinkW assignee}. $# Assigned to ^{sharerLinkW assignee}.
$#
^{buttonW POST "Unassign this ticket" (ProjectTicketUnassignR shar proj ltkhid)} $# ^{buttonW POST "Unassign this ticket" (ProjectTicketUnassignR deckHash ticketHash)}
$nothing $# $nothing
Not assigned. $# Not assigned.
$#
<a href=@{ClaimRequestNewR shar proj ltkhid}>Ask to have it assigned to you $# <a href=@{ClaimRequestNewR deckHash ticketHash}>Ask to have it assigned to you
$#
or $# or
$#
^{buttonW POST "Claim this ticket" (ProjectTicketClaimR shar proj ltkhid)} $# ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR deckHash ticketHash)}
$#
or $# or
$#
<a href=@{ProjectTicketAssignR shar proj ltkhid}>Assign to someone else $# <a href=@{ProjectTicketAssignR deckHash ticketHash}>Assign to someone else
. $# .
<p> <p>
Status: # Status: #
@ -70,16 +69,16 @@ $if ticketStatus ticket /= TSClosed
$of TSNew $of TSNew
Open, new. Open, new.
^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR shar proj ltkhid)} $# ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR deckHash ticketHash)}
^{buttonW POST "Close this ticket" (ProjectTicketCloseR shar proj ltkhid)} $# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)}
$of TSTodo $of TSTodo
Open, to do. Open, to do.
^{buttonW POST "Close this ticket" (ProjectTicketCloseR shar proj ltkhid)} $# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)}
$of TSClosed $of TSClosed
Closed on ___ by ___. Closed on ___ by ___.
^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR shar proj ltkhid)} $# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}
<h3>Custom fields <h3>Custom fields
@ -87,7 +86,7 @@ $if ticketStatus ticket /= TSClosed
<ul> <ul>
$forall TicketTextParam field mvalue <- tparams $forall TicketTextParam field mvalue <- tparams
<li .#{relevant $ wfsFilter field}> <li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}> $# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field} #{wfsName field}
: :
$maybe value <- mvalue $maybe value <- mvalue
@ -99,11 +98,11 @@ $if ticketStatus ticket /= TSClosed
(none) (none)
$forall TicketEnumParam field enum mvalue <- eparams $forall TicketEnumParam field enum mvalue <- eparams
<li .#{relevant $ wfsFilter field}> <li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}> $# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field} #{wfsName field}
: :
$maybe value <- mvalue $maybe value <- mvalue
<a href=@{WorkflowEnumCtorsR wshr wfl $ wesIdent enum}> $# <a href=@{WorkflowEnumCtorsR wshr wfl $ wesIdent enum}>
#{tepvName value} #{tepvName value}
$nothing $nothing
$if wfsRequired field $if wfsRequired field
@ -112,16 +111,16 @@ $if ticketStatus ticket /= TSClosed
(none) (none)
$forall TicketClassParam field mvalue <- cparams $forall TicketClassParam field mvalue <- cparams
<li .#{relevant $ wfsFilter field}> <li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}> $# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field} #{wfsName field}
: :
$maybe _tpcid <- mvalue $maybe _tpcid <- mvalue
Yes Yes
$nothing $nothing
No No
<p> $# <p>
^{buttonW DELETE "Delete this ticket" (ProjectTicketR shar proj ltkhid)} $# ^{buttonW DELETE "Delete this ticket" (ProjectTicketR deckHash ticketHash)}
<h3>Discussion <h3>Discussion

View file

@ -146,6 +146,8 @@
/people/#PersonKeyHashid/follow PersonFollowR POST /people/#PersonKeyHashid/follow PersonFollowR POST
/people/#PersonKeyHashid/unfollow PersonUnfollowR POST /people/#PersonKeyHashid/unfollow PersonUnfollowR POST
/reply/#MessageKeyHashid ReplyR POST
---- Group ------------------------------------------------------------------ ---- Group ------------------------------------------------------------------
/groups/#GroupKeyHashid GroupR GET /groups/#GroupKeyHashid GroupR GET
@ -218,9 +220,9 @@
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unclaim TicketUnclaimR POST -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unclaim TicketUnclaimR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/assign TicketAssignR GET POST -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/assign TicketAssignR GET POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unassign TicketUnassignR POST -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unassign TicketUnassignR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/follow TicketFollowR POST /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/follow TicketFollowR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unfollow TicketUnfollowR POST /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unfollow TicketUnfollowR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/reply TicketTopReplyR GET POST /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/reply TicketReplyR POST
---- Ticket Dependency ------------------------------------------------------- ---- Ticket Dependency -------------------------------------------------------

View file

@ -176,7 +176,6 @@ library
Vervis.Handler.Cloth Vervis.Handler.Cloth
Vervis.Handler.Common Vervis.Handler.Common
Vervis.Handler.Deck Vervis.Handler.Deck
Vervis.Handler.Discussion
-- Vervis.Handler.Git -- Vervis.Handler.Git
Vervis.Handler.Group Vervis.Handler.Group
--Vervis.Handler.Inbox --Vervis.Handler.Inbox
@ -227,6 +226,7 @@ library
Vervis.Web.Actor Vervis.Web.Actor
Vervis.Web.Darcs Vervis.Web.Darcs
Vervis.Web.Discussion
Vervis.Web.Git Vervis.Web.Git
Vervis.Web.Repo Vervis.Web.Repo