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)