
-- SPDX-FileCopyrightText: 2024-2025 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

module Handler.School.DayTasks
  ( getSchoolDayR, postSchoolDayR
  , getSchoolDayCheckR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Company
-- import Handler.Utils.Occurrences
import Handler.Utils.Avs
import Handler.Utils.Course.Cache

import qualified Data.Set  as Set
import qualified Data.Map  as Map
import qualified Data.Text as Text

-- import Database.Persist.Sql (updateWhereCount)
import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Legacy as EL (on, from) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
import qualified Database.Esqueleto.Utils as E
-- import           Database.Esqueleto.PostgreSQL.JSON ((@>.))
-- import qualified Database.Esqueleto.PostgreSQL.JSON as E hiding ((?.))
import Database.Esqueleto.Utils.TH


-- | Maximal number of suggestions for note fields in Day Task view
maxSuggestions :: Int64
maxSuggestions = 7

-- data DailyTableAction = DailyActDummy -- just a dummy, since we don't now yet which actions we will be needing
--   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

-- instance Universe DailyTableAction
-- instance Finite DailyTableAction
-- nullaryPathPiece ''DailyTableAction $ camelToPathPiece' 2
-- embedRenderMessage ''UniWorX ''DailyTableAction id

-- data DailyTableActionData = DailyActDummyData
--   deriving (Eq, Ord, Read, Show, Generic)


type DailyTableExpr =
  (                     E.SqlExpr (Entity Course)
    `E.InnerJoin`       E.SqlExpr (Entity Tutorial)
    `E.InnerJoin`       E.SqlExpr (Entity TutorialParticipant)
    `E.InnerJoin`       E.SqlExpr (Entity User)
    `E.LeftOuterJoin`   E.SqlExpr (Maybe (Entity UserAvs))
    `E.LeftOuterJoin`   E.SqlExpr (Maybe (Entity UserDay))
    `E.LeftOuterJoin`   E.SqlExpr (Maybe (Entity TutorialParticipantDay))
  )

type DailyTableOutput = E.SqlQuery
  ( E.SqlExpr (Entity Course)
  , E.SqlExpr (Entity Tutorial)
  , E.SqlExpr (Entity TutorialParticipant)
  , E.SqlExpr (Entity User)
  , E.SqlExpr (Maybe (Entity UserAvs))
  , E.SqlExpr (Maybe (Entity UserDay))
  , E.SqlExpr (Maybe (Entity TutorialParticipantDay))
  , E.SqlExpr (E.Value (Maybe CompanyId))
  , E.SqlExpr (E.Value (Maybe [QualificationId]))
  )

type DailyTableData   = DBRow
  ( Entity Course
  , Entity Tutorial
  , Entity TutorialParticipant
  , Entity User
  , Maybe (Entity UserAvs)
  , Maybe (Entity UserDay)
  , Maybe (Entity TutorialParticipantDay)
  , E.Value (Maybe CompanyId)
  , E.Value (Maybe [QualificationId])
  )

data DailyFormData = DailyFormData
  { dailyFormDrivingPermit    :: Maybe UserDrivingPermit
  , dailyFormEyeExam          :: Maybe UserEyeExam
  , dailyFormParticipantNote  :: Maybe Text
  , dailyFormAttendance       :: Bool
  , dailyFormAttendanceNote   :: Maybe Text
  , dailyFormParkingToken     :: Bool
  } deriving (Eq, Show)

makeLenses_ ''DailyFormData

-- force declarations before this point to avoid staging restrictions
$(return [])


queryCourse :: DailyTableExpr -> E.SqlExpr (Entity Course)
queryCourse = $(sqlMIXproj' ''DailyTableExpr 1)

queryTutorial :: DailyTableExpr -> E.SqlExpr (Entity Tutorial)
queryTutorial = $(sqlMIXproj' ''DailyTableExpr 2)

queryParticipant :: DailyTableExpr -> E.SqlExpr (Entity TutorialParticipant)
queryParticipant = $(sqlMIXproj' ''DailyTableExpr 3)
-- queryParticipant = $(sqlMIXproj DAILY_TABLE_JOIN 3) -- reify seems problematic for now

queryUser :: DailyTableExpr -> E.SqlExpr (Entity User)
queryUser = $(sqlMIXproj' ''DailyTableExpr 4)

queryUserAvs :: DailyTableExpr -> E.SqlExpr (Maybe (Entity UserAvs))
queryUserAvs = $(sqlMIXproj' ''DailyTableExpr 5)

queryUserDay :: DailyTableExpr -> E.SqlExpr (Maybe (Entity UserDay))
queryUserDay = $(sqlMIXproj' ''DailyTableExpr 6)

queryParticipantDay :: DailyTableExpr -> E.SqlExpr (Maybe (Entity TutorialParticipantDay))
queryParticipantDay = $(sqlMIXproj' ''DailyTableExpr 7)

resultCourse :: Lens' DailyTableData (Entity Course)
resultCourse = _dbrOutput . _1

resultTutorial :: Lens' DailyTableData (Entity Tutorial)
resultTutorial = _dbrOutput . _2

resultParticipant :: Lens' DailyTableData (Entity TutorialParticipant)
resultParticipant = _dbrOutput . _3

resultUser :: Lens' DailyTableData (Entity User)
resultUser = _dbrOutput . _4

resultUserAvs :: Traversal' DailyTableData UserAvs
resultUserAvs = _dbrOutput . _5 . _Just . _entityVal

resultUserDay :: Traversal' DailyTableData UserDay
resultUserDay = _dbrOutput . _6 . _Just . _entityVal

resultParticipantDay :: Traversal' DailyTableData TutorialParticipantDay
resultParticipantDay = _dbrOutput . _7 . _Just . _entityVal

resultCompanyId :: Traversal' DailyTableData CompanyId
resultCompanyId = _dbrOutput . _8 . _unValue . _Just

resultCourseQualis :: Traversal' DailyTableData [QualificationId]
resultCourseQualis = _dbrOutput . _9 . _unValue . _Just


instance HasEntity DailyTableData User where
  hasEntity = resultUser

instance HasUser DailyTableData where
  hasUser = resultUser . _entityVal

-- see colRatedField' for an example of formCell usage

drivingPermitField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserDrivingPermit
drivingPermitField = selectField' (Just $ SomeMessage MsgBoolIrrelevant) optionsFinite

eyeExamField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserEyeExam
eyeExamField = selectField' (Just $ SomeMessage MsgBoolIrrelevant) optionsFinite

mkDailyFormColumn :: (RenderMessage UniWorX msg) => Text -> msg -> Lens' DailyTableData a -> ASetter' DailyFormData a -> Field _ a -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
mkDailyFormColumn k msg lg ls f = sortable (Just $ SortingKey $ stripCI k) (i18nCell msg) $ formCell
  id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table
  (views (resultParticipant . _entityKey) return) -- generate row identfifiers for use in form result
  (\(view lg -> x) mkUnique ->
    over (_1.mapped) (ls .~) . over _2 fvWidget <$> mreq f (fsUniq mkUnique k) (Just x)
  )   -- Given the row data and a callback to make an input name suitably unique generate the MForm

colParticipantPermitField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParticipantPermitField = colParticipantPermitField' _dailyFormDrivingPermit

colParticipantPermitField' :: ASetter' a (Maybe UserDrivingPermit) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
colParticipantPermitField' l = sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ (cellAttrs <>~ [("style","width:1%")]) <$> formCell
  id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table
  (views (resultParticipant . _entityKey) return) -- generate row identfifiers for use in form result
  (\(view (resultParticipant . _entityVal . _tutorialParticipantDrivingPermit) -> x) mkUnique ->
    over (_1.mapped) (l .~) . over _2 fvWidget <$> mopt drivingPermitField (fsUniq mkUnique "permit" & addClass' "uwx-narrow") (Just x)
  )   -- Given the row data and a callback to make an input name suitably unique generate the MForm

colParticipantEyeExamField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParticipantEyeExamField = colParticipantEyeExamField' _dailyFormEyeExam

colParticipantEyeExamField' :: ASetter' a (Maybe UserEyeExam) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ (cellAttrs <>~ [("style","width:1%")]) <$> formCell id
  (views (resultParticipant . _entityKey) return)
  (\(view (resultParticipant . _entityVal . _tutorialParticipantEyeExam) -> x) mkUnique ->
    over (_1.mapped) (l .~) . over _2 fvWidget <$> mopt eyeExamField (fsUniq mkUnique "eye-exam" & addClass' "uwx-narrow") (Just x)
  )

-- colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
-- colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id
--   (views (resultParticipant . _entityKey) return)
--   (\(view (resultParticipant . _entityVal . _tutorialParticipantNote) -> note) mkUnique ->
--     over (_1.mapped) ((_dailyFormParticipantNote .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$>
--       mopt textareaField (fsUniq mkUnique "note-tutorial") (Just $ Textarea <$> note)
--   )

colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","min-width:12em")]) <$>
  formCell id
  (views (resultParticipant . _entityKey) return)
  (\row mkUnique ->
    let note = row ^. resultParticipant . _entityVal . _tutorialParticipantNote
        sid  = row ^. resultCourse . _entityVal . _courseSchool
        cid  = row ^. resultCourse . _entityKey
        tid  = row ^. resultTutorial . _entityKey
    in over (_1.mapped) ((_dailyFormParticipantNote .~) . assertM (not . null) . fmap Text.strip) . over _2 fvWidget <$>
      mopt (textField & cfStrip & addDatalist (suggsParticipantNote sid cid tid)) (fsUniq mkUnique "note-tutorial") (Just note)
  )

suggsParticipantNote :: SchoolId -> CourseId -> TutorialId -> Handler (OptionList Text)
suggsParticipantNote sid cid tid = do
  ol <- memcachedBy (Just . Right $ 2 * diffHour) (CacheKeySuggsParticipantNote sid tid) $ do
    suggs <- runDB $ E.select $ do
      let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
      (tpn, prio) <- E.from $
        ( do
            tpa <- E.from $ E.table @TutorialParticipant
            E.where_ $ E.isJust (tpa E.^. TutorialParticipantNote)
                E.&&.  tpa E.^. TutorialParticipantTutorial E.==. E.val tid
            E.groupBy $ tpa E.^. TutorialParticipantNote
            E.orderBy [E.desc countRows']
            E.limit maxSuggestions
            pure (tpa E.^. TutorialParticipantNote, E.val (1 :: Int64))
        ) `E.unionAll_`
        ( do
            (tpa :& tut) <- E.from $  E.table @TutorialParticipant
                        `E.innerJoin` E.table @Tutorial
                        `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantTutorial)
            E.where_ $ E.isJust (tpa E.^. TutorialParticipantNote)
                E.&&. tpa E.^. TutorialParticipantTutorial E.!=. E.val tid
                E.&&. tut E.^. TutorialCourse E.==. E.val cid
            E.groupBy (tut E.^. TutorialLastChanged, tpa E.^. TutorialParticipantNote)
            E.orderBy [E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
            E.limit maxSuggestions
            pure (tpa E.^. TutorialParticipantNote, E.val 2)
        ) `E.unionAll_`
        ( do
            tpa :& tut :& crs <- E.from $ E.table @TutorialParticipant
                        `E.innerJoin` E.table @Tutorial
                        `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantTutorial)
                        `E.innerJoin` E.table @Course
                        `E.on` (\(_ :& tut :& crs) -> tut E.^. TutorialCourse E.==. crs E.^. CourseId)
            E.where_ $ E.isJust (tpa E.^. TutorialParticipantNote)
                E.&&. tpa E.^. TutorialParticipantTutorial E.!=. E.val tid
                E.&&. tut E.^. TutorialCourse E.!=. E.val cid
                E.&&. crs E.^. CourseSchool E.==. E.val sid
            E.groupBy (tut E.^. TutorialLastChanged, tpa E.^. TutorialParticipantNote)
            E.orderBy [E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
            E.limit maxSuggestions
            pure (tpa E.^. TutorialParticipantNote, E.val 3)
        )
      E.groupBy (tpn, prio)
      E.orderBy [E.asc prio, E.asc tpn]
      E.limit maxSuggestions
      pure $ E.coalesceDefault [tpn] $ E.val "" -- default never used due to where_ condtions, but conveniently changes type
    --    $logInfoS "NOTE-SUGGS *** A: " $ tshow suggs
    pure $ mkOptionListCacheable $ mkOptionText <$> nubOrd suggs
  --      $logInfoS "NOTE-SUGGS *** B: " $ tshow ol
  pure $ mkOptionListFromCacheable ol

suggsAttendanceNote :: SchoolId -> CourseId -> TutorialId -> Handler (OptionList Text)
suggsAttendanceNote sid cid tid = do
  ol <- memcachedBy (Just . Right $ 2 * diffHour) (CacheKeySuggsAttendanceNote sid tid) $ do
    suggs <- runDB $ E.select $ do
      let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
      (tpn, prio) <- E.from $
        ( do
            tpa <- E.from $ E.table @TutorialParticipantDay
            E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote)
                E.&&.  tpa E.^. TutorialParticipantDayTutorial E.==. E.val tid
            E.groupBy (tpa E.^. TutorialParticipantDayNote, tpa E.^. TutorialParticipantDayDay)
            E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc countRows']
            E.limit maxSuggestions
            pure (tpa E.^. TutorialParticipantDayNote, E.val (1 :: Int64))
        ) `E.unionAll_`
        ( do
            (tpa :& tut) <- E.from $  E.table @TutorialParticipantDay
                        `E.innerJoin` E.table @Tutorial
                        `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantDayTutorial)
            E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote)
                E.&&. tpa E.^. TutorialParticipantDayTutorial E.!=. E.val tid
                E.&&. tut E.^. TutorialCourse E.==. E.val cid
            E.groupBy (tpa E.^. TutorialParticipantDayNote, tpa E.^. TutorialParticipantDayDay, tut E.^. TutorialLastChanged)
            E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
            E.limit maxSuggestions
            pure (tpa E.^. TutorialParticipantDayNote, E.val 2)
        ) `E.unionAll_`
        ( do
            tpa :& tut :& crs <- E.from $ E.table @TutorialParticipantDay
                        `E.innerJoin` E.table @Tutorial
                        `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantDayTutorial)
                        `E.innerJoin` E.table @Course
                        `E.on` (\(_ :& tut :& crs) -> tut E.^. TutorialCourse E.==. crs E.^. CourseId)
            E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote)
                E.&&. tpa E.^. TutorialParticipantDayTutorial E.!=. E.val tid
                E.&&. tut E.^. TutorialCourse E.!=. E.val cid
                E.&&. crs E.^. CourseSchool E.==. E.val sid
            E.groupBy (tpa E.^. TutorialParticipantDayNote, tpa E.^. TutorialParticipantDayDay, tut E.^. TutorialLastChanged)
            E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
            E.limit maxSuggestions
            pure (tpa E.^. TutorialParticipantDayNote, E.val 3)
        )
      E.groupBy (tpn, prio)
      E.orderBy [E.asc prio, E.asc tpn]
      E.limit maxSuggestions
      pure $ E.coalesceDefault [tpn] $ E.val "" -- default never used due to where_ condtions, but conveniently changes type
    pure $ mkOptionListCacheable $ mkOptionText <$> nubOrd suggs -- NOTE: datalist does not work on textarea inputs
  pure $ mkOptionListFromCacheable ol


colAttendanceField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colAttendanceField dday = sortable (Just "attendance") (i18nCell $ MsgTutorialDayAttendance dday) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell id
  (views (resultParticipant . _entityKey) return)
  (\(preview (resultParticipantDay . _tutorialParticipantDayAttendance) -> attendance) mkUnique ->
    over (_1.mapped) (_dailyFormAttendance .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "attendance") attendance
  )

colAttendanceNoteField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","min-width:12em")]) <$>
  formCell id
  (views (resultParticipant . _entityKey) return)
  (\row mkUnique ->
    let note = row ^? resultParticipantDay . _tutorialParticipantDayNote
        sid  = row ^. resultCourse . _entityVal . _courseSchool
        cid  = row ^. resultCourse . _entityKey
        tid  = row ^. resultTutorial . _entityKey
    in over (_1.mapped) ((_dailyFormAttendanceNote .~) . assertM (not . null) . fmap Text.strip) . over _2 fvWidget <$>  --  For Textarea use:  fmap (Text.strip . unTextarea)
      mopt (textField & cfStrip & addDatalist (suggsAttendanceNote sid cid tid)) (fsUniq mkUnique "note-attendance") note
      ---- Version für Textare
      -- mopt  (textareaField)  --  & addDatalist (suggsAttendanceNote sid cid tid)) -- NOTE: datalist does not work on textarea inputs
      --       (fsUniq mkUnique "note-attendance" & addClass' "uwx-short"
      --                                     --   & addAttr "rows"  "2"      -- does not work without class uwx-short
      --                                     --   & addAttr "cols" "12"      -- let it stretch
      --                                     --   & addAutosubmit -- submits while typing
      --       ) (Textarea <<$>> note)
  )

colParkingField :: Text ->  Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParkingField = colParkingField' _dailyFormParkingToken

-- colParkingField' :: ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
-- colParkingField' l = sortable (Just "parking") (i18nCell MsgTableUserParkingToken) $ formCell id
--   (views (resultParticipant . _entityKey) return)
--   (\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique ->
--     over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
--   )

colParkingField' :: ASetter' a Bool -> Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
colParkingField' l dday = sortable (Just "parking") (i18nCell $ MsgTableUserParkingToken dday) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell
  id -- TODO: this should not be id! Refactor to simplify the third argument below
  (views (resultParticipant . _entityKey) return)
  (\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique ->
    over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
  )

mkDailyTable :: Bool -> SchoolId -> Day -> Maybe DayCheckResults -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Maybe Widget)
mkDailyTable isAdmin ssh nd dcrs = getDayTutorials ssh (nd,nd) >>= \case
  tutLessons
    | Map.null tutLessons -> return (FormMissing, Nothing)
    | otherwise -> do
      dday <- formatTime SelFormatDate nd
      let
        tutIds = Map.keys tutLessons
        dbtSQLQuery :: DailyTableExpr -> DailyTableOutput
        dbtSQLQuery  (crs `E.InnerJoin` tut `E.InnerJoin` tpu `E.InnerJoin` usr `E.LeftOuterJoin` avs `E.LeftOuterJoin` udy `E.LeftOuterJoin` tdy) = do
          EL.on $ tut E.^. TutorialId     E.=?. tdy E.?. TutorialParticipantDayTutorial
            E.&&. usr E.^. UserId         E.=?. tdy E.?. TutorialParticipantDayUser
            E.&&. E.val nd                E.=?. tdy E.?. TutorialParticipantDayDay
          EL.on $ usr E.^. UserId         E.=?. udy E.?. UserDayUser
            E.&&. E.val nd                E.=?. udy E.?. UserDayDay
          EL.on $ usr E.^. UserId         E.=?. avs E.?. UserAvsUser
          EL.on $ usr E.^. UserId         E.==. tpu E.^. TutorialParticipantUser
          EL.on $ tut E.^. TutorialId     E.==. tpu E.^. TutorialParticipantTutorial
          EL.on $ tut E.^. TutorialCourse E.==. crs E.^. CourseId
          E.where_ $ tut E.^. TutorialId `E.in_` E.valList tutIds
          let associatedQualifications = E.subSelectMaybe . EL.from $ \cq -> do
                E.where_ $ cq E.^. CourseQualificationCourse E.==. crs E.^. CourseId
                let cqQual  = cq E.^. CourseQualificationQualification
                    cqOrder = [E.asc $ cq E.^. CourseQualificationSortOrder, E.asc cqQual]
                return $ E.arrayAggWith E.AggModeAll cqQual cqOrder
          return (crs, tut, tpu, usr, avs, udy, tdy, selectCompanyUserPrime usr, associatedQualifications)
        dbtRowKey = queryParticipant >>> (E.^. TutorialParticipantId)
        dbtProj   = dbtProjId
        dbtColonnade = formColonnade $ mconcat
          [ -- dbSelect (applying _2) id (return . view (resultTutorial . _entityKey))
            sortable (Just "course")    (i18nCell MsgTableCourse)     $ \(view $ resultCourse . _entityVal -> c) -> courseCell c
          , sortable (Just "tutorial")  (i18nCell MsgCourseTutorial)   $ \row ->
              let Course{courseTerm=tid, courseSchool=cssh, courseShorthand=csh}
                          = row ^. resultCourse   . _entityVal
                  tutName = row ^. resultTutorial . _entityVal . _tutorialName
              in anchorCell (CTutorialR tid cssh csh tutName TUsersR) $ citext2widget tutName
          , sortable Nothing (i18nCell MsgTableTutorialOccurrence) $ \(view $ resultTutorial . _entityKey -> tutId) -> cellMaybe (lessonTimesCell False . snd) $ Map.lookup tutId tutLessons
          , sortable Nothing (i18nCell MsgTableTutorialRoom) $ \(view $ resultTutorial . _entityKey -> tutId) ->
              -- listInlineCell (nubOrd . concat $ mapMM lessonRoom $ Map.lookup tutId tutLessons) roomReferenceCell
              cellMaybe ((`listInlineCell` roomReferenceCell) . nubOrd) $ mapMM lessonRoom $ snd <$> Map.lookup tutId tutLessons
          -- , sortable Nothing (i18nCell MsgTableTutorialRoom) $ \(view $ resultTutorial . _entityKey -> _) -> listCell ["A","D","C","B"] textCell -- DEMO: listCell reverses the order, for list-types! listInlineCell is fixed now
          , sortable Nothing (i18nCell $ MsgCourseQualifications 3) $ \(preview resultCourseQualis -> cqs) -> maybeCell cqs $ flip listInlineCell qualificationIdShortCell
          -- , sortable (Just "user-company") (i18nCell MsgTablePrimeCompany) $ \(preview resultCompanyId -> mcid) -> cellMaybe companyIdCell mcid
          -- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid
          , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row ->
              let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany
                  primComp = row ^? resultCompanyId
                  bookLink = cellMaybe companyIdCell bookComp
                  result
                    | primComp /= bookComp
                    , Just (unCompanyKey -> csh) <- primComp
                      = cell (iconTooltip [whamlet|_{MsgAvsPrimaryCompany}: ^{companyWidget True (csh, csh, False)}|]
                             (Just IconCompany) True)
                      <> spacerCell
                      <> bookLink
                    | otherwise = bookLink
              in result
          -- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row ->
          --     let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany
          --         primComp = row ^? resultCompanyId
          --         bookLink = cellMaybe companyIdCell bookComp
          --         warnIcon = \csh -> iconTooltip [whamlet|_{MsgAvsPrimaryCompany}: ^{companyWidget True (csh, csh, False)}|] (Just IconCompanyWarning) True
          --         result
          --           | primComp /= bookComp
          --           , Just (unCompanyKey -> csh) <- primComp
          --             = bookLink
          --             <> spacerCell
          --             <> cell (modal (warnIcon csh) (Right -- maybe just use iconCompanyWarning instead of modal?
          --                 [whamlet|
          --                   <h2>
          --                     ^{userWidget row}
          --                   <p>
          --                     _{MsgAvsPrimaryCompany}: ^{companyWidget True (csh, csh, False)}
          --                 |]
          --                 ))
          --           | otherwise = bookLink
          --     in result
          , maybeEmpty dcrs $ \DayCheckResults{..} ->
            sortable (Just "check-fail") (timeCell dcrTimestamp) $ \(view $ resultParticipant . _entityKey -> tpid) ->
              maybeCell (Map.lookup tpid dcrResults) $ wgtCell . dcr2widgetIcn Nothing
          , colUserNameModalHdr MsgCourseParticipant ForProfileDataR
          , colUserMatriclenr isAdmin
          , sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn
          , colParticipantEyeExamField
          , colParticipantPermitField
          , colParticipantNoteField
          , colAttendanceField     dday
          , colAttendanceNoteField dday
          , colParkingField        dday
          -- FOR DEBUGGING ONLY:
          -- , sortable (Just "permit")        (i18nCell   MsgTutorialDrivingPermit)      $ \(view $ resultParticipant . _entityVal . _tutorialParticipantDrivingPermit -> x) -> x & cellMaybe i18nCell
          -- , sortable (Just "eye-exam")      (i18nCell   MsgTutorialEyeExam)            $ \(view $ resultParticipant . _entityVal . _tutorialParticipantEyeExam       -> x) -> x & cellMaybe i18nCell
          -- , sortable (Just "note-tutorial") (i18nCell   MsgTutorialNote)               $ \(view $ resultParticipant . _entityVal . _tutorialParticipantNote          -> x) -> x & cellMaybe textCell
          -- , sortable (Just "attendance")    (i18nCell $ MsgTutorialDayAttendance dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayAttendance        -> x) -> x & cellMaybe tickmarkCell
          -- , sortable (Just "note-attend")   (i18nCell $ MsgTutorialDayNote       dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayNote . _Just      -> x) -> x & cellMaybe textCell
          -- , sortable (Just "parking")       (i18nCell   MsgTableUserParkingToken)      $ \(preview $ resultUserDay . _userDayParkingToken -> x) -> maybeCell x tickmarkCell
          ]
        dbtSorting = Map.fromList
          [ sortUserNameLink queryUser
          , sortUserMatriclenr  queryUser
          , ("course"         , SortColumn $ queryCourse      >>> (E.^. CourseName))
          , ("tutorial"       , SortColumn $ queryTutorial    >>> (E.^. TutorialName))
          , ("user-company"   , SortColumn $ queryUser        >>> selectCompanyUserPrime)
          , ("booking-firm"   , SortColumn $ queryParticipant >>> (E.^. TutorialParticipantCompany))
          , ("card-no"        , SortColumn $ queryUserAvs     >>> (E.?. UserAvsLastCardNo))
          , ("permit"         , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantDrivingPermit))
          , ("eye-exam"       , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantEyeExam))
          , ("note-tutorial"  , SortColumn         $ queryParticipant >>> (E.^. TutorialParticipantNote))
          , ("attendance"     , SortColumnNullsInv $ queryParticipantDay >>> (E.?. TutorialParticipantDayAttendance))
          , ("note-attend"    , SortColumn         $ queryParticipantDay >>> (E.?. TutorialParticipantDayNote))
          , ("parking"        , SortColumnNullsInv $ queryUserDay     >>> (E.?. UserDayParkingToken))
          -- , ("check-fail"     , SortColumn $ queryParticipant >>> (\pid -> pid E.^. TutorialParticipantId `E.in_` E.vals (maybeEmpty dcrs $ dcrResults >>> Map.keys)))
          , let dcrsLevels = maybeEmpty dcrs $ dcrSeverityGroups . dcrResults in
            ("check-fail"     , SortColumn $ queryParticipant >>> (\((E.^. TutorialParticipantId) -> pid) -> E.case_
              [ E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _1)) E.then_ (E.val   1)
              , E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _2)) E.then_ (E.val   2)
              , E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _3)) E.then_ (E.val   3)
              , E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _4)) E.then_ (E.val   4)
              , E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _5)) E.then_ (E.val   5)
              ]                                                (E.else_  E.val (99 :: Int64))
              ))
          ]
        dbtFilter = Map.fromList
          [ fltrUserNameEmail   queryUser
          , fltrUserMatriclenr  queryUser
          , ("course"       , FilterColumn . E.mkContainsFilter $ queryCourse   >>> (E.^. CourseName))
          , ("tutorial"     , FilterColumn . E.mkContainsFilter $ queryTutorial >>> (E.^. TutorialName))
          , ("booking-firm" , FilterColumn . E.mkContainsFilterWith Just $ queryParticipant >>> (E.^. TutorialParticipantCompany))
          , ("user-company" , FilterColumn . E.mkContainsFilterWith Just $ queryUser        >>> selectCompanyUserPrime)
          ]
        dbtFilterUI mPrev = mconcat
          [ prismAForm (singletonFilter "course"       . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgFilterCourse)
          , prismAForm (singletonFilter "tutorial"     . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgCourseTutorial)
          , prismAForm (singletonFilter "booking-firm" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgTableBookingCompanyShort)
          , prismAForm (singletonFilter "user-company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgTablePrimeCompanyShort)
          , fltrUserNameEmailUI  mPrev
          , fltrUserMatriclenrUI mPrev
          ]
        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
        dbtIdent :: Text
        dbtIdent = "daily"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []
        dbtParams    = def { dbParamsFormAction = Just $ SomeRoute $ SchoolR ssh $ SchoolDayR nd }
        -- dbtParams = DBParamsForm
        --   { dbParamsFormMethod = POST
        --   , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
        --   , dbParamsFormAttrs  = []
        --   , dbParamsFormSubmit = FormSubmit
        --   , dbParamsFormAdditional = \frag -> do
        --       let acts :: Map DailyTableAction (AForm Handler DailyTableActionData)
        --           acts = mconcat
        --                   [ singletonMap DailyActDummy $ pure DailyActDummyData
        --                    ]
        --       (actionRes, action) <- multiActionM acts "" Nothing mempty
        --       return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action)
        --   -- , dbParamsFormAdditional
        --   --     = let acts :: Map DailyTableAction (AForm Handler DailyTableActionData)
        --   --           acts = mconcat
        --   --             [ singletonMap DailyActDummy $ pure DailyActDummyData
        --   --             ]
        --   --        in renderAForm FormStandard
        --   --          $  (, mempty) . First . Just
        --   --         <$> multiActionA acts (fslI MsgTableAction) Nothing
        --   , dbParamsFormEvaluate = liftHandler . runFormPost
        --   , dbParamsFormResult   = _1
        --   , dbParamsFormIdent    = def
        --   }
        -- postprocess :: FormResult (First DailyTableActionData, DBFormResult TutorialParticipantId Bool DailyTableData)
        --             -> FormResult (      DailyTableActionData,          Set TutorialId)
        -- postprocess inp = do
        --     (First (Just act), jobMap) <- inp
        --     let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
        --     return (act, jobSet)
        psValidator = def & defaultSorting [SortAscBy "user-name", SortAscBy "course", SortAscBy "tutorial"]
      -- over _1 postprocess <$> dbTable psValidator DBTable{..}
      over _2 Just <$> dbTable psValidator DBTable{..}


