-- SPDX-FileCopyrightText: 2022-2025 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Table.Cells where

import Import hiding (link)

import Text.Blaze (ToMarkup(..))
import qualified Data.Set as Set

import Handler.Utils.Table.Pagination
import Handler.Utils.DateTime
import Handler.Utils.Widgets
import Handler.Utils.Occurrences
import Handler.Utils.LMS (lmsUserStatusWidget)
import Handler.Utils.Qualification (isValidQualification, retrieveQualification)

type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles !

----------------
-- Some basic cells are defined in Handler.Utils.Table.Pagination
-- such as: i18nCell, cellTooltip, anchorCell for links, etc.

----------------
-- Special cells

-- | Display a breakable space
spacerCell :: IsDBTable m a => DBCell m a
spacerCell = cell [whamlet|&emsp;|]

semicolonCell :: IsDBTable m a => DBCell m a
semicolonCell = cell [whamlet|;&emsp;|]

blankCell :: IsDBTable m a => DBCell m a
blankCell = textCell " "

-- | Contribute to DBResult. BEWARE: only shown cells are executed; pagination makes tellCell useless for rowcounts; instead use dbtProj for computations on all rows regardless of pagination
tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
tellCell = flip mappend . writerCell . tell

cellTell :: IsDBTable m a => DBCell m a -> a -> DBCell m a
cellTell = flip tellCell

indicatorCell :: IsDBTable m Any => DBCell m Any -- For dbTables that return a Bool to indicate content
indicatorCell = writerCell . tell $ Any True

addIndicatorCell :: IsDBTable m Any => DBCell m Any -> DBCell m Any
addIndicatorCell = tellCell $ Any True

writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
writerCell act = mempty & cellContents %~ (<* act)

-- for documentation purposes and better error message
cellMaybe :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
cellMaybe = foldMap

-- like cellMaybe, but explicitely indicating Nothing by a something-is-missing icon
cellMaybe' :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
cellMaybe' = maybe (iconCell IconMissing)

-- for documentation purposes and better error message
maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b
maybeCell = flip foldMap

boolCell :: IsDBTable m b => Bool -> DBCell m b -> DBCell m b
boolCell True   c = c
boolCell False  _ = mempty

htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a
htmlCell = cell . toWidget . toMarkup

pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
pathPieceCell = cell . toWidget . toPathPiece

-- | execute a DB action that return a widget for the cell contents
sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a
sqlCell act = mempty & cellContents .~ lift act

-- TODO: Formulate variant of sqlCell that types for tables having actions, i.e. MForm istead of YesodDB?
-- sqlCell' :: (IsDBTable (MForm Handler) a) => _ -> DBCell (MForm Handler) a
-- sqlCell' = flip (set' cellContents) mempty

-- | Highlight table cells with warning: Is not yet implemented in frontend.
markCell :: IsDBTable m a => MessageStatus -> (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a)
markCell status condition normal x
   | condition x = normal x & addCellClass (statusToUrgencyClass status)
   | otherwise   = normal x

ifCell :: (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a) -> (t -> DBCell m a)
ifCell decision cTrue cFalse x
  | decision x = cTrue  x
  | otherwise  = cFalse x

linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
linkEmptyCell = anchorCell

-- not to be confused with i18nCell
msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
msgCell = textCell . toMessage

guardAuthCell :: (IsDBTable m a, MonadAP m, MonadThrow m)
              => m (Route UniWorX, Bool) -- ^ @(route, isWrite)@
              -> DBCell m a -> DBCell m a
guardAuthCell mkParams = over cellContents $ \act -> do
  (route, isWrite) <- lift mkParams
  ifM (fmap (is _Authorized) . lift $ evalAccess route isWrite) act (return mempty)

-- Recall: for line numbers, use dbRow

---------------------
-- Icon cells

-- to be used with icons directly, for results of `icon`, use either `wgtCell` or `iconFixedCell`
iconCell :: IsDBTable m a => Icon -> DBCell m a
iconCell = cell . toWidget . icon

iconBoolCell :: IsDBTable m a => Bool -> DBCell m a
iconBoolCell = cell . toWidget . boolSymbol

