diff --git a/models/system-messages b/models/system-messages index 0547718ae..0ceec9223 100644 --- a/models/system-messages +++ b/models/system-messages @@ -2,7 +2,7 @@ SystemMessage from UTCTime Maybe to UTCTime Maybe authenticatedOnly Bool - severity MessageClass + severity MessageStatus defaultLanguage Lang content Html summary Html Maybe diff --git a/src/Foundation.hs b/src/Foundation.hs index 047e3f670..70ad9da14 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -220,7 +220,7 @@ instance RenderMessage UniWorX MsgLanguage where instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route) -embedRenderMessage ''UniWorX ''MessageClass ("Message" <>) +embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>) embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel embedRenderMessage ''UniWorX ''StudyFieldType id embedRenderMessage ''UniWorX ''SheetFileType id diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 501cc97b9..6edcbf05f 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -20,6 +20,8 @@ import Database.Persist.Sql (fromSqlKey) -- import qualified Data.UUID.Cryptographic as UUID +import Control.Monad.Trans.Writer (mapWriterT) + -- BEGIN - Buttons needed only here data ButtonCreate = CreateMath | CreateInf -- Dummy for Example deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) @@ -55,7 +57,7 @@ emailTestForm = (,) SelFormatTime -> t makeDemoForm :: Int -> Form (Int,Bool,Double) -makeDemoForm n = identifyForm "adminTestForm" $ \html -> do -- Important: used identForm instead! +makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do (result, widget) <- flip (renderAForm FormStandard) html $ (,,) <$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing <* aformSection MsgFormBehaviour @@ -76,23 +78,20 @@ makeDemoForm n = identifyForm "adminTestForm" $ \html -> do -- Important: used i getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden! getAdminTestR = postAdminTestR postAdminTestR = do - ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm "buttons" (buttonForm :: Form ButtonCreate) + ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonCreate) case btnResult of (FormSuccess CreateInf) -> addMessage Info "Informatik-Knopf gedrückt" (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt" FormMissing -> return () _other -> addMessage Warning "KEIN Knopf erkannt" - ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm "email" $ renderAForm FormStandard emailTestForm - case emailResult of - (FormSuccess (email, ls)) -> do - jId <- runDB $ do - jId <- queueJob $ JobSendTestEmail email ls - addMessage Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] - return jId - writeJobCtl $ JobCtlPerform jId - FormMissing -> return () - (FormFailure errs) -> forM_ errs $ addMessage Error . toHtml + ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm ("email" :: Text) $ renderAForm FormStandard emailTestForm + formResultModal emailResult AdminTestR $ \(email, ls) -> do + jId <- mapWriterT runDB $ do + jId <- queueJob $ JobSendTestEmail email ls + tell . pure $ Message Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] + return jId + writeJobCtl $ JobCtlPerform jId let emailWidget' = [whamlet|