{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE UndecidableInstances #-} -- for `ChildrenNavChildren`
{-# LANGUAGE DuplicateRecordFields #-} -- for `navLabel`

module Foundation.Navigation
  ( NavQuickView(..), NavType(..), NavLevel(..), NavHeaderRole(..), NavLink(..), Nav(..), NavChildren
  , _navModal, _navMethod, _navData, _navLabel, _navType, _navForceActive, _navHeaderRole, _navIcon, _navLink, _navChildren
  , _NavHeader, _NavHeaderContainer, _NavPageActionPrimary, _NavPageActionSecondary, _NavFooter
  , navBaseRoute, navLinkRoute
  , pageActions
  , pageQuickActions
  , defaultLinks
  , navAccess
  , navQuick
  , evalAccessCorrector
  ) where

import Import.NoFoundation

import Foundation.Type
import Foundation.Routes
import Foundation.I18n
import Foundation.Authorization
import Foundation.DB

import Handler.Utils.Memcached
import Handler.Utils.ExamOffice.Course
import Handler.Utils.Download
import Utils.Sheet

import qualified Data.CaseInsensitive as CI
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import Control.Monad.Trans.State (execStateT)

import Yesod.Core.Types (HandlerContents)

import qualified Data.Conduit.Combinators as C

import Utils.Workflow
import Handler.Utils.Workflow.CanonicalRoute


-- Define breadcrumbs.
i18nCrumb :: (RenderMessage (HandlerSite m) msg, MonadHandler m)
          => msg
          -> Maybe (Route (HandlerSite m))
          -> m (Text, Maybe (Route (HandlerSite m)))
i18nCrumb msg mbR = do
  mr <- getMessageRender
  return (mr msg, mbR)

-- `breadcrumb` _really_ needs to be total for _all_ routes
--
-- Even if routes are POST only or don't usually use `siteLayout` they will if
-- an error occurs.
--
-- Keep in mind that Breadcrumbs are also shown by the 403-Handler,
-- i.e. information might be leaked by not performing permission checks if the
-- breadcrumb value depends on sensitive content (like an user's name).
instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
  breadcrumb (AuthR _)        = i18nCrumb MsgMenuLogin         $ Just NewsR
  breadcrumb (StaticR _)      = i18nCrumb MsgBreadcrumbStatic    Nothing
  breadcrumb (WellKnownR _)   = i18nCrumb MsgBreadcrumbWellKnown Nothing
  breadcrumb MetricsR         = i18nCrumb MsgBreadcrumbMetrics   Nothing

  breadcrumb NewsR            = i18nCrumb MsgMenuNews      Nothing
  breadcrumb UsersR           = i18nCrumb MsgMenuUsers   $ Just AdminR
  breadcrumb AdminUserAddR    = i18nCrumb MsgMenuUserAdd $ Just UsersR
  breadcrumb (AdminUserR cID) = maybeT (i18nCrumb MsgBreadcrumbUser $ Just UsersR) $ do
    guardM . hasReadAccessTo $ AdminUserR cID
    uid <- decrypt cID
    User{..} <- MaybeT . runDBRead $ get uid
    return (userDisplayName, Just UsersR)
  breadcrumb (AdminUserDeleteR cID) = i18nCrumb MsgBreadcrumbUserDelete . Just $ AdminUserR cID
  breadcrumb (AdminHijackUserR cID) = i18nCrumb MsgBreadcrumbUserHijack . Just $ AdminUserR cID
  breadcrumb (UserNotificationR cID) = do
    mayList <- hasReadAccessTo UsersR
    if
      | mayList
        -> i18nCrumb MsgMenuUserNotifications . Just $ AdminUserR cID
      | otherwise
        -> i18nCrumb MsgMenuUserNotifications $ Just ProfileR
  breadcrumb (UserPasswordR cID) = do
    mayList <- hasReadAccessTo UsersR
    if
      | mayList
        -> i18nCrumb MsgMenuUserPassword . Just $ AdminUserR cID
      | otherwise
        -> i18nCrumb MsgMenuUserPassword $ Just ProfileR
  breadcrumb AdminNewFunctionaryInviteR = i18nCrumb MsgMenuLecturerInvite $ Just UsersR
  breadcrumb AdminFunctionaryInviteR = i18nCrumb MsgBreadcrumbFunctionaryInvite Nothing

  breadcrumb AdminR           = i18nCrumb MsgAdminHeading           Nothing
  breadcrumb AdminFeaturesR   = i18nCrumb MsgAdminFeaturesHeading $ Just AdminR
  breadcrumb AdminTestR       = i18nCrumb MsgMenuAdminTest        $ Just AdminR
  breadcrumb AdminErrMsgR     = i18nCrumb MsgMenuAdminErrMsg      $ Just AdminR
  breadcrumb AdminTokensR     = i18nCrumb MsgMenuAdminTokens      $ Just AdminR
  breadcrumb AdminCrontabR    = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR

  breadcrumb SchoolListR      = i18nCrumb MsgMenuSchoolList       $ Just AdminR
  breadcrumb (SchoolR ssh sRoute) = case sRoute of
    SchoolEditR -> maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
      School{..} <- MaybeT . runDBRead $ get ssh
      isAdmin <- hasReadAccessTo SchoolListR
      return (CI.original schoolName, bool Nothing (Just SchoolListR) isAdmin)

    SchoolWorkflowInstanceListR -> i18nCrumb MsgBreadcrumbWorkflowInstanceList . Just $ SchoolR ssh SchoolEditR
    SchoolWorkflowInstanceNewR  -> i18nCrumb MsgBreadcrumbWorkflowInstanceNew . Just $ SchoolR ssh SchoolWorkflowInstanceListR
    SchoolWorkflowInstanceR win sRoute' -> case sRoute' of
      SWIEditR -> i18nCrumb (MsgBreadcrumbWorkflowInstanceEdit win) . Just $ SchoolR ssh SchoolWorkflowInstanceListR
      SWIDeleteR -> i18nCrumb MsgBreadcrumbWorkflowInstanceDelete . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR
      SWIWorkflowsR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowList . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR
      SWIInitiateR -> do
        mayEdit <- hasReadAccessTo . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR
        i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just . SchoolR ssh $ if
          | mayEdit -> SchoolWorkflowInstanceR win SWIEditR
          | otherwise -> SchoolWorkflowInstanceListR
    SchoolWorkflowWorkflowListR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowList . Just $ SchoolR ssh SchoolWorkflowInstanceListR
    SchoolWorkflowWorkflowR cID sRoute' -> case sRoute' of
      SWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) . Just $ SchoolR ssh SchoolWorkflowWorkflowListR
      SWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR
      SWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR
      SWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR
  breadcrumb SchoolNewR       = i18nCrumb MsgMenuSchoolNew        $ Just SchoolListR

  breadcrumb (ExamOfficeR EOExamsR)  = i18nCrumb MsgMenuExamOfficeExams    Nothing
  breadcrumb (ExamOfficeR EOFieldsR) = i18nCrumb MsgMenuExamOfficeFields . Just $ ExamOfficeR EOExamsR
  breadcrumb (ExamOfficeR EOUsersR)  = i18nCrumb MsgMenuExamOfficeUsers . Just $ ExamOfficeR EOExamsR
  breadcrumb (ExamOfficeR EOUsersInviteR) = i18nCrumb MsgBreadcrumbExamOfficeUserInvite Nothing

  breadcrumb InfoR            = i18nCrumb MsgMenuInformation     Nothing
  breadcrumb InfoLecturerR    = i18nCrumb MsgInfoLecturerTitle $ Just InfoR
  breadcrumb LegalR           = i18nCrumb MsgMenuLegal         $ Just InfoR
  breadcrumb InfoAllocationR  = i18nCrumb MsgBreadcrumbAllocationInfo $ Just InfoR
  breadcrumb VersionR         = i18nCrumb MsgMenuVersion       $ Just InfoR
  breadcrumb FaqR             = i18nCrumb MsgBreadcrumbFaq     $ Just InfoR


  breadcrumb HelpR            = i18nCrumb MsgMenuHelp            Nothing


  breadcrumb HealthR          = i18nCrumb MsgMenuHealth          Nothing
  breadcrumb InstanceR        = i18nCrumb MsgMenuInstance        Nothing

  breadcrumb ProfileR         = i18nCrumb MsgBreadcrumbProfile   Nothing
  breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail  $ Just ProfileR
  breadcrumb ProfileDataR     = i18nCrumb MsgMenuProfileData   $ Just ProfileR
  breadcrumb AuthPredsR       = i18nCrumb MsgMenuAuthPreds     $ Just ProfileR
  breadcrumb CsvOptionsR      = i18nCrumb MsgCsvOptions        $ Just ProfileR
  breadcrumb LangR            = i18nCrumb MsgMenuLanguage      $ Just ProfileR

  breadcrumb StorageKeyR      = i18nCrumb MsgBreadcrumbStorageKey Nothing

  breadcrumb TermShowR              = i18nCrumb MsgMenuTermShow    $ Just NewsR
  breadcrumb TermCurrentR           = i18nCrumb MsgMenuTermCurrent $ Just TermShowR
  breadcrumb TermEditR              = i18nCrumb MsgMenuTermCreate  $ Just TermShowR
  breadcrumb (TermEditExistR tid)   = i18nCrumb MsgMenuTermEdit    . Just $ TermCourseListR tid
  breadcrumb (TermCourseListR tid)  = maybeT (i18nCrumb MsgBreadcrumbTerm $ Just CourseListR) $ do -- redirect only, used in other breadcrumbs
    guardM . lift . runDBRead $ isJust <$> get tid
    i18nCrumb (ShortTermIdentifier $ unTermKey tid) $ Just CourseListR

  breadcrumb (TermSchoolCourseListR tid ssh) = maybeT (i18nCrumb MsgBreadcrumbSchool . Just $ TermCourseListR tid) $ do -- redirect only, used in other breadcrumbs
    guardM . lift . runDBRead $
      (&&) <$> fmap isJust (get ssh)
           <*> fmap isJust (get tid)
    return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid)

  breadcrumb AllocationListR        = i18nCrumb MsgAllocationListTitle $ Just NewsR
  breadcrumb (AllocationR tid ssh ash sRoute) = case sRoute of
    AShowR      -> maybeT (i18nCrumb MsgBreadcrumbAllocation $ Just AllocationListR) $ do
      mr <- getMessageRender
      Entity _ Allocation{allocationName} <- MaybeT . runDBRead . getBy $ TermSchoolAllocationShort tid ssh ash
      return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{CI.original (unSchoolKey ssh)})|], Just AllocationListR)
    ARegisterR  -> i18nCrumb MsgBreadcrumbAllocationRegister . Just $ AllocationR tid ssh ash AShowR
    AApplyR cID -> maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ AllocationR tid ssh ash AShowR) $ do
      cid <- decrypt cID
      Course{..} <- hoist runDBRead $ do
        aid <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash
        guardM . lift $ exists [ AllocationCourseAllocation ==. aid, AllocationCourseCourse ==. cid ]
        MaybeT $ get cid
      return (CI.original courseName, Just $ AllocationR tid ssh ash AShowR)
    AUsersR     -> i18nCrumb MsgBreadcrumbAllocationUsers . Just $ AllocationR tid ssh ash AShowR
    APriosR     -> i18nCrumb MsgBreadcrumbAllocationPriorities . Just $ AllocationR tid ssh ash AUsersR
    AComputeR   -> i18nCrumb MsgBreadcrumbAllocationCompute . Just $ AllocationR tid ssh ash AUsersR
    AAcceptR    -> i18nCrumb MsgBreadcrumbAllocationAccept . Just $ AllocationR tid ssh ash AUsersR
    AAddUserR   -> i18nCrumb MsgBreadcrumbAllocationAddUser . Just $ AllocationR tid ssh ash AUsersR

  breadcrumb ParticipantsListR      = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR
  breadcrumb (ParticipantsR _ _)    = i18nCrumb MsgBreadcrumbParticipants     $ Just ParticipantsListR
  breadcrumb ParticipantsIntersectR = i18nCrumb MsgMenuParticipantsIntersect  $ Just ParticipantsListR

  breadcrumb  CourseListR                 = i18nCrumb MsgMenuCourseList   Nothing
  breadcrumb  CourseNewR                  = i18nCrumb MsgMenuCourseNew  $ Just CourseListR
  breadcrumb (CourseR tid ssh csh CShowR) = maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ TermSchoolCourseListR tid ssh) $ do
    guardM . lift . runDBRead . existsBy $ TermSchoolCourseShort tid ssh csh
    return (CI.original csh, Just $ TermSchoolCourseListR tid ssh)
  breadcrumb (CourseR tid ssh csh CEditR)     = i18nCrumb MsgMenuCourseEdit . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CUsersR)    = i18nCrumb MsgMenuCourseMembers . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CAddUserR)  = i18nCrumb MsgMenuCourseAddMembers . Just $ CourseR tid ssh csh CUsersR
  breadcrumb (CourseR tid ssh csh CInviteR)   = i18nCrumb MsgBreadcrumbCourseParticipantInvitation . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CExamOfficeR) = i18nCrumb MsgMenuCourseExamOffice . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh (CUserR cID)) = maybeT (i18nCrumb MsgBreadcrumbUser . Just $ CourseR tid ssh csh CUsersR) $ do
    guardM . hasReadAccessTo . CourseR tid ssh csh $ CUserR cID
    uid <- decrypt cID
    User{userDisplayName} <- MaybeT . runDBRead $ get uid
    return (userDisplayName, Just $ CourseR tid ssh csh CUsersR)
  breadcrumb (CourseR tid ssh csh CCorrectionsR) = i18nCrumb MsgMenuSubmissions . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CAssignR)   = i18nCrumb MsgMenuCorrectionsAssign . Just $ CourseR tid ssh csh CCorrectionsR
  breadcrumb (CourseR tid ssh csh SheetListR) = i18nCrumb MsgMenuSheetList . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh SheetNewR ) = i18nCrumb MsgMenuSheetNew . Just $ CourseR tid ssh csh SheetListR
  breadcrumb (CourseR tid ssh csh SheetCurrentR) = i18nCrumb MsgMenuSheetCurrent . Just $ CourseR tid ssh csh SheetListR
  breadcrumb (CourseR tid ssh csh SheetOldUnassignedR) = i18nCrumb MsgMenuSheetOldUnassigned . Just $ CourseR tid ssh csh SheetListR
  breadcrumb (CourseR tid ssh csh CCommR    ) = i18nCrumb MsgMenuCourseCommunication . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CTutorialListR) = i18nCrumb MsgMenuTutorialList . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CTutorialNewR) = i18nCrumb MsgMenuTutorialNew . Just $ CourseR tid ssh csh CTutorialListR
  breadcrumb (CourseR tid ssh csh CFavouriteR) = i18nCrumb MsgBreadcrumbCourseFavourite . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CRegisterR)  = i18nCrumb MsgBreadcrumbCourseRegister . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CRegisterTemplateR) = i18nCrumb MsgBreadcrumbCourseRegisterTemplate . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CLecInviteR) = i18nCrumb MsgBreadcrumbLecturerInvite . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CDeleteR) = i18nCrumb MsgMenuCourseDelete . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CHiWisR) = i18nCrumb MsgBreadcrumbHiWis . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CNotesR) = i18nCrumb MsgBreadcrumbCourseNotes . Just $ CourseR tid ssh csh CShowR

  breadcrumb (CourseR tid ssh csh CNewsNewR)    = i18nCrumb MsgMenuCourseNewsNew . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh (CourseNewsR cID sRoute)) = case sRoute of
    CNShowR   -> i18nCrumb MsgBreadcrumbCourseNews . Just $ CourseR tid ssh csh CShowR
    CNEditR   -> i18nCrumb MsgMenuCourseNewsEdit . Just $ CNewsR tid ssh csh cID CNShowR
    CNDeleteR -> i18nCrumb MsgBreadcrumbCourseNewsDelete . Just $ CNewsR tid ssh csh cID CNShowR
    CNArchiveR -> i18nCrumb MsgBreadcrumbCourseNewsArchive . Just $ CNewsR tid ssh csh cID CNShowR
    CNFileR _ -> i18nCrumb MsgBreadcrumbCourseNewsFile . Just $ CNewsR tid ssh csh cID CNShowR

  breadcrumb (CourseR tid ssh csh CEventsNewR)    = i18nCrumb MsgMenuCourseEventNew . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh (CourseEventR _cID sRoute)) = case sRoute of
    CEvEditR   -> i18nCrumb MsgMenuCourseEventEdit . Just $ CourseR tid ssh csh CShowR
    CEvDeleteR -> i18nCrumb MsgBreadcrumbCourseEventDelete . Just $ CourseR tid ssh csh CShowR

  breadcrumb (CourseR tid ssh csh CExamListR) = i18nCrumb MsgMenuExamList . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CExamNewR) = i18nCrumb MsgMenuExamNew . Just $ CourseR tid ssh csh CExamListR

  breadcrumb (CourseR tid ssh csh CApplicationsR) = i18nCrumb MsgMenuCourseApplications . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh CAppsFilesR) = i18nCrumb MsgBreadcrumbCourseAppsFiles . Just $ CourseR tid ssh csh CApplicationsR

  breadcrumb (CourseR tid ssh csh (CourseApplicationR cID sRoute)) = case sRoute of
    CAEditR -> maybeT (i18nCrumb MsgBreadcrumbApplicant . Just $ CourseR tid ssh csh CApplicationsR) $ do
      guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
      appId <- decrypt cID
      User{..} <- hoist runDBRead $ MaybeT (get appId) >>= MaybeT . get . courseApplicationUser
      return (userDisplayName, Just $ CourseR tid ssh csh CApplicationsR)
    CAFilesR -> i18nCrumb MsgBreadcrumbApplicationFiles . Just $ CApplicationR tid ssh csh cID CAEditR

  breadcrumb (CourseR tid ssh csh (ExamR examn sRoute)) = case sRoute of
    EShowR    -> maybeT (i18nCrumb MsgBreadcrumbExam . Just $ CourseR tid ssh csh CExamListR) $ do
      guardM . hasReadAccessTo $ CExamR tid ssh csh examn EShowR
      return (CI.original examn, Just $ CourseR tid ssh csh CExamListR)
    EEditR    -> i18nCrumb MsgMenuExamEdit . Just $ CExamR tid ssh csh examn EShowR
    EUsersR   -> i18nCrumb MsgMenuExamUsers . Just $ CExamR tid ssh csh examn EShowR
    EAddUserR -> i18nCrumb MsgMenuExamAddMembers . Just $ CExamR tid ssh csh examn EUsersR
    EGradesR  -> i18nCrumb MsgMenuExamGrades . Just $ CExamR tid ssh csh examn EShowR
    ECInviteR  -> i18nCrumb MsgBreadcrumbExamCorrectorInvite . Just $ CExamR tid ssh csh examn EShowR
    EInviteR   -> i18nCrumb MsgBreadcrumbExamParticipantInvite . Just $ CExamR tid ssh csh examn EShowR
    ERegisterR -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
    ERegisterOccR _occn -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
    EAutoOccurrenceR -> i18nCrumb MsgBreadcrumbExamAutoOccurrence . Just $ CExamR tid ssh csh examn EUsersR
    ECorrectR  -> i18nCrumb MsgMenuExamCorrect . Just $ CExamR tid ssh csh examn EShowR

  breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
    TUsersR  -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
      guardM . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
      return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
    TEditR   -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
    TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
    TCommR   -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR
    TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR
    TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR

  breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
    SShowR -> maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do
      guardM . hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
      return (CI.original shn, Just $ CourseR tid ssh csh SheetListR)
    SEditR -> i18nCrumb MsgMenuSheetEdit . Just $ CSheetR tid ssh csh shn SShowR
    SDelR  -> i18nCrumb MsgMenuSheetDelete . Just $ CSheetR tid ssh csh shn SShowR
    SSubsR -> i18nCrumb MsgMenuSubmissions . Just $ CSheetR tid ssh csh shn SShowR
    SAssignR -> i18nCrumb MsgMenuCorrectionsAssign . Just $ CSheetR tid ssh csh shn SSubsR
    SubmissionNewR -> i18nCrumb MsgMenuSubmissionNew . Just $ CSheetR tid ssh csh shn SShowR
    SubmissionOwnR -> i18nCrumb MsgMenuSubmissionOwn . Just $ CSheetR tid ssh csh shn SShowR
    SubmissionR cid sRoute' -> case sRoute' of
      SubShowR -> do
        mayList <- hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
        if
          | mayList
            -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SSubsR
          | otherwise
            -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SShowR
      CorrectionR -> i18nCrumb MsgMenuCorrection . Just $ CSubmissionR tid ssh csh shn cid SubShowR
      SubDelR -> i18nCrumb MsgMenuSubmissionDelete . Just $ CSubmissionR tid ssh csh shn cid SubShowR
      SubAssignR -> i18nCrumb MsgCorrectorAssignTitle . Just $ CSubmissionR tid ssh csh shn cid SubShowR
      SInviteR -> i18nCrumb MsgBreadcrumbSubmissionUserInvite . Just $ CSubmissionR tid ssh csh shn cid SubShowR
      SubArchiveR sft -> i18nCrumb sft . Just $ CSubmissionR tid ssh csh shn cid SubShowR
      SubDownloadR _ _ -> i18nCrumb MsgBreadcrumbSubmissionFile . Just $ CSubmissionR tid ssh csh shn cid SubShowR
    SArchiveR -> i18nCrumb MsgBreadcrumbSheetArchive . Just $ CSheetR tid ssh csh shn SShowR
    SIsCorrR -> i18nCrumb MsgBreadcrumbSheetIsCorrector . Just $ CSheetR tid ssh csh shn SShowR
    SPseudonymR -> i18nCrumb MsgBreadcrumbSheetPseudonym . Just $ CSheetR tid ssh csh shn SShowR
    SCorrInviteR -> i18nCrumb MsgBreadcrumbSheetCorrectorInvite . Just $ CSheetR tid ssh csh shn SShowR
    SZipR sft -> i18nCrumb sft . Just $ CSheetR tid ssh csh shn SShowR
    SFileR _ _ -> i18nCrumb MsgBreadcrumbSheetFile . Just $ CSheetR tid ssh csh shn SShowR
    SPersonalFilesR -> i18nCrumb MsgBreadcrumbSheetPersonalisedFiles . Just $ CSheetR tid ssh csh shn SShowR

  breadcrumb (CourseR tid ssh csh MaterialListR) = i18nCrumb MsgMenuMaterialList . Just $ CourseR tid ssh csh CShowR
  breadcrumb (CourseR tid ssh csh MaterialNewR ) = i18nCrumb MsgMenuMaterialNew . Just $ CourseR tid ssh csh MaterialListR
  breadcrumb (CourseR tid ssh csh (MaterialR mnm sRoute)) = case sRoute of
    MShowR -> maybeT (i18nCrumb MsgBreadcrumbMaterial . Just $ CourseR tid ssh csh MaterialListR) $ do
      guardM . hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
      return (CI.original mnm, Just $ CourseR tid ssh csh MaterialListR)
    MEditR -> i18nCrumb MsgMenuMaterialEdit . Just $ CMaterialR tid ssh csh mnm MShowR
    MDelR  -> i18nCrumb MsgMenuMaterialDelete . Just $ CMaterialR tid ssh csh mnm MShowR
    MArchiveR -> i18nCrumb MsgBreadcrumbMaterialArchive . Just $ CMaterialR tid ssh csh mnm MShowR
    MFileR _ -> i18nCrumb MsgBreadcrumbMaterialFile . Just $ CMaterialR tid ssh csh mnm MShowR
    MVideoR _ -> i18nCrumb MsgBreadcrumbMaterialVideo . Just $ CMaterialR tid ssh csh mnm MShowR

  breadcrumb (CourseR tid ssh csh CPersonalFilesR) = i18nCrumb MsgBreadcrumbCourseSheetPersonalisedFiles . Just $ CourseR tid ssh csh CShowR

  breadcrumb CorrectionsR         = i18nCrumb MsgMenuCorrections Nothing
  breadcrumb CorrectionsUploadR   = i18nCrumb MsgMenuCorrectionsUpload $ Just CorrectionsR
  breadcrumb CorrectionsCreateR   = i18nCrumb MsgMenuCorrectionsCreate $ Just CorrectionsR
  breadcrumb CorrectionsGradeR    = i18nCrumb MsgMenuCorrectionsGrade $ Just CorrectionsR
  breadcrumb CorrectionsDownloadR = i18nCrumb MsgMenuCorrectionsDownload $ Just CorrectionsR

  breadcrumb (CryptoUUIDDispatchR _) = i18nCrumb MsgBreadcrumbCryptoIDDispatch Nothing

  breadcrumb (MessageR _) = do
    mayList <- (== Authorized) <$> evalAccess MessageListR False
    if
      | mayList   -> i18nCrumb MsgBreadcrumbSystemMessage $ Just MessageListR
      | otherwise -> i18nCrumb MsgBreadcrumbSystemMessage $ Just NewsR
  breadcrumb MessageListR = i18nCrumb MsgMenuMessageList $ Just AdminR
  breadcrumb (MessageHideR cID) = i18nCrumb MsgBreadcrumbMessageHide . Just $ MessageR cID

  breadcrumb GlossaryR = i18nCrumb MsgMenuGlossary $ Just InfoR

  breadcrumb EExamListR = i18nCrumb MsgMenuExternalExamList Nothing
  breadcrumb EExamNewR = do
    isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
    i18nCrumb MsgBreadcrumbExternalExamNew . Just $ if
      | isEO -> ExamOfficeR EOExamsR
      | otherwise -> EExamListR
  breadcrumb (EExamR tid ssh coursen examn sRoute) = case sRoute of
    EEShowR -> do
      isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
      maybeT (i18nCrumb MsgBreadcrumbExternalExam . Just $ bool EExamListR (ExamOfficeR EOExamsR) isEO) $ do
        guardM . hasReadAccessTo $ EExamR tid ssh coursen examn EEShowR
        i18nCrumb (MsgBreadcrumbExternalExamShow coursen examn) . Just $ if
          | isEO -> ExamOfficeR EOExamsR
          | otherwise -> EExamListR
    EEEditR -> i18nCrumb MsgBreadcrumbExternalExamEdit . Just $ EExamR tid ssh coursen examn EEShowR
    EEUsersR -> i18nCrumb MsgBreadcrumbExternalExamUsers . Just $ EExamR tid ssh coursen examn EEShowR
    EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR
    EEStaffInviteR -> i18nCrumb MsgBreadcrumbExternalExamStaffInvite . Just $ EExamR tid ssh coursen examn EEShowR
    EECorrectR -> i18nCrumb MsgBreadcrumbExternalExamCorrect . Just $ EExamR tid ssh coursen examn EEShowR

  breadcrumb AdminWorkflowDefinitionListR = i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionList $ Just AdminR
  breadcrumb AdminWorkflowDefinitionNewR = i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionNew $ Just AdminWorkflowDefinitionListR
  breadcrumb (AdminWorkflowDefinitionR wfdScope wfdName sRoute) = case sRoute of
    AWDEditR -> do
      MsgRenderer mr <- getMsgRenderer
      i18nCrumb (MsgBreadcrumbAdminWorkflowDefinitionEdit (mr wfdScope) wfdName) $ Just AdminWorkflowDefinitionListR
    AWDDeleteR -> i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionDelete . Just $ AdminWorkflowDefinitionR wfdScope wfdName AWDEditR
    AWDInstantiateR -> i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionInstantiate . Just $ AdminWorkflowDefinitionR wfdScope wfdName AWDEditR
  breadcrumb AdminWorkflowInstanceListR = i18nCrumb MsgBreadcrumbAdminWorkflowInstanceList $ Just AdminWorkflowDefinitionListR
  breadcrumb AdminWorkflowInstanceNewR = i18nCrumb MsgBreadcrumbAdminWorkflowInstanceNew $ Just AdminWorkflowInstanceListR
  breadcrumb (AdminWorkflowInstanceR _cID sRoute) = case sRoute of
    AWIEditR -> i18nCrumb MsgBreadcrumbAdminWorkflowInstanceEdit $ Just AdminWorkflowInstanceListR
  breadcrumb AdminWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbAdminWorkflowWorkflowList $ Just AdminWorkflowInstanceListR
  breadcrumb AdminWorkflowWorkflowNewR = i18nCrumb MsgBreadcrumbAdminWorkflowWorkflowNew $ Just AdminWorkflowWorkflowListR

  breadcrumb GlobalWorkflowInstanceListR = i18nCrumb MsgBreadcrumbGlobalWorkflowInstanceList Nothing
  breadcrumb GlobalWorkflowInstanceNewR = i18nCrumb MsgBreadcrumbWorkflowInstanceNew $ Just GlobalWorkflowInstanceListR
  breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of
    GWIEditR -> i18nCrumb (MsgBreadcrumbWorkflowInstanceEdit win) $ Just GlobalWorkflowInstanceListR
    GWIDeleteR -> i18nCrumb MsgBreadcrumbWorkflowInstanceDelete . Just $ GlobalWorkflowInstanceR win GWIEditR
    GWIWorkflowsR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowList . Just $ GlobalWorkflowInstanceR win GWIEditR
    GWIInitiateR -> do
      mayEdit <- hasReadAccessTo $ GlobalWorkflowInstanceR win GWIEditR
      i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just $ if
        | mayEdit -> GlobalWorkflowInstanceR win GWIEditR
        | otherwise -> GlobalWorkflowInstanceListR
  breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR
  breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of
    GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowWorkflowListR
    GWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR
    GWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR
    GWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR

  breadcrumb TopWorkflowInstanceListR = i18nCrumb MsgBreadcrumbTopWorkflowInstanceList Nothing
  breadcrumb TopWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbTopWorkflowWorkflowList $ Just TopWorkflowInstanceListR


