From 9e1111f654423496bafcfebbd240d2b563dce5f8 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 30 Jun 2018 21:24:13 +0200 Subject: [PATCH] Don't display empty multiAction-Widgets --- src/Handler/Corrections.hs | 10 +++++----- src/Handler/Utils/Form.hs | 6 +++--- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index c1d50ac06..431d35fbb 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index c8d4bf3c0..770129424 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -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"))