UI: Project: Component list HTML version
This commit is contained in:
Pere Lev
parent
5d52db9377
commit
acc1d13c63
4 changed files with 221 additions and 35 deletions
|
|
@ -216,10 +216,47 @@ postProjectNewR = do
|
|||
getProjectStampR :: KeyHashid Project -> KeyHashid SigKey -> Handler TypedContent
|
||||
getProjectStampR = servePerActorKey projectActor LocalActorProject
|
||||
|
||||
getProjectCollabsR :: KeyHashid Project -> Handler Html
|
||||
getProjectCollabsR :: KeyHashid Project -> Handler TypedContent
|
||||
getProjectCollabsR projectHash = do
|
||||
projectID <- decodeKeyHashid404 projectHash
|
||||
(project, actor, collabs, invites, joins) <- runDB $ do
|
||||
collabs <- runDB $ do
|
||||
_project <- get404 projectID
|
||||
grants <- getTopicGrants CollabTopicProjectCollab CollabTopicProjectProject projectID
|
||||
for grants $ \ (role, actor, _ct, time) ->
|
||||
(role,time,) <$> bitraverse pure (getRemoteActorURI <=< getJust) actor
|
||||
h <- asksSite siteInstanceHost
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
hashPerson <- getEncodeKeyHashid
|
||||
let makeItem (role, time, i) = AP.Relationship
|
||||
{ AP.relationshipId = Nothing
|
||||
, AP.relationshipExtraTypes = []
|
||||
, AP.relationshipSubject = encodeRouteHome $ ProjectR projectHash
|
||||
, AP.relationshipProperty = Left AP.RelHasCollab
|
||||
, AP.relationshipObject =
|
||||
case i of
|
||||
Left personID -> encodeRouteHome $ PersonR $ hashPerson personID
|
||||
Right u -> u
|
||||
, AP.relationshipAttributedTo = encodeRouteLocal $ ProjectR projectHash
|
||||
, AP.relationshipPublished = Just time
|
||||
, AP.relationshipUpdated = Nothing
|
||||
, AP.relationshipInstrument = Just role
|
||||
}
|
||||
collabsAP = AP.Collection
|
||||
{ AP.collectionId = encodeRouteLocal $ ProjectCollabsR projectHash
|
||||
, AP.collectionType = CollectionTypeUnordered
|
||||
, AP.collectionTotalItems = Just $ length collabs
|
||||
, AP.collectionCurrent = Nothing
|
||||
, AP.collectionFirst = Nothing
|
||||
, AP.collectionLast = Nothing
|
||||
, AP.collectionItems = map (Doc h . makeItem) collabs
|
||||
, AP.collectionContext =
|
||||
Just $ encodeRouteLocal $ ProjectR projectHash
|
||||
}
|
||||
provideHtmlAndAP collabsAP $ getHtml projectID
|
||||
where
|
||||
getHtml projectID = do
|
||||
(project, actor, collabs, invites, joins) <- handlerToWidget $ runDB $ do
|
||||
project <- get404 projectID
|
||||
actor <- getJust $ projectActor project
|
||||
collabs <- do
|
||||
|
|
@ -241,7 +278,7 @@ getProjectCollabsR projectHash = do
|
|||
for joins' $ \ (recip, time, role) ->
|
||||
(,time,role) <$> getPersonWidgetInfo recip
|
||||
return (project, actor, collabs, invites, joins)
|
||||
defaultLayout $(widgetFile "project/collab/list")
|
||||
$(widgetFile "project/collab/list")
|
||||
where
|
||||
grabPerson actorID = do
|
||||
actorByKey <- getLocalActor actorID
|
||||
|
|
@ -352,7 +389,7 @@ getProjectComponentsR projectHash = do
|
|||
encodeRouteHome <- getEncodeRouteHome
|
||||
hashActor <- getHashLocalActor
|
||||
let componentsAP = Collection
|
||||
{ collectionId = encodeRouteLocal here
|
||||
{ collectionId = encodeRouteLocal $ ProjectComponentsR projectHash
|
||||
, collectionType = CollectionTypeUnordered
|
||||
, collectionTotalItems = Just $ length components
|
||||
, collectionCurrent = Nothing
|
||||
|
|
@ -371,12 +408,10 @@ getProjectComponentsR projectHash = do
|
|||
, collectionContext =
|
||||
Just $ encodeRouteLocal $ ProjectR projectHash
|
||||
}
|
||||
provideHtmlAndAP componentsAP $ redirectToPrettyJSON here
|
||||
provideHtmlAndAP componentsAP $ getHtml projectID
|
||||
|
||||
where
|
||||
|
||||
here = ProjectComponentsR projectHash
|
||||
|
||||
getRepos projectID =
|
||||
fmap (map E.unValue) $
|
||||
E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` local `E.InnerJoin` repo) -> do
|
||||
|
|
@ -415,6 +450,68 @@ getProjectComponentsR projectHash = do
|
|||
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
|
||||
return (i E.^. InstanceHost, ro E.^. RemoteObjectIdent)
|
||||
|
||||
getHtml projectID = do
|
||||
(project, actor, comps, drafts) <- handlerToWidget $ runDB $ do
|
||||
project <- get404 projectID
|
||||
actor <- getJust $ projectActor project
|
||||
cs <-
|
||||
E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` grant) -> do
|
||||
E.on $ enable E.^. ComponentEnableGrant E.==. grant E.^. OutboxItemId
|
||||
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
|
||||
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
|
||||
return (comp, grant)
|
||||
cs' <- for cs $ \ (Entity cid c, Entity _ i) -> do
|
||||
byKeyOrRaid <- bimap snd snd <$> getComponentIdent cid
|
||||
identView <-
|
||||
bitraverse
|
||||
(\ byKey -> do
|
||||
actorID <-
|
||||
case byKey of
|
||||
ComponentRepo k -> repoActor <$> getJust k
|
||||
ComponentDeck k -> deckActor <$> getJust k
|
||||
ComponentLoom k -> loomActor <$> getJust k
|
||||
actor <- getJust actorID
|
||||
return (byKey, actor)
|
||||
)
|
||||
(\ remoteActorID -> do
|
||||
remoteActor <- getJust remoteActorID
|
||||
remoteObject <- getJust $ remoteActorIdent remoteActor
|
||||
inztance <- getJust $ remoteObjectInstance remoteObject
|
||||
return (inztance, remoteObject, remoteActor)
|
||||
)
|
||||
byKeyOrRaid
|
||||
return (identView, componentRole c, outboxItemPublished i)
|
||||
ds <-
|
||||
E.select $ E.from $ \ (comp `E.LeftOuterJoin` enable) -> do
|
||||
E.on $ E.just (comp E.^. ComponentId) E.==. enable E.?. ComponentEnableComponent
|
||||
E.where_ $
|
||||
comp E.^. ComponentProject E.==. E.val projectID E.&&.
|
||||
E.isNothing (enable E.?. ComponentEnableId)
|
||||
return comp
|
||||
ds' <- for ds $ \ (Entity cid c) -> do
|
||||
byKeyOrRaid <- bimap snd snd <$> getComponentIdent cid
|
||||
identView <-
|
||||
bitraverse
|
||||
(\ byKey -> do
|
||||
actorID <-
|
||||
case byKey of
|
||||
ComponentRepo k -> repoActor <$> getJust k
|
||||
ComponentDeck k -> deckActor <$> getJust k
|
||||
ComponentLoom k -> loomActor <$> getJust k
|
||||
actor <- getJust actorID
|
||||
return (byKey, actor)
|
||||
)
|
||||
(\ remoteActorID -> do
|
||||
remoteActor <- getJust remoteActorID
|
||||
remoteObject <- getJust $ remoteActorIdent remoteActor
|
||||
inztance <- getJust $ remoteObjectInstance remoteObject
|
||||
return (inztance, remoteObject, remoteActor)
|
||||
)
|
||||
byKeyOrRaid
|
||||
return (identView, componentRole c)
|
||||
return (project, actor, cs', ds')
|
||||
$(widgetFile "project/components")
|
||||
|
||||
getProjectCollabLiveR
|
||||
:: KeyHashid Project -> KeyHashid CollabEnable -> Handler ()
|
||||
getProjectCollabLiveR projectHash enableHash = do
|
||||
|
|
|
|||
|
|
@ -17,13 +17,17 @@ module Vervis.Widget.Tracker
|
|||
( deckNavW
|
||||
, loomNavW
|
||||
, projectNavW
|
||||
, componentLinkFedW
|
||||
)
|
||||
where
|
||||
|
||||
import Database.Persist.Types
|
||||
import Yesod.Core.Widget
|
||||
|
||||
import Network.FedURI
|
||||
import Yesod.Hashids
|
||||
|
||||
import Vervis.Data.Collab
|
||||
import Vervis.Foundation
|
||||
import Vervis.Model
|
||||
import Vervis.Settings
|
||||
|
|
@ -44,3 +48,38 @@ projectNavW :: Entity Project -> Actor -> Widget
|
|||
projectNavW (Entity projectID project) actor = do
|
||||
projectHash <- encodeKeyHashid projectID
|
||||
$(widgetFile "project/widget/nav")
|
||||
|
||||
componentLinkW :: ComponentBy Key -> Actor -> Widget
|
||||
componentLinkW (ComponentRepo k) actor = do
|
||||
h <- encodeKeyHashid k
|
||||
[whamlet|
|
||||
<a href=@{RepoR h}>
|
||||
^#{keyHashidText h} #{actorName actor}
|
||||
|]
|
||||
componentLinkW (ComponentDeck k) actor = do
|
||||
h <- encodeKeyHashid k
|
||||
[whamlet|
|
||||
<a href=@{DeckR h}>
|
||||
=#{keyHashidText h} #{actorName actor}
|
||||
|]
|
||||
componentLinkW (ComponentLoom k) actor = do
|
||||
h <- encodeKeyHashid k
|
||||
[whamlet|
|
||||
<a href=@{LoomR h}>
|
||||
+#{keyHashidText h} #{actorName actor}
|
||||
|]
|
||||
|
||||
componentLinkFedW
|
||||
:: Either (ComponentBy Key, Actor) (Instance, RemoteObject, RemoteActor)
|
||||
-> Widget
|
||||
componentLinkFedW (Left (c, a)) = componentLinkW c a
|
||||
componentLinkFedW (Right (inztance, object, actor)) =
|
||||
[whamlet|
|
||||
<a href="#{renderObjURI uActor}">
|
||||
$maybe name <- remoteActorName actor
|
||||
#{name}
|
||||
$nothing
|
||||
#{renderAuthority $ instanceHost inztance}#{localUriPath $ remoteObjectIdent object}
|
||||
|]
|
||||
where
|
||||
uActor = ObjURI (instanceHost inztance) (remoteObjectIdent object)
|
||||
|
|
|
|||
|
|
@ -54,6 +54,8 @@ module Web.ActivityPub
|
|||
|
||||
-- * Content objects
|
||||
, Note (..)
|
||||
, RelationshipProperty (..)
|
||||
, Relationship (..)
|
||||
, TicketDependency (..)
|
||||
, PatchLocal (..)
|
||||
, Patch (..)
|
||||
|
|
@ -1072,13 +1074,14 @@ instance ActivityPub Note where
|
|||
<> "content" .= content
|
||||
<> "mediaType" .= ("text/html" :: Text)
|
||||
|
||||
data RelationshipProperty = RelDependsOn deriving Eq
|
||||
data RelationshipProperty = RelDependsOn | RelHasCollab deriving Eq
|
||||
|
||||
instance FromJSON RelationshipProperty where
|
||||
parseJSON = withText "RelationshipProperty" parse
|
||||
where
|
||||
parse t
|
||||
| t == "dependsOn" = pure RelDependsOn
|
||||
| t == "hasCollaborator" = pure RelHasCollab
|
||||
| otherwise = fail $ "Unrecognized relationship: " ++ T.unpack t
|
||||
|
||||
instance ToJSON RelationshipProperty where
|
||||
|
|
@ -1086,6 +1089,7 @@ instance ToJSON RelationshipProperty where
|
|||
toEncoding at =
|
||||
toEncoding $ case at of
|
||||
RelDependsOn -> "dependsOn" :: Text
|
||||
RelHasCollab -> "hasCollaborator"
|
||||
|
||||
data Relationship u = Relationship
|
||||
{ relationshipId :: Maybe (ObjURI u)
|
||||
|
|
@ -1096,6 +1100,7 @@ data Relationship u = Relationship
|
|||
, relationshipAttributedTo :: LocalURI
|
||||
, relationshipPublished :: Maybe UTCTime
|
||||
, relationshipUpdated :: Maybe UTCTime
|
||||
, relationshipInstrument :: Maybe Role
|
||||
}
|
||||
|
||||
instance ActivityPub Relationship where
|
||||
|
|
@ -1117,10 +1122,11 @@ instance ActivityPub Relationship where
|
|||
<*> pure attributedTo
|
||||
<*> o .:? "published"
|
||||
<*> o .:? "updated"
|
||||
<*> o .:? "instrument"
|
||||
|
||||
toSeries authority
|
||||
(Relationship id_ typs subject property object attributedTo published
|
||||
updated)
|
||||
updated role)
|
||||
= "id" .=? id_
|
||||
<> "type" .= ("Relationship" : typs)
|
||||
<> "subject" .= subject
|
||||
|
|
@ -1129,6 +1135,7 @@ instance ActivityPub Relationship where
|
|||
<> "attributedTo" .= ObjURI authority attributedTo
|
||||
<> "published" .=? published
|
||||
<> "updated" .=? updated
|
||||
<> "instrument" .=? role
|
||||
|
||||
data TicketDependency u = TicketDependency
|
||||
{ ticketDepId :: Maybe (ObjURI u)
|
||||
|
|
@ -1171,6 +1178,7 @@ instance ActivityPub TicketDependency where
|
|||
, relationshipAttributedTo = ticketDepAttributedTo td
|
||||
, relationshipPublished = ticketDepPublished td
|
||||
, relationshipUpdated = ticketDepUpdated td
|
||||
, relationshipInstrument = Nothing
|
||||
}
|
||||
|
||||
data PatchLocal = PatchLocal
|
||||
|
|
|
|||
42
templates/project/components.hamlet
Normal file
42
templates/project/components.hamlet
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
$#
|
||||
$# The author(s) have dedicated all copyright and related and neighboring
|
||||
$# rights to this software to the public domain worldwide. This software is
|
||||
$# distributed without any warranty.
|
||||
$#
|
||||
$# You should have received a copy of the CC0 Public Domain Dedication along
|
||||
$# with this software. If not, see
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
^{projectNavW (Entity projectID project) actor}
|
||||
|
||||
<h2>Components
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<th>Role
|
||||
<th>Component
|
||||
<th>Since
|
||||
$forall (comp, role, since) <- comps
|
||||
<tr>
|
||||
<td>#{show role}
|
||||
<td>^{componentLinkFedW comp}
|
||||
<td>#{showDate since}
|
||||
$# <td>^{buttonW POST "Remove" (ProjectRemoveR projectHash ctID)}
|
||||
|
||||
<h2>Component requests in progress
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<th>Role
|
||||
<th>Component
|
||||
$forall (comp, role) <- drafts
|
||||
<tr>
|
||||
<td>#{show role}
|
||||
<td>^{componentLinkFedW comp}
|
||||
|
||||
$#<a href=@{ProjectInviteR projectHash}>Invite…
|
||||
Loading…
Reference in a new issue