data NavQuickView
  = NavQuickViewFavourite
  | NavQuickViewPageActionSecondary
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
  deriving (Universe, Finite)

navQuick :: NavQuickView -> (NavQuickView -> Any)
navQuick x x' = Any $ x == x'

data NavType
  = NavTypeLink
    { navModal  :: Bool
    }
  | NavTypeButton
    { navMethod :: StdMethod
    , navData   :: [(Text, Text)]
    }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Binary)

makeLenses_ ''NavType
makePrisms ''NavType

data NavLevel = NavLevelTop | NavLevelInner
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

data NavHeaderRole = NavHeaderPrimary | NavHeaderSecondary
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

data NavLink = forall msg route. (RenderMessage UniWorX msg, HasRoute UniWorX route, RedirectUrl UniWorX route) => NavLink
  { navLabel       :: msg
  , navRoute       :: route
  , navDownload    :: Maybe (Maybe (ConduitT () (Either FileReference DBFile) Handler ()))
  , navAccess'     :: Handler Bool
  , navType        :: NavType
  , navQuick'      :: NavQuickView -> Any
  , navForceActive :: Bool
  }

makeLenses_ ''NavLink

-- instance HasRoute UniWorX NavLink where
--   urlRoute NavLink{..} = urlRoute navRoute
-- instance RedirectUrl UniWorX NavLink where
--   toTextUrl NavLink{..} = toTextUrl navRoute
instance RenderMessage UniWorX NavLink where
  renderMessage app ls NavLink{..} = renderMessage app ls navLabel

