UI, Vocab: Link from project/team to children & parents pages

src/Vervis/Handler/Group.hs

@@ -196,8 +196,8 @@ getGroupR groupHash = do
             }
         groupAP = AP.Team
             { AP.teamActor    = actorAP
-            , AP.teamChildren = []
-            , AP.teamParents  = []
+            , AP.teamChildren = encodeRouteLocal $ GroupChildrenR groupHash
+            , AP.teamParents  = encodeRouteLocal $ GroupParentsR groupHash
             , AP.teamMembers  = encodeRouteLocal $ GroupMembersR groupHash
             }
 

src/Vervis/Handler/Project.hs

@@ -159,8 +159,8 @@ getProjectR projectHash = do
                     }
                 }
             , AP.projectTracker    = Nothing
-            , AP.projectChildren   = []
-            , AP.projectParents    = []
+            , AP.projectChildren   = encodeRouteLocal $ ProjectChildrenR projectHash
+            , AP.projectParents    = encodeRouteLocal $ ProjectParentsR projectHash
             , AP.projectComponents =
                 encodeRouteLocal $ ProjectComponentsR projectHash
             , AP.projectCollaborators =

src/Web/ActivityPub.hs

@@ -880,8 +880,8 @@ instance ActivityPub ResourceWithCollections where
 data Project u = Project
     { projectActor      :: Actor u
     , projectTracker    :: Maybe (ObjURI u)
-    , projectChildren   :: [ObjURI u]
-    , projectParents    :: [ObjURI u]
+    , projectChildren   :: LocalURI
+    , projectParents    :: LocalURI
     , projectComponents :: LocalURI
     , projectCollaborators :: LocalURI
     }
@@ -895,36 +895,22 @@ instance ActivityPub Project where
         fmap (h,) $
             Project a
                 <$> o .:? "ticketsTrackedBy"
-                <*> (do c <- o .: "subprojects"
-                        typ <- c .: "type"
-                        unless (typ == ("Collection" :: Text)) $
-                            fail "subprojects.type isn't Collection"
-                        items <- c .: "items"
-                        mtotal <- c .:? "totalItems"
-                        for_ mtotal $ \ total ->
-                            unless (length items == total) $
-                                fail "Incorrect totalItems"
-                        return items
-                    )
-                <*> o .:? "context" .!= []
+                <*> withAuthorityO h (o .: "subprojects")
+                <*> withAuthorityO h (o .: "context")
                 <*> withAuthorityO h (o .: "components")
                 <*> withAuthorityO h (o .: "collaborators")
     toSeries h (Project actor tracker children parents components collabs)
         =  toSeries h actor
         <> "ticketsTrackedBy" .=? tracker
-        <> "subprojects" `pair` pairs
-            (  "type"       .= ("Collection" :: Text)
-            <> "items"      .= children
-            <> "totalItems" .= length children
-            )
-        <> "context"        .= parents
+        <> "subprojects"    .= ObjURI h children
+        <> "context"        .= ObjURI h parents
         <> "components"     .= ObjURI h components
         <> "collaborators"  .= ObjURI h collabs
 
 data Team u = Team
     { teamActor    :: Actor u
-    , teamChildren :: [ObjURI u]
-    , teamParents  :: [ObjURI u]
+    , teamChildren :: LocalURI
+    , teamParents  :: LocalURI
     , teamMembers  :: LocalURI
     }
 
@@ -936,27 +922,13 @@ instance ActivityPub Team where
             fail "Actor type isn't Team"
         fmap (h,) $
             Team a
-                <$> (do c <- o .: "subteams"
-                        typ <- c .: "type"
-                        unless (typ == ("Collection" :: Text)) $
-                            fail "subteams.type isn't Collection"
-                        items <- c .: "items"
-                        mtotal <- c .:? "totalItems"
-                        for_ mtotal $ \ total ->
-                            unless (length items == total) $
-                                fail "Incorrect totalItems"
-                        return items
-                    )
-                <*> o .:? "context" .!= []
+                <$> withAuthorityO h (o .: "subteams")
+                <*> withAuthorityO h (o .: "context")
                 <*> withAuthorityO h (o .: "members")
     toSeries h (Team actor children parents members)
         =  toSeries h actor
-        <> "subteams" `pair` pairs
-            (  "type"       .= ("Collection" :: Text)
-            <> "items"      .= children
-            <> "totalItems" .= length children
-            )
-        <> "context"        .= parents
+        <> "subteams"       .= ObjURI h children
+        <> "context"        .= ObjURI h parents
         <> "members"        .= ObjURI h members
 
 data Audience u = Audience

templates/group/nav.hamlet

@@ -30,5 +30,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <span>
     <a href=@{GroupMembersR groupHash}>
       [🤝 Members]
+  <span>
+    <a href=@{GroupChildrenR groupHash}>
+      [🐛 Children]
+  <span>
+    <a href=@{GroupParentsR groupHash}>
+      [🦋 Parents]
   <span>
     [✏ Edit]

templates/project/widget/nav.hamlet

@@ -33,6 +33,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <span>
     <a href=@{ProjectComponentsR projectHash}>
       [🧩 Components]
+  <span>
+    <a href=@{ProjectChildrenR projectHash}>
+      [🐛 Children]
+  <span>
+    <a href=@{ProjectParentsR projectHash}>
+      [🦋 Parents]
   <span>
     [No wiki]
   <span>