fradrive-old/src/Handler/Utils/Table/Cells.hs

-- SPDX-FileCopyrightText: 2022-24 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) 

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;|]

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

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

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

maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b
maybeCell = flip foldMap

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  = iconCell
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  

-----------------
-- 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

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

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 `mappend` desc
  where
    link = CourseR courseTerm courseSchool courseShorthand CShowR
    name = citext2widget courseName
    desc = case courseDescription of
            Nothing      -> mempty
            (Just descr) -> cell [whamlet|
              $newline never
              <div>
                ^{modal "Beschreibung" (Right $ toWidget descr)}
              |]

-- 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

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 <> desc
  where
    desc = case qualificationDescription of
            Nothing      -> mempty
            (Just descr) -> spacerCell <> markupCellLargeModal descr

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

occurrencesCell :: IsDBTable m a => Occurrences -> DBCell m a
occurrencesCell = cell . occurrencesWidget

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

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