navBaseRoute :: NavLink -> Route UniWorX
navBaseRoute NavLink{navRoute} = urlRoute navRoute

navLinkRoute :: ( MonadHandler m, HandlerSite m ~ UniWorX
                , MonadCrypto m
                , MonadCryptoKey m ~ CryptoIDKey
                , YesodAuthPersist UniWorX, AuthEntity UniWorX ~ User, AuthId UniWorX ~ UserId
                )
             => NavLink -> m (SomeRoute UniWorX)
navLinkRoute NavLink{..} = case navDownload of
  Nothing -> return $ SomeRoute navRoute
  Just mSource -> withFileDownloadTokenMaybe' (transPipe liftHandler <$> mSource) navRoute

data Nav
  = NavHeader
    { navHeaderRole :: NavHeaderRole
    , navIcon       :: Icon
    , navLink       :: NavLink
    }
  | NavHeaderContainer
    { navHeaderRole :: NavHeaderRole
    , navLabel      :: SomeMessage UniWorX
    , navIcon       :: Icon
    , navChildren   :: [NavLink]
    }
  | NavPageActionPrimary
    { navLink     :: NavLink
    , navChildren :: [NavLink]
    }
  | NavPageActionSecondary
    { navLink :: NavLink
    }
  | NavFooter
    { navLink :: NavLink
    } deriving (Generic, Typeable)

