|
|
|
|
@ -191,8 +191,8 @@ queryTutorial :: DailyTableExpr -> E.SqlExpr (Entity Tutorial)
|
|
|
|
|
queryTutorial = $(sqlMIXproj' ''DailyTableExpr 2)
|
|
|
|
|
|
|
|
|
|
queryParticipant :: DailyTableExpr -> E.SqlExpr (Entity TutorialParticipant)
|
|
|
|
|
queryParticipant = $(sqlMIXproj' ''DailyTableExpr 3) -- TODO reify seems problematic for now
|
|
|
|
|
-- queryParticipant = $(sqlMIXproj DAILY_TABLE_JOIN 3)
|
|
|
|
|
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)
|
|
|
|
|
@ -286,7 +286,8 @@ colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorial
|
|
|
|
|
-- )
|
|
|
|
|
|
|
|
|
|
colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
|
|
|
|
|
colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id
|
|
|
|
|
colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ -- (cellAttrs <>~ [("style","width:60%")]) <$>
|
|
|
|
|
formCell id
|
|
|
|
|
(views (resultParticipant . _entityKey) return)
|
|
|
|
|
(\row mkUnique ->
|
|
|
|
|
let note = row ^. resultParticipant . _entityVal . _tutorialParticipantNote
|
|
|
|
|
@ -348,7 +349,7 @@ suggsParticipantNote sid cid tid = do
|
|
|
|
|
-- $logInfoS "NOTE-SUGGS *** B: " $ tshow ol
|
|
|
|
|
pure $ mkOptionListFromCacheable ol
|
|
|
|
|
|
|
|
|
|
suggsAttendanceNote :: SchoolId -> CourseId -> TutorialId -> Handler (OptionList Textarea)
|
|
|
|
|
suggsAttendanceNote :: SchoolId -> CourseId -> TutorialId -> Handler (OptionList Text)
|
|
|
|
|
suggsAttendanceNote sid cid tid = do
|
|
|
|
|
ol <- $(memcachedByHere) (Just . Right $ 12 * diffSecond) (sid,cid,tid) $ do -- memcached key good enough?
|
|
|
|
|
suggs <- runDB $ E.select $ do
|
|
|
|
|
@ -362,41 +363,39 @@ suggsAttendanceNote sid cid tid = do
|
|
|
|
|
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 (tut E.^. TutorialLastChanged, tpa E.^. TutorialParticipantDayNote)
|
|
|
|
|
-- E.orderBy [E.desc $ tut E.^. TutorialLastChanged, E.desc $ tpa E.^. TutorialParticipantDayDay, 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 (tut E.^. TutorialLastChanged, tpa E.^. TutorialParticipantDayNote)
|
|
|
|
|
-- E.orderBy [E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
|
|
|
|
|
-- E.limit maxSuggestions
|
|
|
|
|
-- pure (tpa E.^. TutorialParticipantDayNote, E.val 3)
|
|
|
|
|
) `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
|
|
|
|
|
-- $logInfoS "NOTE-SUGGS *** A: " $ tshow suggs
|
|
|
|
|
pure $ mkOptionListCacheable $ fmap Textarea . mkOptionText <$> nubOrd suggs -- TODO: datalist does not work on textarea inputs!
|
|
|
|
|
-- $logInfoS "NOTE-SUGGS *** B: " $ tshow ol
|
|
|
|
|
pure $ mkOptionListCacheable $ mkOptionText <$> nubOrd suggs -- NOTE: datalist does not work on textarea inputs
|
|
|
|
|
pure $ mkOptionListFromCacheable ol
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -416,16 +415,18 @@ colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutor
|
|
|
|
|
sid = row ^. resultCourse . _entityVal . _courseSchool
|
|
|
|
|
cid = row ^. resultCourse . _entityKey
|
|
|
|
|
tid = row ^. resultTutorial . _entityKey
|
|
|
|
|
in over (_1.mapped) ((_dailyFormAttendanceNote .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$>
|
|
|
|
|
mopt (textareaField & addDatalist (suggsAttendanceNote sid cid tid)) -- TODO: 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)
|
|
|
|
|
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 :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
|
|
|
|
|
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)))
|
|
|
|
|
@ -435,18 +436,18 @@ colParkingField = colParkingField' _dailyFormParkingToken
|
|
|
|
|
-- over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
|
|
|
|
|
-- )
|
|
|
|
|
|
|
|
|
|
colParkingField' :: ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
|
|
|
|
colParkingField' l = sortable (Just "parking") (i18nCell MsgTableUserParkingToken) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell
|
|
|
|
|
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 thrid 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 -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Widget)
|
|
|
|
|
mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Maybe Widget)
|
|
|
|
|
mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
tutLessons
|
|
|
|
|
| Map.null tutLessons -> return (FormMissing, [whamlet|No tutorials on this day|])
|
|
|
|
|
| Map.null tutLessons -> return (FormMissing, Nothing)
|
|
|
|
|
| otherwise -> do
|
|
|
|
|
dday <- formatTime SelFormatDate nd
|
|
|
|
|
let
|
|
|
|
|
@ -473,7 +474,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
dbtProj = dbtProjId
|
|
|
|
|
dbtColonnade = formColonnade $ mconcat
|
|
|
|
|
[ -- dbSelect (applying _2) id (return . view (resultTutorial . _entityKey))
|
|
|
|
|
sortable (Just "course") (i18nCell MsgFilterCourse) $ \(view $ resultCourse . _entityVal -> c) -> courseCell c
|
|
|
|
|
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
|
|
|
|
|
@ -486,8 +487,8 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
-- , 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-company") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid
|
|
|
|
|
, sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \row ->
|
|
|
|
|
-- , 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
|
|
|
|
|
@ -500,7 +501,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
(Just IconCompanyWarning) True)
|
|
|
|
|
| otherwise = bookLink
|
|
|
|
|
in result
|
|
|
|
|
-- , sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \row ->
|
|
|
|
|
-- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row ->
|
|
|
|
|
-- let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany
|
|
|
|
|
-- primComp = row ^? resultCompanyId
|
|
|
|
|
-- bookLink = cellMaybe companyIdCell bookComp
|
|
|
|
|
@ -510,7 +511,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
-- , Just (unCompanyKey -> csh) <- primComp
|
|
|
|
|
-- = bookLink
|
|
|
|
|
-- <> spacerCell
|
|
|
|
|
-- <> cell (modal (warnIcon csh) (Right -- TODO: use iconCompanyWarning instead!
|
|
|
|
|
-- <> cell (modal (warnIcon csh) (Right -- maybe just use iconCompanyWarning instead of modal?
|
|
|
|
|
-- [whamlet|
|
|
|
|
|
-- <h2>
|
|
|
|
|
-- ^{userWidget row}
|
|
|
|
|
@ -528,8 +529,8 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
, colParticipantNoteField
|
|
|
|
|
, colAttendanceField dday
|
|
|
|
|
, colAttendanceNoteField dday
|
|
|
|
|
, colParkingField
|
|
|
|
|
-- FOR DEBUGGING ONLY
|
|
|
|
|
, 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
|
|
|
|
|
@ -543,7 +544,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
, ("course" , SortColumn $ queryCourse >>> (E.^. CourseName))
|
|
|
|
|
, ("tutorial" , SortColumn $ queryTutorial >>> (E.^. TutorialName))
|
|
|
|
|
, ("user-company" , SortColumn $ queryUser >>> selectCompanyUserPrime)
|
|
|
|
|
, ("booking-company", SortColumn $ queryParticipant >>> (E.^. TutorialParticipantCompany))
|
|
|
|
|
, ("booking-firm" , SortColumn $ queryParticipant >>> (E.^. TutorialParticipantCompany))
|
|
|
|
|
, ("card-no" , SortColumn $ queryUserAvs >>> (E.?. UserAvsLastCardNo))
|
|
|
|
|
, ("permit" , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantDrivingPermit))
|
|
|
|
|
, ("eye-exam" , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantEyeExam))
|
|
|
|
|
@ -557,12 +558,14 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
, fltrUserMatriclenr queryUser
|
|
|
|
|
, ("course" , FilterColumn . E.mkContainsFilter $ queryCourse >>> (E.^. CourseName))
|
|
|
|
|
, ("tutorial" , FilterColumn . E.mkContainsFilter $ queryTutorial >>> (E.^. TutorialName))
|
|
|
|
|
, ("user-company" , FilterColumn . E.mkContainsFilter $ queryUser >>> selectCompanyUserPrime)
|
|
|
|
|
, ("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 "user-company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTablePrimeCompany)
|
|
|
|
|
, 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
|
|
|
|
|
]
|
|
|
|
|
@ -605,7 +608,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
|
|
|
|
|
-- return (act, jobSet)
|
|
|
|
|
psValidator = def & defaultSorting [SortAscBy "user-name", SortAscBy "course", SortAscBy "tutorial"]
|
|
|
|
|
-- over _1 postprocess <$> dbTable psValidator DBTable{..}
|
|
|
|
|
dbTable psValidator DBTable{..}
|
|
|
|
|
(over _2 Just) <$> dbTable psValidator DBTable{..}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
getSchoolDayR, postSchoolDayR :: SchoolId -> Day -> Handler Html
|
|
|
|
|
@ -622,12 +625,12 @@ postSchoolDayR ssh nd = do
|
|
|
|
|
, dailyFormAttendanceNote = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just
|
|
|
|
|
, dailyFormParkingToken = row ^? resultUserDay . _userDayParkingToken & fromMaybe False
|
|
|
|
|
}
|
|
|
|
|
(fmap unFormResult -> tableRes,tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd
|
|
|
|
|
$logInfoS "****DailyTable****" $ tshow tableRes
|
|
|
|
|
(fmap unFormResult -> tableRes, tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd
|
|
|
|
|
-- logInfoS "****DailyTable****" $ tshow tableRes
|
|
|
|
|
formResult tableRes $ \resMap -> do
|
|
|
|
|
runDB $ do
|
|
|
|
|
forM_ (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do
|
|
|
|
|
-- $logDebugS "TableForm" (tshow dfd)
|
|
|
|
|
-- logDebugS "TableForm" (tshow dfd)
|
|
|
|
|
TutorialParticipant{..} <- get404 tpid -- needed anyway to find the ParticipantDay/UserDay updated
|
|
|
|
|
when ( tutorialParticipantDrivingPermit /= dailyFormDrivingPermit
|
|
|
|
|
|| tutorialParticipantEyeExam /= dailyFormEyeExam
|
|
|
|
|
@ -654,6 +657,5 @@ postSchoolDayR ssh nd = do
|
|
|
|
|
|
|
|
|
|
siteLayoutMsg (MsgMenuSchoolDay ssh dday) $ do
|
|
|
|
|
setTitleI (MsgMenuSchoolDay ssh dday)
|
|
|
|
|
[whamlet|TODO Overview School #{ciOriginal (unSchoolKey ssh)}
|
|
|
|
|
^{tableDaily}
|
|
|
|
|
|]
|
|
|
|
|
$(i18nWidgetFile "day-view")
|
|
|
|
|
|
|
|
|
|
|
