chore(day): make form columns compile eventually
This commit is contained in:
parent
5d46479a33
commit
e1dca7d6b0
@ -105,8 +105,8 @@ instance HasCookieSettings RegisteredCookie UniWorX where
|
||||
instance (MonadHandler m, HandlerSite m ~ UniWorX) => ReadLogSettings m where
|
||||
readLogSettings = liftIO . readTVarIO =<< getsYesod (view _appLogSettings)
|
||||
|
||||
|
||||
type DB = YesodDB UniWorX
|
||||
type DB = YesodDB UniWorX
|
||||
-- ~ ReaderT SqlBackend (HandlerFor UniWorX)
|
||||
type DBRead = ReaderT SqlReadBackend (HandlerFor UniWorX)
|
||||
type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, WidgetFor UniWorX ())
|
||||
type MsgRenderer = MsgRendererS UniWorX -- see Utils
|
||||
|
||||
@ -34,16 +34,16 @@ import Database.Esqueleto.Utils.TH
|
||||
|
||||
|
||||
|
||||
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)
|
||||
-- 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
|
||||
-- instance Universe DailyTableAction
|
||||
-- instance Finite DailyTableAction
|
||||
-- nullaryPathPiece ''DailyTableAction $ camelToPathPiece' 2
|
||||
-- embedRenderMessage ''UniWorX ''DailyTableAction id
|
||||
|
||||
data DailyTableActionData = DailyActDummyData
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
-- data DailyTableActionData = DailyActDummyData
|
||||
-- deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
-- | partial JSON object to be used for filtering with "@>"
|
||||
-- ensure that a GIN index for the jsonb column is created in Model.Migration.Definitions
|
||||
@ -153,6 +153,7 @@ type DailyTableOutput = E.SqlQuery
|
||||
, E.SqlExpr (E.Value (Maybe CompanyId))
|
||||
, E.SqlExpr (E.Value (Maybe [QualificationId]))
|
||||
)
|
||||
|
||||
type DailyTableData = DBRow
|
||||
( Entity Course
|
||||
, Entity Tutorial
|
||||
@ -165,6 +166,17 @@ type DailyTableData = DBRow
|
||||
, 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 [])
|
||||
|
||||
@ -233,51 +245,60 @@ drivingPermitField = selectField' Nothing optionsFinite
|
||||
eyeExamField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserEyeExam
|
||||
eyeExamField = selectField' Nothing optionsFinite
|
||||
|
||||
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
|
||||
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 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
|
||||
|
||||
colParticipantEyeExamField :: ASetter' a (Maybe UserEyeExam) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
colParticipantEyeExamField 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
|
||||
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 "permit") (i18nCell MsgTutorialNote) $ 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") (Just x)
|
||||
) -- Given the row data and a callback to make an input name suitably unique generate the MForm
|
||||
)
|
||||
|
||||
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
|
||||
colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
|
||||
colParticipantNoteField = sortable (Just "note-participant") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id
|
||||
(views (resultParticipant . _entityKey) return)
|
||||
(\(view (resultParticipant . _entityVal . _tutorialParticipantNote) -> note) mkUnique ->
|
||||
over (_1.mapped) ((l .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$>
|
||||
over (_1.mapped) ((_dailyFormParticipantNote .~) . 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
|
||||
colAttendanceField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
|
||||
colAttendanceField dday = sortable (Just "attendance") (i18nCell $ MsgTutorialDayAttendance dday) $ formCell id
|
||||
(views (resultParticipant . _entityKey) return)
|
||||
(\(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
|
||||
over (_1.mapped) (_dailyFormAttendance .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "attendance") attendance
|
||||
)
|
||||
|
||||
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
|
||||
colAttendanceNoteField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
|
||||
colAttendanceNoteField dday = sortable (Just "note-attendance") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id
|
||||
(views (resultParticipant . _entityKey) return)
|
||||
(\(preview (resultParticipantDay . _tutorialParticipantDayNote) -> note) mkUnique ->
|
||||
over (_1.mapped) ((l .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$>
|
||||
over (_1.mapped) ((_dailyFormAttendanceNote .~) . 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
|
||||
colParkingField :: 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
|
||||
) -- 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 :: Bool -> SchoolId -> Day -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Widget)
|
||||
mkDailyTable isAdmin ssh nd = do
|
||||
tutLessons <- getDayTutorials' ssh (nd,nd)
|
||||
dday <- formatTime SelFormatDate nd
|
||||
@ -303,7 +324,7 @@ mkDailyTable isAdmin ssh nd = do
|
||||
return (crs, tut, tpu, usr, avs, udy, tdy, selectCompanyUserPrime usr, associatedQualifications)
|
||||
dbtRowKey = queryParticipant >>> (E.^. TutorialParticipantId)
|
||||
dbtProj = dbtProjId
|
||||
dbtColonnade = mconcat
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ -- dbSelect (applying _2) id (return . view (resultTutorial . _entityKey))
|
||||
sortable (Just "course") (i18nCell MsgFilterCourse) $ \(view $ resultCourse . _entityVal -> c) -> courseCell c
|
||||
, sortable (Just "tutorial") (i18nCell MsgCourseTutorial) $ \row ->
|
||||
@ -328,7 +349,12 @@ mkDailyTable isAdmin ssh nd = do
|
||||
, 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 -- TODO
|
||||
, colParticipantPermitField
|
||||
, colParticipantEyeExamField
|
||||
, colParticipantNoteField
|
||||
, colAttendanceField dday
|
||||
, colAttendanceNoteField dday
|
||||
, colParkingField
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ sortUserNameLink queryUser
|
||||
@ -365,33 +391,40 @@ mkDailyTable isAdmin ssh nd = do
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormNoSubmit
|
||||
, dbParamsFormAdditional = \_csrf -> return (FormMissing, mempty)
|
||||
-- , dbParamsFormSubmit = FormSubmit
|
||||
-- , dbParamsFormAdditional
|
||||
-- = let acts :: Map MCTableAction (AForm Handler MCTableActionData)
|
||||
-- acts = mconcat
|
||||
-- [ singletonMap MCActDummy $ pure MCActDummyData
|
||||
-- ]
|
||||
-- in renderAForm FormStandard
|
||||
-- $ (, mempty) . First . Just
|
||||
-- <$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
postprocess :: FormResult (First DailyTableActionData, DBFormResult TutorialId 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)
|
||||
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 _1 postprocess <$> dbTable psValidator DBTable{..}
|
||||
dbTable psValidator DBTable{..}
|
||||
|
||||
|
||||
getSchoolDayR, postSchoolDayR :: SchoolId -> Day -> Handler Html
|
||||
|
||||
Loading…
Reference in New Issue
Block a user