Don't display empty multiAction-Widgets

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

View File

@ -189,7 +189,7 @@ data ActionCorrectionsData = CorrDownloadData
| CorrSetCorrectorData (Maybe UserId)
| 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
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator
((actionRes, table), tableEncoding) <- runFormPost . identForm FIDcorrectorTable $ \csrf -> do
@ -252,16 +252,16 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
$(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 = ( CorrDownload
, return (pure CorrDownloadData, mempty)
, return (pure CorrDownloadData, Nothing)
)
assignAction :: Either CourseId SheetId -> ActionCorrections'
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
E.on $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser
E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
@ -282,7 +282,7 @@ assignAction selId = ( CorrSetCorrector
autoAssignAction :: SheetId -> ActionCorrections'
autoAssignAction shid = ( CorrAutoSetCorrector
, return (pure $ CorrAutoSetCorrectorData shid, mempty)
, return (pure $ CorrAutoSetCorrectorData shid, Nothing)
)
getCorrectionsR, postCorrectionsR :: Handler TypedContent

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
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)
multiAction acts = do
mr <- getMessageRender
let
options = OptionList [ Option (mr a) a (toPathPiece a) | a <- Map.keys acts ] fromPathPiece
(actionRes, actionView) <- mreq (selectField $ return options) "" Nothing
results <- mapM id acts
let actionWidgets = Map.foldrWithKey (\act (_, w) -> ($(widgetFile "widgets/multiAction") :)) [] results
results <- sequence acts
let actionWidgets = Map.foldrWithKey (\act -> \case (_, Just w) -> ($(widgetFile "widgets/multiAction") :); (_, Nothing) -> id) [] results
actionResults = Map.map fst results
return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multiActionCollect"))