fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Don't display empty multiAction-Widgets

Browse Source
This commit is contained in:
Gregor Kleen 2018-06-30 21:24:13 +02:00
parent 850164d2b4
commit 9e1111f654
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Handler/Corrections.hs
View File

@ -189,7 +189,7 @@ data ActionCorrectionsData = CorrDownloadData
| CorrSetCorrectorData (Maybe UserId) | CorrSetCorrectorData (Maybe UserId)
| CorrAutoSetCorrectorData SheetId | CorrAutoSetCorrectorData SheetId
correctionsR :: _ -> _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) -> Handler TypedContent correctionsR :: _ -> _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Maybe Widget)) -> Handler TypedContent
correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator tableForm <- makeCorrectionsTable whereClause displayColumns psValidator
((actionRes, table), tableEncoding) <- runFormPost . identForm FIDcorrectorTable $ \csrf -> do ((actionRes, table), tableEncoding) <- runFormPost . identForm FIDcorrectorTable $ \csrf -> do
@ -252,16 +252,16 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
$(widgetFile "corrections") $(widgetFile "corrections")
type ActionCorrections' = (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) type ActionCorrections' = (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Maybe Widget))
downloadAction :: ActionCorrections' downloadAction :: ActionCorrections'
downloadAction = ( CorrDownload downloadAction = ( CorrDownload
, return (pure CorrDownloadData, mempty) , return (pure CorrDownloadData, Nothing)
) )
assignAction :: Either CourseId SheetId -> ActionCorrections' assignAction :: Either CourseId SheetId -> ActionCorrections'
assignAction selId = ( CorrSetCorrector assignAction selId = ( CorrSetCorrector
, do , over (mapped._2) Just $ do
correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> do correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> do
E.on $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser E.on $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser
E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
@ -282,7 +282,7 @@ assignAction selId = ( CorrSetCorrector
autoAssignAction :: SheetId -> ActionCorrections' autoAssignAction :: SheetId -> ActionCorrections'
autoAssignAction shid = ( CorrAutoSetCorrector autoAssignAction shid = ( CorrAutoSetCorrector
, return (pure $ CorrAutoSetCorrectorData shid, mempty) , return (pure $ CorrAutoSetCorrectorData shid, Nothing)
) )
getCorrectionsR, postCorrectionsR :: Handler TypedContent getCorrectionsR, postCorrectionsR :: Handler TypedContent

6
src/Handler/Utils/Form.hs
View File

@ -536,14 +536,14 @@ aforced :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m
aforced field settings val = formToAForm $ second pure <$> mforced field settings val aforced field settings val = formToAForm $ second pure <$> mforced field settings val
multiAction :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq action) multiAction :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq action)
=> Map action (MForm (HandlerT UniWorX IO) (FormResult a, Widget)) => Map action (MForm (HandlerT UniWorX IO) (FormResult a, Maybe Widget))
-> MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> MForm (HandlerT UniWorX IO) (FormResult a, Widget)
multiAction acts = do multiAction acts = do
mr <- getMessageRender mr <- getMessageRender
let let
options = OptionList [ Option (mr a) a (toPathPiece a) | a <- Map.keys acts ] fromPathPiece options = OptionList [ Option (mr a) a (toPathPiece a) | a <- Map.keys acts ] fromPathPiece
(actionRes, actionView) <- mreq (selectField $ return options) "" Nothing (actionRes, actionView) <- mreq (selectField $ return options) "" Nothing
results <- mapM id acts results <- sequence acts
let actionWidgets = Map.foldrWithKey (\act (_, w) -> ($(widgetFile "widgets/multiAction") :)) [] results let actionWidgets = Map.foldrWithKey (\act -> \case (_, Just w) -> ($(widgetFile "widgets/multiAction") :); (_, Nothing) -> id) [] results
actionResults = Map.map fst results actionResults = Map.map fst results
return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multiActionCollect")) return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multiActionCollect"))