From 6d0eab24d1e723b309162237ec31eeb932649d06 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Mon, 26 Sep 2022 06:54:16 +0000
Subject: [PATCH] UI: Define nav breadcrumbs for all routes
---
src/Vervis/Foundation.hs | 353 ++++++++++++++-------------------------
1 file changed, 122 insertions(+), 231 deletions(-)
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index a1004d9..1e56fe7 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -789,238 +789,129 @@ instance YesodPaginate App where
instance YesodBreadcrumbs App where
breadcrumb route = return $ case route of
- LoomR l -> ("MR Tracker +" <> keyHashidText l, Just HomeR)
- LoomClothsR l -> ("MRs", Just $ LoomR l)
- ClothR l c -> ("!" <> keyHashidText c, Just $ LoomClothsR l)
+
+ HighlightStyleR _ -> ("", Nothing)
+ StaticR _ -> ("", Nothing)
+ FaviconSvgR -> ("", Nothing)
+ FaviconPngR -> ("", Nothing)
+ RobotsR -> ("", Nothing)
+
+ ResendVerifyEmailR -> ("Resend verification email", Nothing)
+ AuthR _ -> ("Auth", Just HomeR)
+ DvaraR _ -> ("OAuth", Just HomeR)
+ ActorKey1R -> ("Actor Key 1", Just HomeR)
+ ActorKey2R -> ("Actor Key 2", Just HomeR)
+
+ HomeR -> ("Home", Nothing)
+ BrowseR -> ("Browse", Just HomeR)
+ NotificationsR -> ("Notifications", Just HomeR)
+ InboxDebugR -> ("Inbox Debug", Just HomeR)
+
+ PublishOfferMergeR -> ("Open MR", Just HomeR)
+ PublishMergeR -> ("Apply MR", Just HomeR)
+
+ PersonR p -> ("Person ~" <> keyHashidText p, Just HomeR)
+ PersonInboxR p -> ("Inbox", Just $ PersonR p)
+ PersonOutboxR p -> ("Outbox", Just $ PersonR p)
+ PersonOutboxItemR p i -> (keyHashidText i, Just $ PersonOutboxR p)
+ PersonFollowersR p -> ("Followers", Just $ PersonR p)
+ PersonFollowingR p -> ("Following", Just $ PersonR p)
+
+ SshKeyR p k -> ("SSH Key #" <> keyHashidText k, Just $ PersonR p)
+
+ PersonMessageR p m -> ("Message #" <> keyHashidText m, Just $ PersonR p)
+
+ PersonFollowR _ -> ("", Nothing)
+ PersonUnfollowR _ -> ("", Nothing)
+
+ ReplyR _ -> ("", Nothing)
+
+ GroupR g -> ("Team &" <> keyHashidText g, Just HomeR)
+ GroupInboxR g -> ("Inbox", Just $ GroupR g)
+ GroupOutboxR g -> ("Outbox", Just $ GroupR g)
+ GroupOutboxItemR g i -> (keyHashidText i, Just $ GroupOutboxR g)
+ GroupFollowersR g -> ("Followers", Just $ GroupR g)
+
+ RepoR r -> ("Repo ^" <> keyHashidText r, Just HomeR)
+ RepoInboxR r -> ("Inbox", Just $ RepoR r)
+ RepoOutboxR r -> ("Outbox", Just $ RepoR r)
+ RepoOutboxItemR r i -> (keyHashidText i, Just $ RepoOutboxR r)
+ RepoFollowersR r -> ("Followers", Just $ RepoR r)
+
+ DarcsDownloadR _ _ -> ("", Nothing)
+ GitRefDiscoverR _ -> ("", Nothing)
+ GitUploadRequestR _ -> ("", Nothing)
+
+ RepoSourceR r [] -> ("Files", Just $ RepoR r)
+ RepoSourceR r dir -> (last dir, Just $ RepoSourceR r $ init dir)
+ RepoBranchSourceR r b [] -> ("Branch " <> b <> " Files", Just $ RepoR r)
+ RepoBranchSourceR r b dir -> (last dir, Just $ RepoBranchSourceR r b $ init dir)
+ RepoCommitsR r -> ("Commits", Just $ RepoR r)
+ RepoBranchCommitsR r b -> ("Branch " <> b <> " Commits", Just $ RepoR r)
+ RepoCommitR r c -> (c, Just $ RepoCommitsR r)
+
+ RepoNewR -> ("New Repo", Just HomeR)
+ RepoDeleteR r -> ("", Nothing)
+ RepoEditR r -> ("Edit", Just $ RepoR r)
+ RepoFollowR r -> ("", Nothing)
+ RepoUnfollowR r -> ("", Nothing)
+
+ PostReceiveR -> ("", Nothing)
+
+ RepoLinkR _ _ -> ("", Nothing)
+
+ DeckR d -> ("Ticket Tracker =" <> keyHashidText d, Just HomeR)
+ DeckInboxR d -> ("Inbox", Just $ DeckR d)
+ DeckOutboxR d -> ("Outbox", Just $ DeckR d)
+ DeckOutboxItemR d i -> (keyHashidText i, Just $ DeckOutboxR d)
+ DeckFollowersR d -> ("Followers", Just $ DeckR d)
+ DeckTicketsR d -> ("Tickets", Just $ DeckR d)
+
+ DeckTreeR d -> ("Tree", Just $ DeckTicketsR d)
+
+ DeckNewR -> ("New Ticket Tracker", Just HomeR)
+ DeckDeleteR _ -> ("", Nothing)
+ DeckEditR d -> ("Edit", Just $ DeckR d)
+ DeckFollowR _ -> ("", Nothing)
+ DeckUnfollowR _ -> ("", Nothing)
+
+ TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d)
+ TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t)
+ TicketEventsR d t -> ("Events", Just $ TicketR d t)
+ TicketFollowersR d t -> ("Followers", Just $ TicketR d t)
+ TicketDepsR d t -> ("Dependencies", Just $ TicketR d t)
+ TicketReverseDepsR d t -> ("Dependants", Just $ TicketR d t)
+
+ TicketFollowR _ _ -> ("", Nothing)
+ TicketUnfollowR _ _ -> ("", Nothing)
+ TicketReplyR _ _ -> ("", Nothing)
+
+ TicketDepR d t p -> (keyHashidText p, Just $ TicketDepsR d t)
+
+ LoomR l -> ("Merge Request Tracker +" <> keyHashidText l, Just HomeR)
+ LoomInboxR l -> ("Inbox", Just $ LoomR l)
+ LoomOutboxR l -> ("Outbox", Just $ LoomR l)
+ LoomOutboxItemR l i -> (keyHashidText i, Just $ LoomOutboxR l)
+ LoomFollowersR l -> ("Followers", Just $ LoomR l)
+ LoomClothsR l -> ("Merge Requests", Just $ LoomR l)
+
+ LoomNewR -> ("New Patch Tracker", Just HomeR)
+ LoomFollowR _ -> ("", Nothing)
+ LoomUnfollowR _ -> ("", Nothing)
+
+ ClothR l c -> ("#" <> keyHashidText c, Just $ LoomClothsR l)
+ ClothDiscussionR l c -> ("Discussion", Just $ ClothR l c)
+ ClothEventsR l c -> ("Events", Just $ ClothR l c)
+ ClothFollowersR l c -> ("Followers", Just $ ClothR l c)
+ ClothDepsR l c -> ("Dependencies", Just $ ClothR l c)
+ ClothReverseDepsR l c -> ("Dependants", Just $ ClothR l c)
+
BundleR l c b -> ("Bundle " <> keyHashidText b, Just $ ClothR l c)
PatchR l c b p -> ("Patch " <> keyHashidText p, Just $ BundleR l c b)
- {-
- StaticR _ -> ("", Nothing)
- FaviconSvgR -> ("", Nothing)
- FaviconPngR -> ("", Nothing)
- RobotsR -> ("", Nothing)
- PublishR -> ("Publish", Just HomeR)
- InboxDebugR -> ("Inbox Debug", Just HomeR)
- SharerOutboxR shr -> ("Outbox", Just $ SharerR shr)
- SharerOutboxItemR shr hid -> ( "#" <> keyHashidText hid
- , Just $ SharerOutboxR shr
- )
- SharerFollowersR shr -> ("Followers", Just $ SharerR shr)
+ ClothApplyR _ _ -> ("", Nothing)
+ ClothFollowR _ _ -> ("", Nothing)
+ ClothUnfollowR _ _ -> ("", Nothing)
+ ClothReplyR _ _ -> ("", Nothing)
- ActorKey1R -> ("Actor Key 1", Nothing)
- ActorKey2R -> ("Actor Key 2", Nothing)
-
- HomeR -> ("Home", Nothing)
- ResendVerifyEmailR -> ( "Resend verification email"
- , Nothing
- )
- AuthR _ -> ("Auth", Just HomeR)
-
- SharersR -> ("Sharers", Just HomeR)
- SharerR shar -> (shr2text shar, Just SharersR)
- SharerInboxR shr -> ("Inbox", Just $ SharerR shr)
- NotificationsR shr -> ( "Notifications"
- , Just $ SharerR shr
- )
-
- PeopleR -> ("People", Just HomeR)
-
- GroupsR -> ("Groups", Just HomeR)
- GroupNewR -> ("New", Just GroupsR)
- GroupMembersR shar -> ("Members", Just $ SharerR shar)
- GroupMemberNewR shar -> ("New", Just $ GroupMembersR shar)
- GroupMemberR grp memb -> ( shr2text memb
- , Just $ GroupMembersR grp
- )
-
- KeysR -> ("Keys", Just HomeR)
- KeyNewR -> ("New", Just KeysR)
- KeyR key -> (ky2text key, Just KeysR)
-
- ClaimRequestsPersonR -> ( "Ticket Claim Requests"
- , Just HomeR
- )
-
- ProjectRolesR shr -> ( "Project Roles"
- , Just $ SharerR shr
- )
- ProjectRoleNewR shr -> ("New", Just $ ProjectRolesR shr)
- ProjectRoleR shr rl -> ( rl2text rl
- , Just $ ProjectRolesR shr
- )
- ProjectRoleOpsR shr rl -> ( "Operations"
- , Just $ ProjectRoleR shr rl
- )
- ProjectRoleOpNewR shr rl -> ( "New"
- , Just $ ProjectRoleOpsR shr rl
- )
-
- ReposR shar -> ("Repos", Just $ SharerR shar)
- RepoNewR shar -> ("New", Just $ ReposR shar)
- RepoR shar repo -> (rp2text repo, Just $ ReposR shar)
- RepoOutboxR shr rp -> ("Outbox", Just $ RepoR shr rp)
- RepoOutboxItemR shr rp hid -> ( "#" <> keyHashidText hid
- , Just $ RepoOutboxR shr rp
- )
- RepoEditR shr rp -> ("Edit", Just $ RepoR shr rp)
- RepoSourceR shar repo [] -> ("Files", Just $ RepoR shar repo)
- RepoSourceR shar repo refdir -> ( last refdir
- , Just $
- RepoSourceR shar repo $
- init refdir
- )
- RepoHeadChangesR shar repo -> ("Changes", Just $ RepoR shar repo)
- RepoBranchR shar repo ref -> (ref, Just $ RepoR shar repo)
- RepoChangesR shar repo ref -> ( ref
- , Just $ RepoHeadChangesR shar repo
- )
- RepoCommitR shr rp hash -> ( "Commit " <> hash
- , Just $ RepoHeadChangesR shr rp
- )
- RepoDevsR shr rp -> ( "Collaboratots"
- , Just $ RepoR shr rp
- )
- RepoDevNewR shr rp -> ("New", Just $ RepoDevsR shr rp)
- RepoDevR shr rp dev -> ( shr2text dev
- , Just $ RepoDevsR shr rp
- )
-
- DarcsDownloadR _ _ _ -> ("", Nothing)
-
- GitRefDiscoverR _ _ -> ("", Nothing)
- GitUploadRequestR _ _ -> ("", Nothing)
-
- BrowseR -> ("Browse", Just HomeR)
-
- ProjectsR shar -> ("Projects", Just $ SharerR shar)
- ProjectNewR shar -> ("New", Just $ ProjectsR shar)
- ProjectR shar proj -> ( prj2text proj
- , Just $ ProjectsR shar
- )
- ProjectInboxR shr prj -> ("Inbox", Just $ ProjectR shr prj)
- ProjectOutboxR shr prj -> ("Outbox", Just $ ProjectR shr prj)
- ProjectOutboxItemR shr prj hid -> ( "#" <> keyHashidText hid
- , Just $ ProjectOutboxR shr prj
- )
- ProjectEditR shr prj -> ("Edit", Just $ ProjectR shr prj)
- ProjectDevsR shr prj -> ( "Collaborators"
- , Just $ ProjectR shr prj
- )
- ProjectDevNewR shr prj -> ( "New"
- , Just $ ProjectDevsR shr prj
- )
- ProjectDevR shr prj dev -> ( shr2text dev
- , Just $ ProjectDevsR shr prj
- )
-
- WorkflowsR shr -> ("Workflows", Just $ SharerR shr)
- WorkflowNewR shr -> ("New", Just $ WorkflowsR shr)
- WorkflowR shr wfl -> ( wfl2text wfl
- , Just $ WorkflowsR shr
- )
- WorkflowFieldsR shr wfl -> ( "Fields"
- , Just $ WorkflowR shr wfl
- )
- WorkflowFieldNewR shr wfl -> ( "New"
- , Just $ WorkflowFieldsR shr wfl
- )
- WorkflowFieldR shr wfl fld -> ( fld2text fld
- , Just $ WorkflowFieldsR shr wfl
- )
- WorkflowEnumsR shr wfl -> ( "Enums"
- , Just $ WorkflowR shr wfl
- )
- WorkflowEnumNewR shr wfl -> ( "New"
- , Just $ WorkflowEnumsR shr wfl
- )
- WorkflowEnumR shr wfl enm -> ( enm2text enm
- , Just $ WorkflowEnumsR shr wfl
- )
- WorkflowEnumCtorsR shr wfl enm -> ( "Ctors"
- , Just $ WorkflowEnumR shr wfl enm
- )
- WorkflowEnumCtorNewR shr wfl enm -> ( "New"
- , Just $
- WorkflowEnumCtorsR shr wfl enm
- )
- WorkflowEnumCtorR shr wfl enm c -> ( c
- , Just $
- WorkflowEnumCtorsR shr wfl enm
- )
-
- MessageR shr lmhid -> ( "#" <> keyHashidText lmhid
- , Just $ SharerR shr
- )
-
- ProjectTicketsR shar proj -> ( "Tickets"
- , Just $ ProjectR shar proj
- )
- ProjectTicketTreeR shr prj -> ( "Tree", Just $ ProjectTicketsR shr prj)
- ProjectTicketNewR shar proj -> ("New", Just $ ProjectTicketsR shar proj)
- ProjectTicketR shar proj num -> ( T.pack $ '#' : show num
- , Just $ ProjectTicketsR shar proj
- )
- ProjectTicketEditR shar proj num -> ( "Edit"
- , Just $ ProjectTicketR shar proj num
- )
- ProjectTicketAcceptR _shr _prj _num -> ("", Nothing)
- ProjectTicketCloseR _shar _proj _num -> ("", Nothing)
- ProjectTicketOpenR _shar _proj _num -> ("", Nothing)
- ProjectTicketClaimR _shar _proj _num -> ("", Nothing)
- ProjectTicketUnclaimR _shar _proj _num -> ("", Nothing)
- ProjectTicketAssignR shr prj num -> ( "Assign"
- , Just $ ProjectTicketR shr prj num
- )
- ProjectTicketUnassignR _shr _prj _num -> ("", Nothing)
- ClaimRequestsProjectR shr prj -> ( "Ticket Claim Requests"
- , Just $ ProjectR shr prj
- )
- ClaimRequestsTicketR shr prj num -> ( "Ticket Claim Requests"
- , Just $ ProjectTicketR shr prj num
- )
- ClaimRequestNewR shr prj num -> ( "New"
- , Just $
- ClaimRequestsTicketR shr prj num
- )
- ProjectTicketDiscussionR shar proj num -> ( "Discussion"
- , Just $ ProjectTicketR shar proj num
- )
- ProjectTicketMessageR shr prj num mkhid -> ( "#" <> keyHashidText mkhid
- , Just $
- ProjectTicketDiscussionR shr prj num
- )
- ProjectTicketTopReplyR shar proj num -> ( "New topic"
- , Just $
- ProjectTicketDiscussionR shar proj num
- )
- ProjectTicketReplyR shar proj num cnum -> ( "Reply"
- , Just $
- ProjectTicketMessageR shar proj num cnum
- )
- ProjectTicketDepsR shr prj num -> ( "Dependencies"
- , Just $ ProjectTicketR shr prj num
- )
- ProjectTicketDepNewR shr prj num -> ( "New dependency"
- , Just $ ProjectTicketDepsR shr prj num
- )
- TicketDepOldR shr prj pnum cnum -> ( T.pack $ '#' : show cnum
- , Just $ ProjectTicketDepsR shr prj pnum
- )
- ProjectTicketReverseDepsR shr prj num -> ( "Dependants"
- , Just $ ProjectTicketR shr prj num
- )
- ProjectTicketParticipantsR shr prj num -> ( "Participants"
- , Just $ ProjectTicketR shr prj num
- )
- ProjectTicketTeamR shr prj num -> ( "Team"
- , Just $ ProjectTicketR shr prj num
- )
- ProjectTicketEventsR shr prj num -> ( "Events"
- , Just $ ProjectTicketR shr prj num
- )
-
- WikiPageR shr prj _page -> ("Wiki", Just $ ProjectR shr prj)
- -}
-
- _ -> ("PAGE TITLE HERE", Just HomeR)
+ ClothDepR l c p -> (keyHashidText p, Just $ ClothDepsR l c)