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

Send Alerts-Header when using async-massinput

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-09 21:17:26 +02:00
parent 6a68e1de79
commit ebbef3911e
2 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Foundation.hs
View File

@ -1103,8 +1103,13 @@ instance Yesod UniWorX where
headerMessagesMiddleware handler = (handler `finally`) . runMaybeT $ do headerMessagesMiddleware handler = (handler `finally`) . runMaybeT $ do
isModal <- hasCustomHeader HeaderIsModal isModal <- hasCustomHeader HeaderIsModal
dbTableShortcircuit <- hasCustomHeader HeaderDBTableShortcircuit dbTableShortcircuit <- hasCustomHeader HeaderDBTableShortcircuit
$logDebugS "headerMessagesMiddleware" $ tshow (isModal, dbTableShortcircuit) massInputShortcircuit <- hasCustomHeader HeaderMassInputShortcircuit
guard $ isModal || dbTableShortcircuit $logDebugS "headerMessagesMiddleware" $ tshow (isModal, dbTableShortcircuit, massInputShortcircuit)
guard $ or
[ isModal
, dbTableShortcircuit
, massInputShortcircuit
]
lift . bracketOnError getMessages (mapM_ $ uncurry Yesod.addMessage) $ \msgs -> do lift . bracketOnError getMessages (mapM_ $ uncurry Yesod.addMessage) $ \msgs -> do
Just msgs' <- return . forM msgs $ \(msgState, content) -> Message <$> fromPathPiece msgState <*> return content Just msgs' <- return . forM msgs $ \(msgState, content) -> Message <$> fromPathPiece msgState <*> return content

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

@ -21,7 +21,7 @@ import Handler.Utils.Form (secretJsonField)
import Handler.Utils.Form.MassInput.Liveliness import Handler.Utils.Form.MassInput.Liveliness
import Handler.Utils.Form.MassInput.TH import Handler.Utils.Form.MassInput.TH
import Data.Aeson import Data.Aeson hiding (Result(..))
import Algebra.Lattice hiding (join) import Algebra.Lattice hiding (join)
@ -423,6 +423,10 @@ massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvR
PageContent{..} <- widgetToPageContent $(widgetFile "widgets/massinput/massinput-standalone") PageContent{..} <- widgetToPageContent $(widgetFile "widgets/massinput/massinput-standalone")
ur <- getUrlRenderParams ur <- getUrlRenderParams
case result of
FormFailure errs -> forM_ errs $ addMessage Error . toHtml -- Error messages get collected by middleware and added as header to response
_other -> return () -- Completely ignore non-error results; we'll short circuit below
sendResponse $ $(hamletFile "templates/widgets/massinput/massinput-standalone-wrapper.hamlet") ur sendResponse $ $(hamletFile "templates/widgets/massinput/massinput-standalone-wrapper.hamlet") ur
let let