makeLenses_ ''Nav
makePrisms ''Nav

data NavChildren
type instance Children NavChildren a = ChildrenNavChildren a
type family ChildrenNavChildren a where
  ChildrenNavChildren (SomeMessage UniWorX) = '[]

  ChildrenNavChildren a = Children ChGeneric a

navAccess :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, BearerAuthSite UniWorX) => Nav -> MaybeT m Nav
navAccess = execStateT $ do
  guardM $ preuse _navLink >>= maybe (return True) navLinkAccess

  _navChildren <~ (filterM navLinkAccess =<< use _navChildren)
  whenM (hasn't _navLink <$> use id) $
    guardM $ not . null <$> use _navChildren

navLinkAccess :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, BearerAuthSite UniWorX) => NavLink -> m Bool
navLinkAccess NavLink{..} = handle shortCircuit $ liftHandler navAccess' `and2M` accessCheck navType navRoute
  where
    shortCircuit :: HandlerContents -> m Bool
    shortCircuit _ = return False

    accessCheck :: HasRoute UniWorX route => NavType -> route -> m Bool
    accessCheck nt (urlRoute -> route) = do
      authCtx <- getAuthContext
      $memcachedByHere (Just $ Right 120) (authCtx, nt, route) $
        bool hasWriteAccessTo hasReadAccessTo (is _NavTypeLink nt) route
  
defaultLinks :: ( MonadHandler m
                , HandlerSite m ~ UniWorX
                , BearerAuthSite UniWorX
                , BackendCompatible SqlReadBackend (YesodPersistBackend UniWorX)
                ) => m [Nav]
defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the header.
  [ return NavHeader
      { navHeaderRole = NavHeaderSecondary
      , navIcon       = IconMenuLogout
      , navLink       = NavLink
        { navLabel       = MsgMenuLogout
        , navRoute       = AuthR LogoutR
        , navDownload    = Nothing
        , navAccess'     = is _Just <$> maybeAuthId
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , return NavHeader
      { navHeaderRole = NavHeaderSecondary
      , navIcon       = IconMenuLogin
      , navLink       = NavLink
        { navLabel       = MsgMenuLogin
        , navRoute       = AuthR LoginR
        , navDownload    = Nothing
        , navAccess'     = is _Nothing <$> maybeAuthId
        , navType        = NavTypeLink { navModal = True }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , return NavHeader
      { navHeaderRole = NavHeaderSecondary
      , navIcon       = IconMenuProfile
      , navLink       = NavLink
        { navLabel       = MsgMenuProfile
        , navRoute       = ProfileR
        , navDownload    = Nothing
        , navAccess'     = is _Just <$> maybeAuthId
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , do
      mCurrentRoute <- getCurrentRoute

      activeLang <- selectLanguage appLanguages

      let navChildren = flip map (toList appLanguages) $ \lang -> NavLink
            { navLabel       = MsgLanguage lang
            , navRoute       = (LangR, [(toPathPiece GetReferer, toPathPiece currentRoute) | currentRoute <- hoistMaybe mCurrentRoute ])
            , navDownload    = Nothing
            , navAccess'     = return True
            , navType        = NavTypeButton
              { navMethod = POST
              , navData   = [(toPathPiece PostLanguage, lang)]
              }
            , navQuick'      = mempty
            , navForceActive = lang == activeLang
            }

      guard $ length navChildren > 1

      return NavHeaderContainer
        { navHeaderRole = NavHeaderSecondary
        , navLabel      = SomeMessage MsgMenuLanguage
        , navIcon       = IconLanguage
        , navChildren
        }
  , do
      mCurrentRoute <- getCurrentRoute

      return NavHeader
        { navHeaderRole = NavHeaderSecondary
        , navIcon       = IconMenuHelp
        , navLink       = NavLink
          { navLabel       = MsgMenuHelp
          , navRoute       = (HelpR, [(toPathPiece GetReferer, toPathPiece currentRoute) | currentRoute <- hoistMaybe mCurrentRoute ])
          , navDownload    = Nothing
          , navAccess'     = return True
          , navType        = NavTypeLink { navModal = True }
          , navQuick'      = mempty
          , navForceActive = False
          }
        }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuDataProt
      , navRoute       = LegalR :#: ("data-protection" :: Text)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuTermsUse
      , navRoute       = LegalR :#: ("terms-of-use" :: Text)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuCopyright
      , navRoute       = LegalR :#: ("copyright" :: Text)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuImprint
      , navRoute       = LegalR :#: ("imprint" :: Text)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuInformation
      , navRoute       = InfoR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuFaq
      , navRoute       = FaqR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return $ NavFooter NavLink
      { navLabel       = MsgMenuGlossary
      , navRoute       = GlossaryR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
  , return NavHeader
      { navHeaderRole = NavHeaderPrimary
      , navIcon       = IconMenuNews
      , navLink       = NavLink
        { navLabel       = MsgMenuNews
        , navRoute       = NewsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , return NavHeader
      { navHeaderRole = NavHeaderPrimary
      , navIcon       = IconMenuCourseList
      , navLink       = NavLink
        { navLabel       = MsgMenuCourseList
        , navRoute       = CourseListR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , return NavHeader
      { navHeaderRole = NavHeaderPrimary
      , navIcon       = IconMenuCorrections
      , navLink       = NavLink
        { navLabel       = MsgMenuCorrections
        , navRoute       = CorrectionsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , return NavHeader
      { navHeaderRole = NavHeaderPrimary
      , navIcon       = IconMenuExams
      , navLink       = NavLink
        { navLabel       = MsgMenuExamOfficeExams
        , navRoute       = ExamOfficeR EOExamsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
  , do
      (haveInstances, haveWorkflows) <- liftHandler . runDB $ (,)
        <$> haveTopWorkflowInstances
        <*> haveTopWorkflowWorkflows

      if | haveInstances -> return NavHeader
             { navHeaderRole = NavHeaderPrimary
             , navIcon       = IconMenuWorkflows
             , navLink       = NavLink
               { navLabel       = MsgMenuTopWorkflowInstanceList
               , navRoute       = TopWorkflowInstanceListR
               , navDownload    = Nothing
               , navAccess'     = return True
               , navType        = NavTypeLink { navModal = False }
               , navQuick'      = mempty
               , navForceActive = False
               }
             }
         | haveWorkflows -> return NavHeader
             { navHeaderRole = NavHeaderPrimary
             , navIcon       = IconMenuWorkflows
             , navLink       = NavLink
               { navLabel       = MsgMenuTopWorkflowWorkflowListHeader
               , navRoute       = TopWorkflowWorkflowListR
               , navDownload    = Nothing
               , navAccess'     = return True
               , navType        = NavTypeLink { navModal = False }
               , navQuick'      = mempty
               , navForceActive = False
               }
             }
         | otherwise -> mzero
  , return NavHeaderContainer
      { navHeaderRole = NavHeaderPrimary
      , navLabel      = SomeMessage MsgAdminHeading
      , navIcon       = IconMenuAdmin
      , navChildren   =
          [ NavLink
              { navLabel       = MsgMenuUsers
              , navRoute       = UsersR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuSchoolList
              , navRoute       = SchoolListR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgAdminFeaturesHeading
              , navRoute       = AdminFeaturesR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuMessageList
              , navRoute       = MessageListR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuAdminErrMsg
              , navRoute       = AdminErrMsgR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuAdminTokens
              , navRoute       = AdminTokensR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuAdminWorkflowDefinitionList
              , navRoute       = AdminWorkflowDefinitionListR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuAdminCrontab
              , navRoute       = AdminCrontabR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuAdminTest
              , navRoute       = AdminTestR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          ]
      }
  , return NavHeaderContainer
      { navHeaderRole = NavHeaderPrimary
      , navLabel      = SomeMessage (mempty :: Text)
      , navIcon       = IconMenuExtra
      , navChildren   =
          [ NavLink
              { navLabel       = MsgMenuCourseNew
              , navRoute       = CourseNewR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuExternalExamList
              , navRoute       = EExamListR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuTermShow
              , navRoute       = TermShowR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgMenuAllocationList
              , navRoute       = AllocationListR
              , navDownload    = Nothing
              , navAccess'     = return True
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          , NavLink
              { navLabel       = MsgInfoLecturerTitle
              , navRoute       = InfoLecturerR
              , navDownload    = Nothing
              , navAccess'     = hasWriteAccessTo CourseNewR
              , navType        = NavTypeLink { navModal = False }
              , navQuick'      = mempty
              , navForceActive = False
              }
          ]
      }
  ]

pageActions :: ( MonadHandler m
               , HandlerSite m ~ UniWorX
               , MonadCatch m
               , BearerAuthSite UniWorX
               , BackendCompatible SqlReadBackend (YesodPersistBackend UniWorX)
               )
            => Route UniWorX -> m [Nav]
pageActions NewsR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuOpenCourses
      , navRoute       = (CourseListR, [("courses-openregistration", toPathPiece True)])
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuOpenAllocations
      , navRoute       = (AllocationListR, [("allocations-active", toPathPiece True)])
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CourseR tid ssh csh CShowR) = do
  materialListSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh MaterialListR
  tutorialListSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CTutorialListR
  sheetListSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh SheetListR
  examListSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CExamListR
  membersSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CUsersR

  let examListBound :: Num a => a
      examListBound = 4 -- guaranteed random; chosen by fair dice roll
  examListExams <- liftHandler . runDBRead $ do
    examNames <- E.select . E.from $ \(course `E.InnerJoin` exam) -> do
      E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
      E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
           E.&&. course   E.^. CourseSchool    E.==. E.val ssh
           E.&&. course   E.^. CourseShorthand E.==. E.val csh
      E.limit $ succ examListBound
      return $ exam E.^. ExamName
    return $ do
      E.Value examn <- examNames
      return NavLink
        { navLabel       = examn
        , navRoute       = CExamR tid ssh csh examn EShowR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewFavourite
        , navForceActive = False
        }
  let showExamList = length examListExams <= examListBound

  let
    navMembers = NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseMembers
        , navRoute       = CourseR tid ssh csh CUsersR
        , navDownload    = Nothing
        , navAccess' =
            let courseWhere course = course <$ do
                  E.where_ $ course E.^. CourseTerm      E.==. E.val tid
                       E.&&. course E.^. CourseSchool    E.==. E.val ssh
                       E.&&. course E.^. CourseShorthand E.==. E.val csh
                hasParticipants = E.selectExists . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
                  E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
                  E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
                  void $ courseWhere course
                mayRegister = hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
             in runDBRead $ mayRegister `or2M` hasParticipants
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = membersSecondary
      }
  showMembers <- maybeT (return False) $ True <$ navAccess navMembers

  return $
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuMaterialList
        , navRoute       = CourseR tid ssh csh MaterialListR
        , navDownload    = Nothing
        , navAccess' =
            let lecturerAccess     = hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR  -- Always show for lecturers to create new material
                materialAccess mnm = hasReadAccessTo  $ CMaterialR tid ssh csh mnm MShowR -- otherwise show only if the user can see at least one of the contents
                existsVisible  = do
                    matNames <- E.select . E.from $ \(course `E.InnerJoin` material) -> do
                      E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
                      E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
                          E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
                          E.&&.  course   E.^. CourseShorthand E.==. E.val csh
                      return $ material E.^. MaterialName
                    anyM matNames (materialAccess . E.unValue)
             in runDBRead $ lecturerAccess `or2M` existsVisible
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = materialListSecondary
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetList
        , navRoute       = CourseR tid ssh csh SheetListR
        , navDownload    = Nothing
        , navAccess' =
            let lecturerAccess  = hasWriteAccessTo $ CourseR tid ssh csh SheetNewR  -- Always show for lecturers to create new sheets
                sheetAccess shn = hasReadAccessTo  $ CSheetR tid ssh csh shn SShowR -- othwerwise show only if the user can see at least one of the contents
                existsVisible  = do
                    sheetNames <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
                      E.on     $ course   E.^. CourseId   E.==.   sheet E.^. SheetCourse
                      E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
                          E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
                          E.&&.  course   E.^. CourseShorthand E.==. E.val csh
                      return $ sheet E.^. SheetName
                    anyM sheetNames $ sheetAccess . E.unValue
             in runDBRead $ lecturerAccess `or2M` existsVisible
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = sheetListSecondary
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuTutorialList
        , navRoute       = CourseR tid ssh csh CTutorialListR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = tutorialListSecondary
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExamList
        , navRoute       = CourseR tid ssh csh CExamListR
        , navDownload    = Nothing
        , navAccess' =
            let lecturerAccess   = hasWriteAccessTo $ CourseR tid ssh csh CExamNewR
                examAccess examn = hasReadAccessTo  $ CExamR tid ssh csh examn EShowR
                existsVisible = do
                  examNames <- E.select . E.from $ \(course `E.InnerJoin` exam) -> do
                    E.on     $ course   E.^. CourseId E.==. exam E.^. ExamCourse
                    E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
                        E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
                        E.&&.  course   E.^. CourseShorthand E.==. E.val csh
                    return $ exam E.^. ExamName
                  anyM examNames $ examAccess . E.unValue
             in runDBRead $ lecturerAccess `or2M` existsVisible
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = bool (navQuick NavQuickViewFavourite) mempty showExamList
        , navForceActive = False
        }
      , navChildren = examListSecondary ++ guardOnM showExamList examListExams
      }
    , navMembers
    ] ++ guardOnM (not showMembers) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- membersSecondary ] ++
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseCommunication
        , navRoute       = CourseR tid ssh csh CCommR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionSecondary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseExamOffice
        , navRoute       = CourseR tid ssh csh CExamOfficeR
        , navDownload    = Nothing
        , navAccess' = do
            uid <- requireAuthId
            runDBRead $ do
              cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
              E.selectExists $ do
                (_school, isForced) <- courseExamOfficeSchools (E.val uid) (E.val cid)
                E.where_ $ E.not_ isForced
        , navType        = NavTypeLink { navModal = True }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
    , NavPageActionSecondary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseEdit
        , navRoute       = CourseR tid ssh csh CEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
    , NavPageActionSecondary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseClone
        , navRoute       = ( CourseNewR
                           , [("tid", toPathPiece tid), ("ssh", toPathPiece ssh), ("csh", toPathPiece csh)]
                           )
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
    , NavPageActionSecondary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseDelete
        , navRoute       = CourseR tid ssh csh CDeleteR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
    ]
pageActions (ExamOfficeR EOExamsR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamOfficeFields
      , navRoute       = ExamOfficeR EOFieldsR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamOfficeUsers
      , navRoute       = ExamOfficeR EOUsersR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions SchoolListR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuSchoolNew
      , navRoute       = SchoolNewR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions UsersR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuLecturerInvite
      , navRoute       = AdminNewFunctionaryInviteR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuUserAdd
      , navRoute       = AdminUserAddR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (AdminUserR cID) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuUserNotifications
      , navRoute       = UserNotificationR cID
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuUserPassword
      , navRoute       = UserPasswordR cID
      , navDownload    = Nothing
      , navAccess' = do
          uid <- decrypt cID
          User{userAuthentication} <- runDBRead $ get404 uid
          return $ is _AuthPWHash userAuthentication
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions InfoR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgInfoLecturerTitle
      , navRoute       = InfoLecturerR
      , navDownload    = Nothing
      , navAccess'     = hasWriteAccessTo CourseNewR
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuLegal
      , navRoute       = LegalR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuFaq
      , navRoute       = FaqR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuGlossary
      , navRoute       = GlossaryR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions VersionR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgInfoLecturerTitle
      , navRoute       = InfoLecturerR
      , navDownload    = Nothing
      , navAccess'     = hasWriteAccessTo CourseNewR
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuLegal
      , navRoute       = LegalR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuFaq
      , navRoute       = FaqR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuGlossary
      , navRoute       = GlossaryR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions HealthR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuInstance
      , navRoute       = InstanceR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions InstanceR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuHealth
      , navRoute       = HealthR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions HelpR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuFaq
      , navRoute       = FaqR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgInfoLecturerTitle
      , navRoute       = InfoLecturerR
      , navDownload    = Nothing
      , navAccess'     = hasWriteAccessTo CourseNewR
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = do
        (section, navLabel) <-
          [ ("courses", MsgInfoLecturerCourses)
          , ("exercises", MsgInfoLecturerExercises)
          , ("tutorials", MsgInfoLecturerTutorials)
          , ("exams", MsgInfoLecturerExams)
          , ("allocations", MsgInfoLecturerAllocations)
          ] :: [(Text, UniWorXMessage)]
        return NavLink
          { navLabel
          , navRoute       = InfoLecturerR :#: section
          , navDownload    = Nothing
          , navAccess'     = return True
          , navType        = NavTypeLink { navModal = False }
          , navQuick'      = mempty
          , navForceActive = False
          }
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuGlossary
      , navRoute       = GlossaryR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions ProfileR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuProfileData
      , navRoute       = ProfileDataR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAuthPreds
      , navRoute       = AuthPredsR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgCsvOptions
      , navRoute       = CsvOptionsR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions TermShowR = do
  participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR
  return
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuTermCreate
        , navRoute       = TermEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuParticipantsList
        , navRoute       = ParticipantsListR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = participantsSecondary
      }
    ]
pageActions (AllocationR tid ssh ash AShowR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAllocationInfo
      , navRoute       = InfoAllocationR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAllocationUsers
      , navRoute       = AllocationR tid ssh ash AUsersR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAllocationCompute
      , navRoute       = AllocationR tid ssh ash AComputeR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (AllocationR tid ssh ash AUsersR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAllocationPriorities
      , navRoute       = AllocationR tid ssh ash APriosR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAllocationCompute
      , navRoute       = AllocationR tid ssh ash AComputeR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAllocationAddUser
      , navRoute       = AllocationR tid ssh ash AAddUserR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions CourseListR = do
  participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR
  return
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuCourseNew
        , navRoute       = CourseNewR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuAllocationList
        , navRoute       = AllocationListR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuParticipantsList
        , navRoute       = ParticipantsListR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = participantsSecondary
      }
    ]
pageActions CourseNewR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgInfoLecturerTitle
      , navRoute       = InfoLecturerR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CourseR tid ssh csh CCorrectionsR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsAssign
      , navRoute       = CourseR tid ssh csh CAssignR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsOwn
      , navRoute       = ( CorrectionsR
                         , [ ("corrections-term", toPathPiece tid)
                           , ("corrections-school", toPathPiece ssh)
                           , ("corrections-course", toPathPiece csh)
                           ]
                         )
      , navDownload    = Nothing
      , navAccess' = do
          muid <- maybeAuthId
          case muid of
            Nothing -> return False
            (Just uid) -> do
              runDBRead . E.selectExists . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do
                E.on $ submission E.^. SubmissionSheet E.==. sheet  E.^. SheetId
                E.on $ sheet      E.^. SheetCourse     E.==. course E.^. CourseId
                E.where_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
                  E.&&. course E.^. CourseTerm      E.==. E.val tid
                  E.&&. course E.^. CourseSchool    E.==. E.val ssh
                  E.&&. course E.^. CourseShorthand E.==. E.val csh
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CourseR tid ssh csh SheetListR) = do
  correctionsSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CCorrectionsR

  let
    navCorrections = NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSubmissions
        , navRoute       = CourseR tid ssh csh CCorrectionsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = correctionsSecondary
      }
  showCorrections <- maybeT (return False) $ True <$ navAccess navCorrections

  return $
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetCurrent
        , navRoute       = CourseR tid ssh csh SheetCurrentR
        , navDownload    = Nothing
        , navAccess' =
            runDBRead . maybeT (return False) $ do
              void . MaybeT $ sheetCurrent tid ssh csh
              return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetOldUnassigned
        , navRoute       = CourseR tid ssh csh SheetOldUnassignedR
        , navDownload    = Nothing
        , navAccess' =
            runDBRead . maybeT (return False) $ do
              void . MaybeT $ sheetOldUnassigned tid ssh csh
              return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = []
      }
    , navCorrections
    ] ++ guardOnM (not showCorrections) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- correctionsSecondary ] ++
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetNew
        , navRoute       = CourseR tid ssh csh SheetNewR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
        , navForceActive = False
        }
      , navChildren = []
      }
    ]
pageActions (CourseR tid ssh csh CUsersR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCourseAddMembers
      , navRoute       = CourseR tid ssh csh CAddUserR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCourseApplications
      , navRoute       = CourseR tid ssh csh CApplicationsR
      , navDownload    = Nothing
      , navAccess' =
          let courseWhere course = course <$ do
                E.where_ $ course E.^. CourseTerm      E.==. E.val tid
                     E.&&. course E.^. CourseSchool    E.==. E.val ssh
                     E.&&. course E.^. CourseShorthand E.==. E.val csh
              existsApplications = E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
                E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
                void $ courseWhere course
              courseApplications = fmap (any E.unValue) . E.select . E.from $ \course -> do
                void $ courseWhere course
                return $ course E.^. CourseApplicationsRequired
              courseAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
                E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
                void $ courseWhere course
           in runDBRead $ courseAllocation `or2M` courseApplications `or2M` existsApplications
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CourseR tid ssh csh MaterialListR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuMaterialNew
      , navRoute       = CourseR tid ssh csh MaterialNewR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CMaterialR tid ssh csh mnm MShowR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuMaterialEdit
      , navRoute       = CMaterialR tid ssh csh mnm MEditR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuMaterialDelete
      , navRoute       = CMaterialR tid ssh csh mnm MDelR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions (CourseR tid ssh csh CTutorialListR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuTutorialNew
      , navRoute       = CourseR tid ssh csh CTutorialNewR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CTutorialR tid ssh csh tutn TEditR) = return
  [ NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuTutorialDelete
      , navRoute       = CTutorialR tid ssh csh tutn TDeleteR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions (CTutorialR tid ssh csh tutn TUsersR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuTutorialComm
      , navRoute       = CTutorialR tid ssh csh tutn TCommR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuTutorialEdit
      , navRoute       = CTutorialR tid ssh csh tutn TEditR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuTutorialDelete
      , navRoute       = CTutorialR tid ssh csh tutn TDeleteR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions (CourseR tid ssh csh CExamListR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamNew
      , navRoute       = CourseR tid ssh csh CExamNewR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CExamR tid ssh csh examn EShowR) = do
  usersSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CExamR tid ssh csh examn EUsersR

  return
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExamEdit
        , navRoute       = CExamR tid ssh csh examn EEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExamUsers
        , navRoute       = CExamR tid ssh csh examn EUsersR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = usersSecondary
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExamGrades
        , navRoute       = CExamR tid ssh csh examn EGradesR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExamCorrect
        , navRoute       = CExamR tid ssh csh examn ECorrectR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    ]
pageActions (CExamR tid ssh csh examn ECorrectR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamUsers
      , navRoute       = CExamR tid ssh csh examn EUsersR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamGrades
      , navRoute       = CExamR tid ssh csh examn EGradesR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuExamEdit
      , navRoute       = CExamR tid ssh csh examn EEditR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions (CExamR tid ssh csh examn EUsersR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamAddMembers
      , navRoute       = CExamR tid ssh csh examn EAddUserR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamGrades
      , navRoute       = CExamR tid ssh csh examn EGradesR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamCorrect
      , navRoute       = CExamR tid ssh csh examn ECorrectR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CExamR tid ssh csh examn EGradesR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamUsers
      , navRoute       = CExamR tid ssh csh examn EUsersR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuExamCorrect
      , navRoute       = CExamR tid ssh csh examn ECorrectR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CSheetR tid ssh csh shn SShowR) = do
  subsSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CSheetR tid ssh csh shn SSubsR
  let
    navSubmissions = NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSubmissions
        , navRoute       = CSheetR tid ssh csh shn SSubsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = subsSecondary
      }
  showSubmissions <- maybeT (return False) $ True <$ navAccess navSubmissions

  return $
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSubmissionOwn
        , navRoute       = CSheetR tid ssh csh shn SubmissionOwnR
        , navDownload    = Nothing
        , navAccess' =
            runDBRead . maybeT (return False) $ do
              uid <- MaybeT $ liftHandler maybeAuthId
              submissions <- lift $ submissionList tid csh shn uid
              guard . not $ null submissions
              return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , navSubmissions
    ] ++ guardOnM (not showSubmissions) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- subsSecondary ] ++
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetPersonalisedFiles
        , navRoute       = CSheetR tid ssh csh shn SPersonalFilesR
        , navDownload    = Nothing
        , navAccess'     =
            let onlyPersonalised = fmap (maybe False $ not . E.unValue) . E.selectMaybe . E.from $ \(sheet `E.InnerJoin` course) -> do
                  E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
                  E.where_$ sheet E.^. SheetName E.==. E.val shn
                      E.&&. course E.^. CourseTerm E.==. E.val tid
                      E.&&. course E.^. CourseSchool E.==. E.val ssh
                      E.&&. course E.^. CourseShorthand E.==. E.val csh
                  return $ sheet E.^. SheetAllowNonPersonalisedSubmission
                hasPersonalised = E.selectExists . E.from $ \(sheet `E.InnerJoin` course `E.InnerJoin` personalisedSheetFile) -> do
                  E.on $ personalisedSheetFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
                  E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
                  E.where_$ sheet E.^. SheetName E.==. E.val shn
                      E.&&. course E.^. CourseTerm E.==. E.val tid
                      E.&&. course E.^. CourseSchool E.==. E.val ssh
                      E.&&. course E.^. CourseShorthand E.==. E.val csh
             in runDBRead $ or2M onlyPersonalised hasPersonalised
        , navType        = NavTypeLink { navModal = True }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetEdit
        , navRoute       = CSheetR tid ssh csh shn SEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
    , NavPageActionSecondary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetClone
        , navRoute       = (CourseR tid ssh csh SheetNewR, [("shn", toPathPiece shn)])
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
    , NavPageActionSecondary
      { navLink = NavLink
        { navLabel       = MsgMenuSheetDelete
        , navRoute       = CSheetR tid ssh csh shn SDelR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      }
    ]
pageActions (CSheetR tid ssh csh shn SSubsR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuSubmissionNew
      , navRoute       = CSheetR tid ssh csh shn SubmissionNewR
      , navDownload    = Nothing
      , navAccess' =
          let submissionAccess = hasWriteAccessTo $ CSheetR tid ssh csh shn SSubsR
              hasNoSubmission = maybeT (return False) $ do
                uid <- MaybeT $ liftHandler maybeAuthId
                submissions <- lift $ submissionList tid csh shn uid
                guard $ null submissions
                return True
           in runDBRead $ hasNoSubmission `or2M` submissionAccess
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsOwn
      , navRoute       = ( CorrectionsR
                         , [ ("corrections-term", toPathPiece tid)
                           , ("corrections-school", toPathPiece ssh)
                           , ("corrections-course", toPathPiece csh)
                           , ("corrections-sheet", toPathPiece shn)
                           ]
                         )
      , navDownload    = Nothing
      , navAccess'     = (== Authorized) <$> evalAccessCorrector tid ssh csh
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsAssign
      , navRoute       = CSheetR tid ssh csh shn SAssignR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (CSubmissionR tid ssh csh shn cid SubShowR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrection
      , navRoute       = CSubmissionR tid ssh csh shn cid CorrectionR
      , navDownload    = Nothing
      , navAccess'     = hasWriteAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgCorrectorAssignTitle
      , navRoute       = CSubmissionR tid ssh csh shn cid SubAssignR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuSubmissionDelete
      , navRoute       = CSubmissionR tid ssh csh shn cid SubDelR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgCorrectorAssignTitle
      , navRoute       = CSubmissionR tid ssh csh shn cid SubAssignR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuSubmissionDelete
      , navRoute       = CSubmissionR tid ssh csh shn cid SubDelR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions (CourseR tid ssh csh CApplicationsR) = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCourseApplicationsFiles
      , navRoute       = CourseR tid ssh csh CAppsFilesR
      , navDownload    = Just Nothing -- If `navAccess'` is True, we definitely have either exactly one generated file or more than one file
      , navAccess' =
          let appAccess (E.Value appId) = do
                cID <- encrypt appId
                hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
              appSource = E.selectSource . E.from $ \(course `E.InnerJoin` courseApplication) -> do
                E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
                E.where_ $ course E.^. CourseTerm E.==. E.val tid
                     E.&&. course E.^. CourseSchool E.==. E.val ssh
                     E.&&. course E.^. CourseShorthand E.==. E.val csh
                E.where_ . E.exists . E.from $ \courseApplicationFile ->
                  E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. courseApplication E.^. CourseApplicationId
                return $ courseApplication E.^. CourseApplicationId
           in runDBRead . runConduit $ appSource .| anyMC appAccess
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCourseMembers
      , navRoute       = CourseR tid ssh csh CUsersR
      , navDownload    = Nothing
      , navAccess' =
          runDBRead $ do
            cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
            exists [ CourseParticipantCourse ==. cid ]
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions CorrectionsR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsDownload
      , navRoute       = CorrectionsDownloadR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsUpload
      , navRoute       = CorrectionsUploadR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsCreate
      , navRoute       = CorrectionsCreateR
      , navDownload    = Nothing
      , navAccess'     = runDBRead . maybeT (return False) $ do
          uid <- MaybeT $ liftHandler maybeAuthId
          sheets <- lift . E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
            E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
            let
              isCorrector' = E.exists . E.from $ \sheetCorrector -> E.where_
                    $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
                E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
              isLecturer = E.exists . E.from $ \lecturer -> E.where_
                    $ lecturer E.^. LecturerUser E.==. E.val uid
                E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
            E.where_ $ isCorrector' E.||. isLecturer
            return $ sheet E.^. SheetSubmissionMode
          return $ orOf (traverse . _Value . _submissionModeCorrector) sheets
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuCorrectionsGrade
      , navRoute       = CorrectionsGradeR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions CorrectionsGradeR = do
  correctionsSecondary <- pageQuickActions NavQuickViewPageActionSecondary CorrectionsR
  return
    [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuCorrections
        , navRoute       = CorrectionsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = correctionsSecondary
      }
    ]
pageActions EExamListR = return
  [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamNew
        , navRoute       = EExamNewR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  ]
pageActions (EExamR tid ssh coursen examn EEShowR) = return
  [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamEdit
        , navRoute       = EExamR tid ssh coursen examn EEEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamUsers
        , navRoute       = EExamR tid ssh coursen examn EEUsersR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamGrades
        , navRoute       = EExamR tid ssh coursen examn EEGradesR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamCorrect
        , navRoute       = EExamR tid ssh coursen examn EECorrectR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  ]
pageActions (EExamR tid ssh coursen examn EEGradesR) = return
  [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamCorrect
        , navRoute       = EExamR tid ssh coursen examn EECorrectR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamUsers
        , navRoute       = EExamR tid ssh coursen examn EEUsersR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamEdit
        , navRoute       = EExamR tid ssh coursen examn EEEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  ]
pageActions (EExamR tid ssh coursen examn EECorrectR) = return
  [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamGrades
        , navRoute       = EExamR tid ssh coursen examn EEGradesR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamUsers
        , navRoute       = EExamR tid ssh coursen examn EEUsersR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamEdit
        , navRoute       = EExamR tid ssh coursen examn EEEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  ]
pageActions (EExamR tid ssh coursen examn EEUsersR) = return
  [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamGrades
        , navRoute       = EExamR tid ssh coursen examn EEGradesR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamCorrect
        , navRoute       = EExamR tid ssh coursen examn EECorrectR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  , NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgMenuExternalExamEdit
        , navRoute       = EExamR tid ssh coursen examn EEEditR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = False }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }
  ]