ifIconCell :: IsDBTable m a => Bool -> Icon -> DBCell m a
ifIconCell True  = iconFixedCell . icon
ifIconCell False = const iconSpacerCell

addIconFixedWidth :: IsDBTable m a => DBCell m a -> DBCell m a
addIconFixedWidth = addCellClass ("icon-fixed-width" :: Text)

-- | Can be used directly with type Markup as delivered by most functions from Utils.Icon
iconFixedCell :: (IsDBTable m a, ToWidget UniWorX wgt) => wgt -> DBCell m a
iconFixedCell = addIconFixedWidth . cell . toWidget

iconSpacerCell :: IsDBTable m a => DBCell m a
iconSpacerCell = mempty & addIconFixedWidth

-- | Maybe display a tickmark/checkmark icon
tickmarkCell :: IsDBTable m a => Bool -> DBCell m a
tickmarkCell = cell . toWidget . hasTickmark

-- | Maybe display an icon for tainted rows
isBadCell :: IsDBTable m a => Bool -> DBCell m a
isBadCell = cell . toWidget . isBad

-- | Maybe display a exclamation icon
isNewCell :: IsDBTable m a => Bool -> DBCell m a
isNewCell = cell . toWidget . isNew

-- | Maybe display comment icon linking a given URL or show nothing at all
commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
commentCell Nothing     = mempty
commentCell (Just link) = anchorCell link $ hasComment True

-- | whether something is visible or hidden
isVisibleCell :: IsDBTable m a => Bool -> DBCell m a
isVisibleCell True  =  cell . toWidget $ isVisible True
isVisibleCell False = (cell . toWidget $ isVisible False) & addUrgencyClass
  where
    addUrgencyClass = addCellClass $ statusToUrgencyClass Warning

-- | for simple file downloads
fileCell :: IsDBTable m a => (Route UniWorX, [(Text, Text)]) -> DBCell m a
fileCell route = anchorCell route iconFileDownload

-- | for zip-archive downloads
zipCell :: IsDBTable m a => (Route UniWorX, [(Text, Text)]) -> DBCell m a
zipCell route = anchorCell route iconFileZip

-- | for csv downloads
csvCell :: IsDBTable m a => Route UniWorX -> DBCell m a
csvCell route = anchorCell route iconFileCSV

-- | Display an icon that opens a modal upon clicking
modalCell :: (IsDBTable m a, ToWidget UniWorX w) => w -> DBCell m a
modalCell content = cell $ modal (toWidget $ hasComment True) (Right $ toWidget content)

-- | Show Text if it is small, create modal otherwise
modalCellLarge :: (IsDBTable m a, ToWidget UniWorX t, MonoFoldable t, Element t ~ Char) => t -> DBCell m a
modalCellLarge content
  | length content > 32 = modalCell  content
  | otherwise           = stringCell content

markupCellLargeModal :: IsDBTable m a => StoredMarkup -> DBCell m a
markupCellLargeModal mup
  | markupIsSmallish mup = cell $ toWidget mup
  | otherwise = modalCell mup

addModalDescriptionCell :: IsDBTable m a => Maybe StoredMarkup -> DBCell m a
addModalDescriptionCell = foldMap ((spacerCell <>) . markupCellLargeModal)


-----------------
-- Datatype cells
timeCell :: IsDBTable m a => UTCTime -> DBCell m a
timeCell t = cell $ formatTimeW SelFormatTime t

dateTimeCell :: IsDBTable m a => UTCTime -> DBCell m a
dateTimeCell t = cell $ formatTimeW SelFormatDateTime t

dateCell :: IsDBTable m a => UTCTime -> DBCell m a
dateCell t = cell $ formatTimeW SelFormatDate t

