chore(tutorial): (WIP) towards #90 write form columns
This commit is contained in:
parent
85511091cc
commit
8317f682d8
@ -20,7 +20,7 @@ import Handler.Utils.Occurrences
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Aeson as Aeson
|
||||
-- import qualified Data.Text as Text
|
||||
import qualified Data.Text as Text
|
||||
|
||||
-- import Database.Persist.Sql (updateWhereCount)
|
||||
import Database.Esqueleto.Experimental ((:&)(..))
|
||||
@ -227,6 +227,51 @@ instance HasUser DailyTableData where
|
||||
|
||||
-- see colRatedField' for an example of formCell usage
|
||||
|
||||
drivingPermitField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserDrivingPermit
|
||||
drivingPermitField = selectField' Nothing optionsFinite
|
||||
|
||||
-- eyeExamField :: Field (HandlerFor UniWorX) UserEyeExam
|
||||
-- eyeExamField = selectField optionsFinite
|
||||
|
||||
-- This does not type:
|
||||
-- colParticipantPermitField :: ASetter' a (Maybe UserDrivingPermit) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
-- colParticipantPermitField l = sortable (Just "permit") (i18nCell MsgTutorialNote) $ 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") $ Just x
|
||||
-- ) -- Given the row data and a callback to make an input name suitably unique generate the MForm
|
||||
|
||||
-- colEyeExamField :: TODO
|
||||
|
||||
colParticipantNoteField :: ASetter' a (Maybe Text) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
colParticipantNoteField l = sortable (Just "note-participant") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> 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 . _tutorialParticipantNote) -> note) mkUnique ->
|
||||
over (_1.mapped) ((l .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$>
|
||||
mopt textareaField (fsUniq mkUnique "note-participant") (Just $ Textarea <$> note)
|
||||
) -- Given the row data and a callback to make an input name suitably unique generate the MForm
|
||||
|
||||
colAttendanceField :: Text -> ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
colAttendanceField dday l = sortable (Just "attendance") (i18nCell $ MsgTutorialDayAttendance dday) $ 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
|
||||
(\(preview (resultParticipantDay . _tutorialParticipantDayAttendance) -> attendance) mkUnique ->
|
||||
over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "attendance") attendance
|
||||
) -- Given the row data and a callback to make an input name suitably unique generate the MForm
|
||||
|
||||
colAttendnaceNoteField :: Text -> ASetter' a (Maybe Text) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
colAttendnaceNoteField dday l = sortable (Just "note-attendance") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","width:60%")]) <$> 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
|
||||
(\(preview (resultParticipantDay . _tutorialParticipantDayNote) -> note) mkUnique ->
|
||||
over (_1.mapped) ((l .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$>
|
||||
mopt textareaField (fsUniq mkUnique "note-attendance") (Textarea <<$>> note)
|
||||
) -- Given the row data and a callback to make an input name suitably unique generate the MForm
|
||||
|
||||
colParkingField :: ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
colParkingField l = sortable (Just "parking") (i18nCell MsgTableUserParkingToken) $ 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
|
||||
(\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique ->
|
||||
over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
|
||||
) -- Given the row data and a callback to make an input name suitably unique generate the MForm
|
||||
|
||||
mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DailyTableActionData, Set TutorialId), Widget)
|
||||
mkDailyTable isAdmin ssh nd = do
|
||||
@ -273,12 +318,13 @@ mkDailyTable isAdmin ssh nd = do
|
||||
, colUserNameModalHdr MsgCourseParticipant ForProfileDataR
|
||||
, colUserMatriclenr isAdmin
|
||||
, sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn
|
||||
, sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantDrivingPermit -> x) -> maybeCell x $ textCell . tshow
|
||||
, sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantEyeExam -> x) -> maybeCell x $ textCell . tshow
|
||||
, sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantNote -> x) -> maybeCell x textCell
|
||||
, sortable (Just "attendance") (i18nCell $ MsgTutorialDayAttendance dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayAttendance -> x) -> maybeCell x tickmarkCell
|
||||
, sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayNote . _Just -> x) -> maybeCell x textCell
|
||||
, 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
|
||||
-- , colParkingField id
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ sortUserNameLink queryUser
|
||||
|
||||
@ -45,7 +45,7 @@ deriveJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 3
|
||||
} ''UserDrivingPermit
|
||||
derivePersistFieldJSON ''UserDrivingPermit
|
||||
|
||||
nullaryPathPiece ''UserDrivingPermit $ camelToPathPiece' 3
|
||||
|
||||
data UserEyeExam = UserEyeExamSX
|
||||
| UserEyeExamS01
|
||||
@ -62,3 +62,4 @@ deriveJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 3
|
||||
} ''UserEyeExam
|
||||
derivePersistFieldJSON ''UserEyeExam
|
||||
nullaryPathPiece ''UserEyeExam $ camelToPathPiece' 3
|
||||
|
||||
@ -546,9 +546,9 @@ spec = do
|
||||
lawsCheckHspec (Proxy @LmsDay)
|
||||
[ eqLaws, ordLaws, showLaws, showReadLaws, csvFieldLaws ]
|
||||
lawsCheckHspec (Proxy @UserDrivingPermit)
|
||||
[ eqLaws, ordLaws, showLaws, boundedEnumLaws, finiteLaws, persistFieldLaws ]
|
||||
[ eqLaws, ordLaws, showLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, persistFieldLaws ]
|
||||
lawsCheckHspec (Proxy @UserEyeExam)
|
||||
[ eqLaws, ordLaws, showLaws, boundedEnumLaws, finiteLaws, persistFieldLaws ]
|
||||
[ eqLaws, ordLaws, showLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, persistFieldLaws ]
|
||||
|
||||
describe "TermIdentifier" $ do
|
||||
it "has compatible encoding/decoding to/from Text" . property $
|
||||
|
||||
Loading…
Reference in New Issue
Block a user