pageActions ParticipantsListR = return
  [ NavPageActionPrimary
      { navLink = NavLink
        { navLabel       = MsgCsvOptions
        , navRoute       = CsvOptionsR
        , navDownload    = Nothing
        , navAccess'     = return True
        , navType        = NavTypeLink { navModal = True }
        , navQuick'      = mempty
        , navForceActive = False
        }
      , navChildren = []
      }

  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuParticipantsIntersect
      , navRoute       = ParticipantsIntersectR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False}
      , navQuick'      = navQuick NavQuickViewPageActionSecondary
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions AdminWorkflowDefinitionListR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAdminWorkflowDefinitionNew
      , navRoute       = AdminWorkflowDefinitionNewR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAdminWorkflowInstanceList
      , navRoute       = AdminWorkflowInstanceListR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions (AdminWorkflowDefinitionR wds wdn AWDEditR) = return
  [ NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuAdminWorkflowDefinitionDelete
      , navRoute       = AdminWorkflowDefinitionR wds wdn AWDDeleteR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAdminWorkflowDefinitionInstantiate
      , navRoute       = AdminWorkflowDefinitionR wds wdn AWDInstantiateR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = True }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions AdminWorkflowInstanceListR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuAdminWorkflowInstanceNew
      , navRoute       = AdminWorkflowInstanceNewR
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions route | Just (rScope, WorkflowInstanceListR) <- route ^? _WorkflowScopeRoute = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuWorkflowWorkflowList
      , navRoute       = _WorkflowScopeRoute # (rScope, WorkflowWorkflowListR)
      , navDownload    = Nothing
      , navAccess'     = runDB $ haveWorkflowWorkflows rScope
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions route | Just (rScope, WorkflowInstanceR win WIEditR) <- route ^? _WorkflowScopeRoute = return
  [ NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuWorkflowInstanceDelete
      , navRoute       = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIDeleteR)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuWorkflowInstanceWorkflows
      , navRoute       = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  , NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuWorkflowInstanceInitiate
      , navRoute       = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions route | Just (rScope, WorkflowWorkflowR cID WWWorkflowR) <- route ^? _WorkflowScopeRoute = return
  [ NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuWorkflowWorkflowEdit
      , navRoute       = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWEditR)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  , NavPageActionSecondary
    { navLink = NavLink
      { navLabel       = MsgMenuWorkflowWorkflowDelete
      , navRoute       = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWDeleteR)
      , navDownload    = Nothing
      , navAccess'     = return True
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    }
  ]