rangeCell :: (IsDBTable m a, HasLocalTime t, HasLocalTime t') => t -> Maybe t' -> DBCell m a
rangeCell = (cell .) . formatTimeRangeW SelFormatDateTime

dayCell :: IsDBTable m a => Day -> DBCell m a
dayCell utctDay = cell $ formatTimeW SelFormatDate UTCTime{..}
  where utctDayTime = 0

-- | Show a date, and highlight date earlier than given watershed with an icon and cell class Warning
--
--   Cannot use `Handler.Utils.visibleUTCTime`, since setting the UrgencyClass must be done outside the monad, hence the watershed argument.
dateTimeCellVisible :: IsDBTable m a => UTCTime -> UTCTime -> DBCell m a
dateTimeCellVisible watershed t
    | watershed < t = cell $(widgetFile "widgets/date-time/yet-invisible") & addUrgencyClass
    | otherwise     = cell timeStampWgt
  where
    timeStampWgt    = formatTimeW SelFormatDateTime t
    addUrgencyClass = addCellClass $ statusToUrgencyClass Warning

userCell :: IsDBTable m a => Text -> Text -> DBCell m a
userCell displayName surname = cell $ nameWidget displayName surname

{- Recall:
userCell' :: IsDBTable m a => User -> DBCell m a
userCell' = cellHasUser
-}

emailCell :: IsDBTable m a => CI Text -> DBCell m a
emailCell email = cell $(widgetFile "widgets/link-email")
  where linkText= toWgt email


cellMailPrefPin :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a
cellMailPrefPin usr =
  let userEntity = usr ^. hasEntityUser
      uid = userEntity ^. _entityKey
      rwgt = do
              uuid <- liftHandler $ encrypt uid
              modal (widgetMailPrefPin userEntity) (Left $ SomeRoute $ UserRecipientsR uuid)
  in cell rwgt

-- cellMailPrefPin :: (IsDBTable m a, HasUser u) => u -> DBCell m a
-- cellMailPrefPin usr =
--     iconFixedCell (iconLetterOrEmail prefPost) <> blankCell <> ifIconCell (not prefPost && hasPin) IconPinProtect
--   where
--     prefPost =         usr ^. _userPrefersPostal
--     hasPin   = isJust (usr ^. _userPinPassword)

cellHasUser :: (IsDBTable m c, HasUser a) => a -> DBCell m c
cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)

cellHasUserLink :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c
-- cellHasUserLink toLink user =
--   let uid   = user ^. hasEntityUser . _entityKey
--       nWdgt = nameWidget (user ^. hasEntityUser . _entityVal . _userDisplayName) (user ^. hasEntityUser .  _entityVal . _userSurname)
--   in  anchorCellM (toLink <$> encrypt uid) nWdgt
cellHasUserLink toLink user =
  let userEntity = user ^. hasEntityUser
      uid   = userEntity ^. _entityKey
      nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^.  _entityVal . _userSurname)
  in  anchorCellM (toLink <$> encrypt uid) nWdgt

-- | like `cellHasUserLink` but opens the user in a modal instead; link is only displayed if the user has sufficient rights
cellHasUserModal :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c
cellHasUserModal toLink user =
  let userEntity = user ^. hasEntityUser
      uid   = userEntity ^. _entityKey
      nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^.  _entityVal . _userSurname)
      lWdgt = do
                uuid <- liftHandler $ encrypt uid
                modalAccess nWdgt nWdgt False $ toLink uuid
  in cell lWdgt

-- | like `cellHasUserModal` but but always display link without prior access rights checks
cellHasUserModalAdmin :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c
cellHasUserModalAdmin toLink user =
  let userEntity = user ^. hasEntityUser
      uid   = userEntity ^. _entityKey
      nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^.  _entityVal . _userSurname)
      lWdgt = do
                uuid <- liftHandler $ encrypt uid
                modal nWdgt $ Left $ SomeRoute $ toLink uuid
  in cell lWdgt

-- | like `cellHasUserModal` but with fixed route and showing an edit icon instead; link is only displayed if the user has sufficient rights
cellEditUserModal :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c
cellEditUserModal user =
  let userEntity = user ^. hasEntityUser
      uid   = userEntity ^. _entityKey
      nWdgt = toWidget $ icon IconUserEdit
      lWdgt = do
                uuid <- liftHandler $ encrypt uid
                modalAccess mempty nWdgt True $ ForProfileR uuid
  in cell lWdgt