getSchoolDayR,  postSchoolDayR :: SchoolId -> Day -> Handler Html
getSchoolDayR = postSchoolDayR
postSchoolDayR ssh nd = do
  isAdmin <- hasReadAccessTo AdminR
  dday <- formatTime SelFormatDate nd
  let unFormResult = getDBFormResult $ \row -> let tpt = row ^. resultParticipant . _entityVal
        in DailyFormData
            { dailyFormDrivingPermit   = tpt ^. _tutorialParticipantDrivingPermit
            , dailyFormEyeExam         = tpt ^. _tutorialParticipantEyeExam
            , dailyFormParticipantNote = tpt ^. _tutorialParticipantNote
            , dailyFormAttendance      = row ^? resultParticipantDay ._tutorialParticipantDayAttendance   & fromMaybe False
            , dailyFormAttendanceNote  = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just
            , dailyFormParkingToken    = row ^? resultUserDay . _userDayParkingToken                      & fromMaybe False
            }
  dcrs <- memcachedByGet (CacheKeyTutorialCheckResults ssh nd)
  (fmap unFormResult -> tableRes, tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd dcrs
  -- logInfoS "****DailyTable****" $ tshow tableRes
  formResult tableRes $ \resMap -> do
    tuts <- runDB $ forM (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do
      -- logDebugS "TableForm" (tshow dfd)
      TutorialParticipant{..} <- get404 tpid -- needed anyway to find the ParticipantDay/UserDay updated
      when ( tutorialParticipantDrivingPermit /= dailyFormDrivingPermit
          || tutorialParticipantEyeExam       /= dailyFormEyeExam
          || tutorialParticipantNote          /= dailyFormParticipantNote) $
        update tpid [ TutorialParticipantDrivingPermit =. dailyFormDrivingPermit
                    , TutorialParticipantEyeExam       =. dailyFormEyeExam
                    , TutorialParticipantNote          =. dailyFormParticipantNote
                    ]
      let tpdUq = UniqueTutorialParticipantDay tutorialParticipantTutorial tutorialParticipantUser nd
      if not dailyFormAttendance && isNothing (canonical dailyFormAttendanceNote)
        then deleteBy  tpdUq
        else upsertBy_ tpdUq (TutorialParticipantDay tutorialParticipantTutorial tutorialParticipantUser nd dailyFormAttendance dailyFormAttendanceNote)
          [ TutorialParticipantDayAttendance =. dailyFormAttendance
          , TutorialParticipantDayNote       =. dailyFormAttendanceNote
          ]
      let udUq = UniqueUserDay tutorialParticipantUser nd
          updateUserDay = if dailyFormParkingToken
                            then flip upsertBy_ (UserDay tutorialParticipantUser nd dailyFormParkingToken) -- upsert if a permit was issued
                            else      updateBy  -- only update to no permit, if the record exists, but do not create a fresh record with parkingToken==False
      updateUserDay udUq [ UserDayParkingToken =. dailyFormParkingToken]
      return tutorialParticipantTutorial
    forM_ tuts $ \tid -> do
      memcachedByInvalidate (CacheKeySuggsParticipantNote ssh tid) $ Proxy @(OptionListCacheable Text)
      memcachedByInvalidate (CacheKeySuggsAttendanceNote  ssh tid) $ Proxy @(OptionListCacheable Text)
    -- audit log? Currently decided against.
    memcachedByInvalidate (CacheKeyTutorialCheckResults ssh nd) $ Proxy @DayCheckResults
    addMessageI Success $ MsgTutorialParticipantsDayEdits dday
    redirect $ SchoolR ssh $ SchoolDayR nd

  siteLayoutMsg (MsgMenuSchoolDay ssh dday) $ do
    let consistencyBtn = btnModal MsgMenuSchoolDayCheck [BCIsButton, BCDefault] (Left $ SomeRoute $ SchoolR ssh $ SchoolDayCheckR nd)
    setTitleI (MsgMenuSchoolDay ssh dday)
    $(i18nWidgetFile "day-view")


-- | A wrapper for several check results on tutorial participants
data DayCheckResult = DayCheckResult
      { dcAvsKnown      :: Bool
      , dcApronAccess   :: Bool
      , dcBookingFirmOk :: Bool
      , dcEyeFitsPermit :: Maybe Bool
      }
  deriving (Eq, Show, Generic, Binary)

data DayCheckResults = DayCheckResults
      { dcrTimestamp :: UTCTime
      , dcrResults   :: Map TutorialParticipantId DayCheckResult
      }
  deriving (Show, Generic, Binary)

-- | True iff there is no problem at all
dcrIsOk :: DayCheckResult -> Bool
dcrIsOk (DayCheckResult True True True (Just True)) = True
dcrIsOk _ = False

-- | defines categories on DayCheckResult, implying an ordering, with most severe being least
dcrSeverity :: DayCheckResult -> Int
dcrSeverity DayCheckResult{dcAvsKnown      = False     } =  1
dcrSeverity DayCheckResult{dcApronAccess   = False     } =  2
dcrSeverity DayCheckResult{dcBookingFirmOk = False     } =  3
dcrSeverity DayCheckResult{dcEyeFitsPermit = Nothing   } =  4
dcrSeverity DayCheckResult{dcEyeFitsPermit = Just False} =  5
dcrSeverity _                                            = 99

instance Ord DayCheckResult where
  compare = compare `on` dcrSeverity

type DayCheckGroups = ( Set TutorialParticipantId -- 1 severity
                      , Set TutorialParticipantId -- 2
                      , Set TutorialParticipantId -- 3
                      , Set TutorialParticipantId -- 4
                      , Set TutorialParticipantId -- 5
                      )

dcrSeverityGroups :: Map TutorialParticipantId DayCheckResult -> DayCheckGroups
dcrSeverityGroups = Map.foldMapWithKey groupBySeverity
  where
    groupBySeverity :: TutorialParticipantId -> DayCheckResult -> DayCheckGroups
    groupBySeverity tpid dcr =
      let sempty = mempty :: DayCheckGroups
      in case dcrSeverity dcr of
        1 -> set _1 (Set.singleton tpid) sempty
        2 -> set _2 (Set.singleton tpid) sempty
        3 -> set _3 (Set.singleton tpid) sempty
        4 -> set _4 (Set.singleton tpid) sempty
        5 -> set _5 (Set.singleton tpid) sempty
        _ ->                             sempty

-- | Possible outcomes for DayCheckResult
dcrMessages :: [SomeMessage UniWorX]
dcrMessages = [ SomeMessage   MsgAvsPersonSearchEmpty
              , SomeMessage   MsgAvsNoApronCard
              , SomeMessage $ MsgAvsNoCompanyCard Nothing
              , SomeMessage   MsgCheckEyePermitMissing
              , SomeMessage   MsgCheckEyePermitIncompatible
              ]

-- | Show most important problem as text
dcr2widgetTxt :: Maybe CompanyName -> DayCheckResult -> Widget
dcr2widgetTxt _    DayCheckResult{dcAvsKnown=False}          = i18n   MsgAvsPersonSearchEmpty
dcr2widgetTxt _    DayCheckResult{dcApronAccess=False}       = i18n   MsgAvsNoApronCard
dcr2widgetTxt mcn  DayCheckResult{dcBookingFirmOk=False}     = i18n $ MsgAvsNoCompanyCard mcn
dcr2widgetTxt _    DayCheckResult{dcEyeFitsPermit=Nothing}   = i18n   MsgCheckEyePermitMissing
dcr2widgetTxt _    DayCheckResult{dcEyeFitsPermit=Just False}= i18n   MsgCheckEyePermitIncompatible
dcr2widgetTxt _    _                                         = i18n   MsgNoProblem

-- | Show all problems as icon with tooltip
dcr2widgetIcn :: Maybe CompanyName -> DayCheckResult -> Widget
dcr2widgetIcn mcn DayCheckResult{..} = mconcat [avsChk, apronChk, bookChk, permitChk]
  where
    mkTooltip ico msg = iconTooltip msg (Just ico) True

    avsChk    = guardMonoid (not dcAvsKnown)      $ mkTooltip IconUserUnknown     (i18n   MsgAvsPersonSearchEmpty)
    apronChk  = guardMonoid (not dcApronAccess)   $ mkTooltip IconUserBadge       (i18n   MsgAvsNoApronCard)
    bookChk   = guardMonoid (not dcBookingFirmOk) $ mkTooltip IconCompanyWarning  (i18n $ MsgAvsNoCompanyCard mcn)
    permitChk | isNothing dcEyeFitsPermit         = mkTooltip IconFileMissing     (i18n   MsgCheckEyePermitMissing)
              | dcEyeFitsPermit == Just False     = mkTooltip IconGlasses         (i18n   MsgCheckEyePermitIncompatible)
              | otherwise = mempty

type ParticipantCheckData = (Entity TutorialParticipant, UserDisplayName, UserSurname, Maybe AvsPersonId, Maybe CompanyName)

dayCheckParticipant :: Map AvsPersonId AvsDataPerson
                    -> ParticipantCheckData
                    -> DayCheckResult
dayCheckParticipant avsStats (Entity {entityVal=TutorialParticipant{..}}, _udn, _usn, mapi, mcmp) =
    let dcEyeFitsPermit = liftM2 eyeExamFitsDrivingPermit tutorialParticipantEyeExam tutorialParticipantDrivingPermit
        (dcAvsKnown, (dcApronAccess, dcBookingFirmOk))
          | Just AvsDataPerson{avsPersonPersonCards = apcs} <- lookupMaybe avsStats mapi
            = (True , mapBoth getAny $ foldMap (hasApronAccess &&& fitsBooking mcmp) apcs)
          | otherwise
            = (False, (False, False))
    in DayCheckResult{..}
  where
    hasApronAccess :: AvsDataPersonCard -> Any
    hasApronAccess AvsDataPersonCard{avsDataValid=True, avsDataCardColor=AvsCardColorGelb} = Any True
    hasApronAccess AvsDataPersonCard{avsDataValid=True, avsDataCardColor=AvsCardColorRot}  = Any True
    hasApronAccess _ = Any False

    fitsBooking :: Maybe CompanyName -> AvsDataPersonCard -> Any
    fitsBooking (Just cn) AvsDataPersonCard{avsDataValid=True,avsDataFirm=Just df}  = Any $ cn == stripCI df
    fitsBooking _ _ = Any False

-- | Prüft die Teilnehmer der Tagesansicht: AVS online aktualisieren, gültigen Vorfeldausweis prüfen, buchende Firma mit Ausweisnummer aus AVS abgleichen
getSchoolDayCheckR :: SchoolId -> Day -> Handler Html
getSchoolDayCheckR ssh nd = do
  -- isAdmin <- hasReadAccessTo AdminR
  now <- liftIO getCurrentTime
  let nowaday = utctDay now
  dday <- formatTime SelFormatDate nd

  (tuts, parts_avs, examProblemsTbl) <- runDB $ do
    tuts <- getDayTutorials ssh (nd,nd)
    parts_avs :: [ParticipantCheckData] <- $(unValueNIs 5 [2..5]) <<$>> E.select (do
        (tpa :& usr :& avs :& cmp) <- E.from $  E.table @TutorialParticipant
            `E.innerJoin` E.table @User
            `E.on` (\(tpa :& usr)           -> tpa E.^. TutorialParticipantUser    E.==. usr E.^. UserId)
            `E.leftJoin`  E.table @UserAvs
            `E.on` (\(tpa :& _ :& avs)      -> tpa E.^. TutorialParticipantUser    E.=?. avs E.?. UserAvsUser)
            `E.leftJoin`  E.table @Company
            `E.on` (\(tpa :& _ :& _ :& cmp) -> tpa E.^. TutorialParticipantCompany E.==. cmp E.?. CompanyId)
        E.where_ $ tpa E.^. TutorialParticipantTutorial `E.in_` E.vals (Map.keys tuts)
        -- E.orderBy [E.asc $ tpa E.^. TutorialParticipantTutorial, E.asc $ usr E.^. UserDisplayName] -- order no longer needed
        return (tpa, usr E.^. UserDisplayName, usr E.^. UserSurname, avs E.?. UserAvsPersonId, cmp E.?. CompanyName)
      )
    -- additionally queue proper AVS synchs for all users, unless there were already done today
    void $ queueAvsUpdateByUID (foldMap (^. _1 . _entityVal . _tutorialParticipantUser . to Set.singleton) parts_avs) (Just nowaday)
    -- check for double examiners
    examProblemsTbl <- mkExamProblemsTable ssh nd
    return (tuts, parts_avs, examProblemsTbl)
  let getApi :: ParticipantCheckData -> Set AvsPersonId
      getApi = foldMap Set.singleton . view _4
  avsStats :: Map AvsPersonId AvsDataPerson <- catchAVShandler False False True mempty $ lookupAvsUsers $ foldMap getApi parts_avs -- query AVS, but does not affect DB (no update)
  -- gültigen Vorfeldausweis prüfen, buchende Firma mit Ausweisnummer aus AVS abgleichen
  let toPartMap :: ParticipantCheckData -> Map TutorialParticipantId DayCheckResult
      toPartMap pcd = Map.singleton (pcd ^. _1 . _entityKey) $ dayCheckParticipant avsStats pcd
      participantResults = foldMap toPartMap parts_avs
  memcachedBySet (Just . Right $ 2 * diffHour) (CacheKeyTutorialCheckResults ssh nd) $ DayCheckResults now participantResults

  -- the following is only for displaying results neatly
  let sortBadParticipant acc pcd =
        let tid = pcd ^. _1 . _entityVal . _tutorialParticipantTutorial
            pid = pcd ^. _1 . _entityKey
            udn = pcd ^. _2
            ok  = maybe False dcrIsOk $ Map.lookup pid participantResults
        in if ok then acc else Map.insertWith (<>) tid (Map.singleton (udn,pid) pcd) acc
      badTutPartMap :: Map TutorialId (Map (UserDisplayName, TutorialParticipantId) ParticipantCheckData) -- UserDisplayName as Key ensures proper sort order
      badTutPartMap = foldl' sortBadParticipant mempty parts_avs

      mkBaddieWgt :: TutorialParticipantId -> ParticipantCheckData -> Widget
      mkBaddieWgt pid pcd =
        let name = nameWidget (pcd ^. _2) (pcd ^. _3)
            bookFirm = pcd ^. _5
            problemText  = maybe (text2widget "???") (dcr2widgetTxt bookFirm) (Map.lookup pid participantResults)
            problemIcons = maybe mempty              (dcr2widgetIcn bookFirm) (Map.lookup pid participantResults)
        in [whamlet|^{name}: ^{problemIcons} ^{problemText}|]

  siteLayoutMsg MsgMenuSchoolDayCheck $ do
    setTitleI MsgMenuSchoolDayCheck
    [whamlet|
      <section>
        <h2>
          _{MsgMenuSchoolDay ssh dday}
        <p>
          $if Map.null badTutPartMap
            _{MsgNoProblem}.
          $else
            <dl .deflist.profile-dl>
              $forall (tid,badis)  <- Map.toList badTutPartMap
                <dt .deflist__dt>
                  #{maybe "???" fst (Map.lookup tid tuts)}
                <dd .deflist__dd>
                  <ul>
                    $forall ((_udn,pid),pcd) <- Map.toList badis
                      <li>
                        ^{mkBaddieWgt pid pcd}
        <section>
          <p>
            <h4 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
              _{MsgPossibleCheckResults}
            <p>
              <ul>
                $forall msg <- dcrMessages
                  <li>_{msg}
            <p>
              _{MsgAvsUpdateDayCheck}
      <section>
        ^{maybeTable' MsgExamProblemReoccurrence (Just MsgExamNoProblemReoccurrence) Nothing examProblemsTbl}
      <section>
        ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
    |]


type TblExamPrbsExpr = (                E.SqlExpr (Entity Course)
                      `E.InnerJoin`     E.SqlExpr (Entity Exam)
                      `E.InnerJoin`     E.SqlExpr (Entity ExamRegistration)
                      `E.InnerJoin`     E.SqlExpr (Entity ExamOccurrence)
                      `E.InnerJoin`     E.SqlExpr (Entity User)
                      `E.InnerJoin`     E.SqlExpr (Entity User)
                    )
type TblExamPrbsData = DBRow (Entity Course, Entity Exam, Entity ExamRegistration, Entity ExamOccurrence, Entity User, Entity User)

-- | Table listing double examiner problems for a given school and day
mkExamProblemsTable :: SchoolId -> Day -> DB (Bool, Widget)
mkExamProblemsTable =
  let dbtIdent = "exams-user" :: Text
      dbtStyle = def
      dbtSQLQuery' exOccs (crs `E.InnerJoin` exm `E.InnerJoin` reg `E.InnerJoin` occ `E.InnerJoin` usr `E.InnerJoin` xmr) = do
        EL.on $ xmr E.^. UserId                     E.=?. occ E.^. ExamOccurrenceExaminer
        EL.on $ usr E.^. UserId                     E.==. reg E.^. ExamRegistrationUser
        EL.on $ occ E.^. ExamOccurrenceId           E.=?. reg E.^. ExamRegistrationOccurrence
        EL.on $ exm E.^. ExamId                     E.==. reg E.^. ExamRegistrationExam
        EL.on $ exm E.^. ExamCourse                 E.==. crs E.^. CourseId
        E.where_ $ occ E.^. ExamOccurrenceId `E.in_` E.vals exOccs
            E.&&.  E.exists (do
                altReg :& altOcc <- E.from $ E.table @ExamRegistration `E.innerJoin` E.table @ExamOccurrence
                                    `E.on` (\(altReg :& altOcc) -> altReg E.^. ExamRegistrationOccurrence E.?=. altOcc E.^. ExamOccurrenceId)
                E.where_ $ altReg E.^. ExamRegistrationUser   E.==. reg E.^. ExamRegistrationUser
                    E.&&.  altReg E.^. ExamRegistrationId     E.!=. reg E.^. ExamRegistrationId
                    E.&&.  altOcc E.^. ExamOccurrenceExaminer E.==. occ E.^. ExamOccurrenceExaminer
                    E.&&.  altOcc E.^. ExamOccurrenceId       E.!=. occ E.^. ExamOccurrenceId
              )
        return (crs,exm,reg,occ,usr,xmr)
      queryExmCourse    :: TblExamPrbsExpr -> E.SqlExpr (Entity Course)
      queryExmCourse    = $(sqlIJproj 6 1)
      queryExam         :: TblExamPrbsExpr -> E.SqlExpr (Entity Exam)
      queryExam         = $(sqlIJproj 6 2)
      queryRegistration :: TblExamPrbsExpr -> E.SqlExpr (Entity ExamRegistration)
      queryRegistration = $(sqlIJproj 6 3)
      queryOccurrence   :: TblExamPrbsExpr -> E.SqlExpr (Entity ExamOccurrence)
      queryOccurrence   = $(sqlIJproj 6 4)
      queryTestee       :: TblExamPrbsExpr -> E.SqlExpr (Entity User)
      queryTestee       = $(sqlIJproj 6 5)
      queryExaminer     :: TblExamPrbsExpr -> E.SqlExpr (Entity User)
      queryExaminer     = $(sqlIJproj 6 6)
      resultExmCourse     :: Lens' TblExamPrbsData (Entity Course)
      resultExmCourse     = _dbrOutput . _1
      resultExam          :: Lens' TblExamPrbsData (Entity Exam)
      resultExam          = _dbrOutput . _2
      resultRegistration  :: Lens' TblExamPrbsData (Entity ExamRegistration)
      resultRegistration  = _dbrOutput . _3
      resultOccurrence    :: Lens' TblExamPrbsData (Entity ExamOccurrence)
      resultOccurrence    = _dbrOutput . _4
      resultTestee        :: Lens' TblExamPrbsData (Entity User)
      resultTestee        = _dbrOutput . _5
      resultExaminer      :: Lens' TblExamPrbsData (Entity User)
      resultExaminer      = _dbrOutput . _6
      dbtRowKey = queryRegistration >>> (E.^. ExamRegistrationId)
      dbtProj   = dbtProjId
      dbtColonnade = mconcat
          [ sortable (Just "course")      (i18nCell MsgTableCourse)               $ fmap addIndicatorCell courseCell <$> view (resultExmCourse . _entityVal)
          , sortable (Just "exam")        (i18nCell MsgCourseExam)                $ \row -> examCell (row ^. resultExmCourse . _entityVal) (row ^. resultExam . _entityVal)
          , sortable (Just "registration")(i18nCell MsgCourseExamRegistrationTime)$ dateCell . view (resultRegistration . _entityVal . _examRegistrationTime)
          , sortable (Just "occurrence")  (i18nCell MsgTableExamOccurrence)       $ examOccurrenceCell              . view  resultOccurrence
          , sortable (Just "testee")      (i18nCell MsgExamParticipant)           $ cellHasUserLink ForProfileDataR . view  resultTestee
          , sortable (Just "examiner")    (i18nCell MsgExamCorrectors)            $ cellHasUser                     . view  resultExaminer
          ]
      validator = def & defaultSorting [SortAscBy "course", SortAscBy "exam", SortAscBy "testee"] -- [SortDescBy "registration"]
      dbtSorting  = Map.fromList
          [ ( "course"      , SortColumn $ queryExmCourse     >>> (E.^. CourseName))
          , ( "exam"        , SortColumn $ queryExam          >>> (E.^. ExamName))
          , ( "registration", SortColumn $ queryRegistration  >>> (E.^. ExamRegistrationTime))
          , ( "occurrence"  , SortColumn $ queryOccurrence    >>> (E.^. ExamOccurrenceName))
          , ( "testee"      , SortColumn $ queryTestee        >>> (E.^. UserDisplayName))
          , ( "examiner"    , SortColumn $ queryExaminer      >>> (E.^. UserDisplayName))
          ]
      dbtFilter   = mempty
      dbtFilterUI = mempty
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
      dbtExtraReps = []
  in \ssh nd -> do
    exOccs <- getDayExamOccurrences False ssh Nothing (nd,nd)
    let dbtSQLQuery = dbtSQLQuery' $ Map.keys exOccs
    (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}