pageActions TopWorkflowInstanceListR = return
  [ NavPageActionPrimary
    { navLink = NavLink
      { navLabel       = MsgMenuTopWorkflowWorkflowList
      , navRoute       = TopWorkflowWorkflowListR
      , navDownload    = Nothing
      , navAccess'     = runDB haveTopWorkflowWorkflows
      , navType        = NavTypeLink { navModal = False }
      , navQuick'      = mempty
      , navForceActive = False
      }
    , navChildren = []
    }
  ]
pageActions _ = return []

submissionList :: ( MonadIO m
                  , BackendCompatible SqlReadBackend backend
                  )
               => TermId -> CourseShorthand -> SheetName -> UserId -> ReaderT backend m [E.Value SubmissionId]
submissionList tid csh shn uid = withReaderT (projectBackend @SqlReadBackend) . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
  E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
  E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
  E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId

  E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
       E.&&. sheet E.^. SheetName E.==. E.val shn
       E.&&. course E.^. CourseShorthand E.==. E.val csh
       E.&&. course E.^. CourseTerm E.==. E.val tid

  return $ submission E.^. SubmissionId


pageQuickActions :: ( MonadCatch m
                    , MonadHandler m
                    , HandlerSite m ~ UniWorX
                    , BearerAuthSite UniWorX
                    , BackendCompatible SqlReadBackend (YesodPersistBackend UniWorX)
                    )
                 => NavQuickView -> Route UniWorX -> m [NavLink]