-- | like `cellEditUserModal` but always displays the link without prior access rights checks
cellEditUserModalAdmin :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c
cellEditUserModalAdmin user =
  let userEntity = user ^. hasEntityUser
      uid   = userEntity ^. _entityKey
      nWdgt = toWidget $ icon IconUserEdit
      lWdgt = do
                uuid <- liftHandler $ encrypt uid
                modal nWdgt (Left $ SomeRoute $ ForProfileR uuid)
  in cell lWdgt

cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer

cellHasMatrikelnummerLinked :: (IsDBTable m a, HasEntity u User) => Bool -> u -> DBCell m a
cellHasMatrikelnummerLinked isAdmin usr
    | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do
        uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey
        if isAdmin
          then modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid)
          else modalAccess mempty (text2widget matNr) False (AdminAvsUserR uuid)
    | otherwise = mempty
  where
    usrEntity = usr ^. hasEntityUser

cellHasMatrikelnummerLinkedAdmin :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a
cellHasMatrikelnummerLinkedAdmin usr
    | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do
        uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey
        modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid)
    | otherwise = mempty
  where
    usrEntity = usr ^. hasEntityUser


cellHasEMail :: (IsDBTable m a, HasUser u) => u -> DBCell m a
cellHasEMail = emailCell . view _userDisplayEmail


cellHasSemester :: (IsDBTable m c, HasStudyFeatures a) => a -> DBCell m c
cellHasSemester = numCell . view _studyFeaturesSemester


cellHasField :: (IsDBTable m c, HasStudyTerms a) => a -> DBCell m c
cellHasField x = maybe (numCell $ x ^. _studyTermsKey) textCell $ x ^. _studyTermsName <|> x ^. _studyTermsShorthand


cellHasDegreeShort :: (IsDBTable m c, HasStudyDegree a) => a -> DBCell m c
cellHasDegreeShort x = maybe (numCell $ x ^. _studyDegreeKey) textCell $ x ^. _studyDegreeShorthand <|> x ^. _studyDegreeName



-- Just for documentation purposes; inline this code instead:
maybeDateTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a
maybeDateTimeCell = maybe mempty dateTimeCell

numCell :: (IsDBTable m a, ToMessage b) => b -> DBCell m a
numCell = textCell . toMessage

