From 101822fd21802e09cd1987d3d923ac6d0b6fe9eb Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 10 Mar 2019 15:47:33 +0100 Subject: [PATCH] =?UTF-8?q?`MessageClass`=20=E2=86=92=20`MessageStatus`?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- models/system-messages | 2 +- src/Foundation.hs | 2 +- src/Handler/Utils/Form.hs | 2 +- src/Model.hs | 2 +- src/Settings.hs | 2 +- src/Utils/Message.hs | 50 +++++++++++++++++++-------------------- 6 files changed, 30 insertions(+), 30 deletions(-) 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/Utils/Form.hs b/src/Handler/Utils/Form.hs index af7379f8c..7bf0de1d1 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -654,5 +654,5 @@ formResultModal res finalDest handler = maybeT_ $ do if | isModal -> sendResponse $ toJSON messages | otherwise -> do - forM_ messages $ \Message{..} -> addMessage messageClass messageContent + forM_ messages $ \Message{..} -> addMessage messageStatus messageContent redirect finalDest diff --git a/src/Model.hs b/src/Model.hs index 54acc1b28..4a0e3f1c9 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -19,7 +19,7 @@ import Data.Aeson (Value) import Data.CaseInsensitive (CI) import Data.CaseInsensitive.Instances () -import Utils.Message (MessageClass) +import Utils.Message (MessageStatus) import Settings.Cluster (ClusterSettingsKey) import Data.Binary (Binary) diff --git a/src/Settings.hs b/src/Settings.hs index 81f98eb45..f717ee378 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -39,7 +39,7 @@ import qualified Data.Text.Encoding as Text import qualified Ldap.Client as Ldap -import Utils hiding (MessageClass(..)) +import Utils hiding (MessageStatus(..)) import Control.Lens import Data.Maybe (fromJust) diff --git a/src/Utils/Message.hs b/src/Utils/Message.hs index 7cf7f653f..69ce9e45e 100644 --- a/src/Utils/Message.hs +++ b/src/Utils/Message.hs @@ -1,6 +1,6 @@ module Utils.Message - ( MessageClass(..) - , UnknownMessageClass(..) + ( MessageStatus(..) + , UnknownMessageStatus(..) , addMessage, addMessageI, addMessageIHamlet, addMessageFile, addMessageWidget , Message(..) , messageI, messageIHamlet, messageFile, messageWidget @@ -25,64 +25,64 @@ import Text.Blaze.Html.Renderer.Text (renderHtml) import Text.HTML.SanitizeXSS (sanitizeBalance) -data MessageClass = Error | Warning | Info | Success +data MessageStatus = Error | Warning | Info | Success deriving (Eq, Ord, Enum, Bounded, Show, Read, Lift) -instance Universe MessageClass -instance Finite MessageClass +instance Universe MessageStatus +instance Finite MessageStatus deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece - } ''MessageClass + } ''MessageStatus -nullaryPathPiece ''MessageClass camelToPathPiece -derivePersistField "MessageClass" +nullaryPathPiece ''MessageStatus camelToPathPiece +derivePersistField "MessageStatus" -newtype UnknownMessageClass = UnknownMessageClass Text +newtype UnknownMessageStatus = UnknownMessageStatus Text deriving (Eq, Ord, Read, Show, Generic, Typeable) -instance Exception UnknownMessageClass +instance Exception UnknownMessageStatus data Message = Message - { messageClass :: MessageClass + { messageStatus :: MessageStatus , messageContent :: Html } instance Eq Message where - a == b = ((==) `on` messageClass) a b && ((==) `on` renderHtml . messageContent) a b + a == b = ((==) `on` messageStatus) a b && ((==) `on` renderHtml . messageContent) a b instance Ord Message where - a `compare` b = (compare `on` messageClass) a b `mappend` (compare `on` renderHtml . messageContent) a b + a `compare` b = (compare `on` messageStatus) a b `mappend` (compare `on` renderHtml . messageContent) a b instance ToJSON Message where toJSON Message{..} = object - [ "class" .= messageClass + [ "status" .= messageStatus , "content" .= renderHtml messageContent ] instance FromJSON Message where parseJSON = withObject "Message" $ \o -> do - messageClass <- o .: "class" + messageStatus <- o .: "status" messageContent <- preEscapedText . sanitizeBalance <$> o .: "content" return Message{..} -addMessage :: MonadHandler m => MessageClass -> Html -> m () +addMessage :: MonadHandler m => MessageStatus -> Html -> m () addMessage mc = ClassyPrelude.Yesod.addMessage (toPathPiece mc) -addMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageClass -> msg -> m () +addMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageStatus -> msg -> m () addMessageI mc = ClassyPrelude.Yesod.addMessageI (toPathPiece mc) -messageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageClass -> msg -> m Message -messageI messageClass msg = do +messageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageStatus -> msg -> m Message +messageI messageStatus msg = do messageContent <- toHtml . ($ msg) <$> getMessageRender return Message{..} addMessageIHamlet :: ( MonadHandler m , RenderMessage (HandlerSite m) msg , HandlerSite m ~ site - ) => MessageClass -> HtmlUrlI18n msg (Route site) -> m () + ) => MessageStatus -> HtmlUrlI18n msg (Route site) -> m () addMessageIHamlet mc iHamlet = do mr <- getMessageRender ClassyPrelude.Yesod.addMessage (toPathPiece mc) =<< withUrlRenderer (iHamlet $ toHtml . mr) @@ -90,22 +90,22 @@ addMessageIHamlet mc iHamlet = do messageIHamlet :: ( MonadHandler m , RenderMessage (HandlerSite m) msg , HandlerSite m ~ site - ) => MessageClass -> HtmlUrlI18n msg (Route site) -> m Message + ) => MessageStatus -> HtmlUrlI18n msg (Route site) -> m Message messageIHamlet mc iHamlet = do mr <- getMessageRender Message mc <$> withUrlRenderer (iHamlet $ toHtml . mr) -addMessageFile :: MessageClass -> FilePath -> ExpQ +addMessageFile :: MessageStatus -> FilePath -> ExpQ addMessageFile mc tPath = [e|addMessageIHamlet mc $(ihamletFile tPath)|] -messageFile :: MessageClass -> FilePath -> ExpQ +messageFile :: MessageStatus -> FilePath -> ExpQ messageFile mc tPath = [e|messageIHamlet mc $(ihamletFile tPath)|] addMessageWidget :: forall m site. ( MonadHandler m , HandlerSite m ~ site , Yesod site - ) => MessageClass -> WidgetT site IO () -> m () + ) => MessageStatus -> WidgetT site IO () -> m () -- ^ _Note_: `addMessageWidget` ignores `pageTitle` and `pageHead` addMessageWidget mc wgt = do PageContent{pageBody} <- liftHandlerT $ widgetToPageContent wgt @@ -115,7 +115,7 @@ messageWidget :: forall m site. ( MonadHandler m , HandlerSite m ~ site , Yesod site - ) => MessageClass -> WidgetT site IO () -> m Message + ) => MessageStatus -> WidgetT site IO () -> m Message messageWidget mc wgt = do PageContent{pageBody} <- liftHandlerT $ widgetToPageContent wgt messageIHamlet mc (const pageBody :: HtmlUrlI18n (SomeMessage site) (Route site))