pageQuickActions qView route = do
  items'' <- pageActions route
  items' <- catMaybes <$> mapM (runMaybeT . navAccess) items''
  filterM navLinkAccess $ items' ^.. typesUsing @NavChildren @NavLink . filtered (getAny . ($ qView) . navQuick')

-- | Verify that the currently logged in user is lecturer or corrector for at least one sheet for the given course
evalAccessCorrector
  :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX)
  => TermId -> SchoolId -> CourseShorthand -> m AuthResult
evalAccessCorrector tid ssh csh = evalAccess (CourseR tid ssh csh CNotesR) False

  
_haveWorkflowInstances, haveWorkflowWorkflows
  :: ( MonadHandler m, HandlerSite m ~ UniWorX
     , BackendCompatible SqlReadBackend backend
     , BearerAuthSite UniWorX
     )
  => RouteWorkflowScope
  -> ReaderT backend m Bool
_haveWorkflowInstances rScope = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . maybeT (return False) $ do
  scope <- fromRouteWorkflowScope rScope

  let checkAccess (Entity _ WorkflowInstance{..})
        = hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
      getInstances = E.selectSource . E.from $ \workflowInstance -> do
        E.where_ $ workflowInstance E.^. WorkflowInstanceScope E.==. E.val (scope ^. _DBWorkflowScope)
        return workflowInstance

  $cachedHereBinary scope . runConduit $ transPipe lift getInstances .| C.mapM checkAccess .| C.or
haveWorkflowWorkflows rScope = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . maybeT (return False) $ do
  scope <- fromRouteWorkflowScope rScope

  let checkAccess (E.Value wwId) = do
        cID <- lift . lift $ encrypt wwId
        hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
      getWorkflows = E.selectSource . E.from $ \workflowWorkflow -> do
        E.where_ $ workflowWorkflow E.^. WorkflowWorkflowScope E.==. E.val (scope ^. _DBWorkflowScope)
        return $ workflowWorkflow E.^. WorkflowWorkflowId

  $cachedHereBinary scope . runConduit $ transPipe lift getWorkflows .| C.mapM checkAccess .| C.or

haveTopWorkflowInstances, haveTopWorkflowWorkflows
  :: ( MonadHandler m, HandlerSite m ~ UniWorX
     , BackendCompatible SqlReadBackend backend
     , BearerAuthSite UniWorX
     )
  => ReaderT backend m Bool
haveTopWorkflowInstances = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . maybeT (return False) $
  let checkAccess (Entity _ WorkflowInstance{..}) = do
        rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
        hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
      getInstances = selectSource [] []
      isTop (Entity _ WorkflowInstance{..}) = isTopWorkflowScope workflowInstanceScope
   in $cachedHere . runConduit $ transPipe lift getInstances .| C.filter isTop .| C.mapM checkAccess .| C.or
haveTopWorkflowWorkflows = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . maybeT (return False) $
  let checkAccess (Entity wwId WorkflowWorkflow{..}) = do
        rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
        cID <- lift . lift $ encrypt wwId
        hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
      getWorkflows = selectSource [] []
      isTop (Entity _ WorkflowWorkflow{..}) = isTopWorkflowScope workflowWorkflowScope
   in $cachedHere . runConduit $ transPipe lift getWorkflows .| C.filter isTop .| C.mapM checkAccess .| C.or