propCell :: (IsDBTable m a, Real b, ToMessage b) => b -> b -> DBCell m a
propCell curr max'
  | max' /= 0 = i18nCell $ MsgTableProportion (toMessage curr) (toMessage max') (toRational curr / toRational max')
  | otherwise = i18nCell $ MsgTableProportionNoRatio (toMessage curr) (toMessage max')

int64Cell :: IsDBTable m a => Int64-> DBCell m a
int64Cell = numCell

termCell :: IsDBTable m a => TermId -> DBCell m a
termCell tid = anchorCell link name
  where
    link = TermCourseListR tid
    name = toWgt tid

termCellCL :: IsDBTable m a => CourseLink -> DBCell m a
termCellCL (tid,_,_) = termCell tid

schoolCell :: IsDBTable m a => TermId -> SchoolId -> DBCell m a
schoolCell tid ssh  = anchorCell link name
  where
    link = TermSchoolCourseListR tid ssh
    name = toWgt ssh

schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a
schoolCellCL (tid,ssh,_) = schoolCell tid ssh

courseCellCL :: IsDBTable m a => CourseLink -> DBCell m a
courseCellCL (tid,ssh,csh) = anchorCell link name
  where
    link = CourseR tid ssh csh CShowR
    name = toWgt csh

courseCell :: IsDBTable m a => Course -> DBCell m a
courseCell Course{..} = anchorCell link name <> addModalDescriptionCell courseDescription
  where
    link = CourseR courseTerm courseSchool courseShorthand CShowR
    name = citext2widget courseName

examCell :: IsDBTable m a => Course -> Exam -> DBCell m a
examCell Course{..} Exam{..} = anchorCell link name <> addModalDescriptionCell examDescription
  where
    link = CExamR courseTerm courseSchool courseShorthand examName EShowR
    name = citext2widget examName

examOccurrenceCell :: IsDBTable m a => Entity ExamOccurrence -> DBCell m a
examOccurrenceCell Entity{entityVal = ExamOccurrence{..}} =
  wgtCell [whamlet|#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]


-- also see Handler.Utils.Widgets.companyWidget
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
companyCell csh cname isSupervisor = anchorCell curl name
  where
    curl = FirmUsersR csh
    corg = ciOriginal cname
    name
      | isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
      | otherwise    = text2markup  corg

companyIdCell :: IsDBTable m a => CompanyId -> DBCell m a
companyIdCell cid = companyCell csh csh False
  where
    csh = unCompanyKey cid

-- | Uses DB Lookup to link to a qualification by id only, use sparingly!
qualificationIdCell :: (IsDBTable m c) => QualificationId -> DBCell m c
qualificationIdCell qid = anchorCellM' qual link name
  where
    qual = retrieveQualification qid
    link (Just Qualification{..}) = QualificationR qualificationSchool qualificationShorthand
    link Nothing = HelpR
    name Nothing = text2widget "Error: unknown QID"
    name (Just Qualification{..}) = citext2widget qualificationName

qualificationIdShortCell :: (IsDBTable m c) => QualificationId -> DBCell m c
qualificationIdShortCell qid = anchorCellM' qual link name
  where
    qual = retrieveQualification qid
    link (Just Qualification{..}) = QualificationR qualificationSchool qualificationShorthand
    link Nothing = HelpR
    name Nothing = text2widget "Error: unknown QID"
    name (Just Qualification{..}) = citext2widget qualificationShorthand

qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
  where
    link = QualificationR qualificationSchool qualificationShorthand
    name = citext2widget qualificationName

qualificationShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationShortCell (view hasQualification -> Qualification{..}) = anchorCell link name
  where
    link = QualificationR qualificationSchool qualificationShorthand
    name = citext2widget qualificationShorthand

qualificationDescrCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualificationCell q <> addModalDescriptionCell qualificationDescription

qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c
qualificationValidIconCell d qb qu = do
  blockIcon $ isValidQualification d qu qb
  where
    blockIcon = cell . toWidget . iconQualificationBlock

qualificationValidUntilCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c
qualificationValidUntilCell = qualificationValidUntilCell' (Just LmsUserAllR)

qualificationValidUntilCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Day -> Maybe b -> a -> DBCell m c
qualificationValidUntilCell' mbToLink d qb qu = cell $ case mbToLink of
    Nothing     -> headWgt <> dateWgt
    Just toLink -> do
      uuid <- liftHandler $ encrypt $ qu ^. hasQualificationUser . _qualificationUserUser
      let modalWgt = modalAccess dateWgt dateWgt False $ toLink uuid
      headWgt <> modalWgt
  where
    dateWgt = formatTimeW SelFormatDate (qu ^. hasQualificationUser . _qualificationUserValidUntil)
    iconWgt = toWidget $ iconQualificationBlock $ isValidQualification d qu qb
    headWgt = iconWgt <> [whamlet|&emsp;|]

qualificationValidReasonCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Bool -> Day -> Maybe b -> a -> DBCell m c
qualificationValidReasonCell = qualificationValidReasonCell' (Just LmsUserAllR)

qualificationValidReasonCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Bool -> Day -> Maybe b -> a -> DBCell m c
qualificationValidReasonCell' mbToLink showReason d qb qu = ic <> foldMap blc qb
  where
    ic = cell . toWidget . iconQualificationBlock $ isValidQualification d qu qb
    blc (view hasQualificationUserBlock -> QualificationUserBlock{..})
      | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason
      | qualificationUserBlockUnblock = mempty
      | otherwise  = spacerCell <> dateCell qualificationUserBlockFrom
    dc tstamp
      | Just toLink <- mbToLink = cell $ do
          uuid <- liftHandler $ encrypt uid
          let dWgt = formatTimeW SelFormatDate tstamp
          modalAccess dWgt dWgt False $ toLink uuid
        --  anchorCellM (toLink <$> encrypt uid)
      | otherwise = dateCell tstamp
    uid = qu ^. hasQualificationUser . _qualificationUserUser

qualificationValidReasonCell'' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Bool -> Day -> Maybe b -> a -> Bool -> DBCell m c
qualificationValidReasonCell'' mbToLink showReason d qb qu extValid = ic <> icErr <> foldMap blc qb
  where
    quValid = isValidQualification d qu qb
    icErr = cell . toWidget . isBad $ quValid /= extValid
    ic = cell . toWidget $ iconQualificationBlock quValid
    blc (view hasQualificationUserBlock -> QualificationUserBlock{..})
      | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason
      | qualificationUserBlockUnblock = mempty
      | otherwise  = spacerCell <> dateCell qualificationUserBlockFrom
    dc tstamp
      | Just toLink <- mbToLink = cell $ do
          uuid <- liftHandler $ encrypt uid
          let dWgt = formatTimeW SelFormatDate tstamp
          modalAccess dWgt dWgt False $ toLink uuid
        --  anchorCellM (toLink <$> encrypt uid)
      | otherwise = dateCell tstamp
    uid = qu ^. hasQualificationUser . _qualificationUserUser

lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name
  where
    link = LmsR qualificationSchool qualificationShorthand
    name = citext2widget qualificationShorthand

sheetCell :: IsDBTable m a => CourseLink -> SheetName -> DBCell m a
sheetCell crse shn =
  let tid = crse ^. _1
      ssh = crse ^. _2
      csh = crse ^. _3
      link = CSheetR tid ssh csh shn SShowR
  in anchorCell link $ toWgt shn

submissionCell :: IsDBTable m a => CourseLink -> SheetName -> SubmissionId -> DBCell m a
submissionCell crse shn sid =
  let tid = crse ^. _1
      ssh = crse ^. _2
      csh = crse ^. _3
      mkCid = encrypt sid
      mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
      mkText      = toWgt
  in anchorCellM' mkCid mkRoute mkText

correctorStateCell :: IsDBTable m a => SheetCorrector -> DBCell m a
correctorStateCell sc =
  i18nCell $ sheetCorrectorState sc

correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
correctorLoadCell sc =
  i18nCell $ sheetCorrectorLoad sc

lessonTimesCell :: IsDBTable m a => Bool -> [LessonTime] -> DBCell m a
lessonTimesCell roomHidden lessons = cell $ lessonTimesWidget roomHidden lessons

occurrencesCell :: IsDBTable m a => Bool -> JSONB Occurrences -> DBCell m a
occurrencesCell roomHidden occs = cell $ occurrencesWidget roomHidden occs

roomReferenceCell :: IsDBTable m a => RoomReference -> DBCell m a
roomReferenceCell = cell . roomReferenceShortWidget

cryptoidCell :: (IsDBTable m a, PathPiece cid) => cid -> DBCell m a
cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece

lmsStatusCell :: IsDBTable m a => Bool -> Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a
lmsStatusCell extendedInfo mkLink = wgtCell . lmsUserStatusWidget extendedInfo mkLink

lmsStateCell :: IsDBTable m a => LmsState -> DBCell m a
lmsStateCell LmsFailed  = iconBoolCell False
lmsStateCell LmsOpen    = iconSpacerCell
lmsStateCell LmsPassed  = iconBoolCell True

avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
avsPersonNoCell = numCell . view _userAvsNoPerson

avsPersonNoLinkedCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
avsPersonNoLinkedCell a = cell $ do
  uuid <- liftHandler $ encrypt $ a ^. _userAvsUser
  let nWgt = toWgt $ toMessage $ a ^. _userAvsNoPerson
  modalAccess nWgt nWgt False $ AdminAvsUserR uuid

avsPersonNoLinkedCellAdmin :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
avsPersonNoLinkedCellAdmin a = cell $ do
  uuid <- liftHandler $ encrypt $ a ^. _userAvsUser
  let nWgt = toWgt $ toMessage $ a ^. _userAvsNoPerson
  modal nWgt (Left $ SomeRoute $ AdminAvsUserR uuid)

avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c
avsPersonCardCell cards = wgtCell
    [whamlet|
      $newline never
      <ul .list--iconless .list--inline .list--comma-separated>
        $forall c <- validColors
          <li>
            _{c}
    |]
  where
    validCards  = Set.filter avsDataValid cards
    validColors = Set.toDescList $ Set.map avsDataCardColor validCards