sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 09:44:51 +09:00
Code Issues Activity

UI: Define nav breadcrumbs for all routes

Browse source
This commit is contained in:
fr33domlover 2022-09-26 06:54:16 +00:00
parent ab105cb604
commit 6d0eab24d1
1 changed files with 122 additions and 231 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

353
src/Vervis/Foundation.hs
View file

@ -789,238 +789,129 @@ instance YesodPaginate App where
instance YesodBreadcrumbs App where instance YesodBreadcrumbs App where
breadcrumb route = return $ case route of breadcrumb route = return $ case route of
LoomR l -> ("MR Tracker +" <> keyHashidText l, Just HomeR)
LoomClothsR l -> ("MRs", Just $ LoomR l) HighlightStyleR _ -> ("", Nothing)
ClothR l c -> ("!" <> keyHashidText c, Just $ LoomClothsR l) 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) BundleR l c b -> ("Bundle " <> keyHashidText b, Just $ ClothR l c)
PatchR l c b p -> ("Patch " <> keyHashidText p, Just $ BundleR l c b) 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) ClothApplyR _ _ -> ("", Nothing)
InboxDebugR -> ("Inbox Debug", Just HomeR) ClothFollowR _ _ -> ("", Nothing)
SharerOutboxR shr -> ("Outbox", Just $ SharerR shr) ClothUnfollowR _ _ -> ("", Nothing)
SharerOutboxItemR shr hid -> ( "#" <> keyHashidText hid ClothReplyR _ _ -> ("", Nothing)
, Just $ SharerOutboxR shr
)
SharerFollowersR shr -> ("Followers", Just $ SharerR shr)
ActorKey1R -> ("Actor Key 1", Nothing) ClothDepR l c p -> (keyHashidText p, Just $ ClothDepsR l c)
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)