Don't display empty multiAction-Widgets
This commit is contained in:
parent
850164d2b4
commit
9e1111f654
@ -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
|
||||
|
||||
@ -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"))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user