feat(system-messages): manual priority

messages/uniworx/de-de-formal.msg

@@ -1147,6 +1147,8 @@ SystemMessageFrom: Sichtbar ab
 SystemMessageTo: Sichtbar bis
 SystemMessageAuthenticatedOnly: Nur angemeldet
 SystemMessageSeverity: Schwere
+SystemMessagePriority: Priorität
+SystemMessagePriorityNegative: Priorität darf nicht negativ sein
 SystemMessageId: Id
 SystemMessageSummaryContent: Zusammenfassung / Inhalt
 SystemMessageSummary: Zusammenfassung

models/system-messages.model

@@ -6,12 +6,14 @@ SystemMessage
     newsOnly            Bool default=false
     authenticatedOnly   Bool -- Show message to all users upon visiting the site or only upon login?
     severity            MessageStatus -- Success, Warning, Error, Info, ...
+    manualPriority      Natural Maybe
     created             UTCTime default=now()
     lastChanged         UTCTime default=now()
     lastUnhide          UTCTime default=now()
     defaultLanguage     Lang -- Language of @content@ and @summary@
     content             Html -- Detailed message shown when clicking on the @summary@-popup or when no @summary@ is specified
     summary             Html Maybe
+
 SystemMessageTranslation -- Translation of a @SystemMessage@ into another language; which language to choose is determined by user-sent HTTP-headers
     message             SystemMessageId
     language            Lang

src/Foundation.hs

@@ -2238,7 +2238,7 @@ applySystemMessages = liftHandler . maybeT_ . catchMPlus (Proxy @CryptoIDError)
   cRoute <- lift getCurrentRoute
   guard $ cRoute /= Just NewsR
 
-  lift . runDB . runConduit $ selectSource [] [] .| C.mapM_ applyMessage
+  lift . runDB . runConduit $ selectSource [] [Asc SystemMessageManualPriority] .| C.mapM_ applyMessage
   where
     syncSystemMessageHidden uid = runDB $ do
       smSt <- lookupRegisteredCookiesJson id CookieSystemMessageState :: DB (MergeHashMap CryptoUUIDSystemMessage UserSystemMessageState)

src/Handler/News.hs

@@ -75,7 +75,7 @@ newsSystemMessages = do
     .| C.iterM (\(smId, _, _, _) -> tellShown smId)
     .| C.mapM (\(smId, sm@SystemMessage{..}, trans, hidden) -> (sm, trans, hidden,,) <$> formatTime SelFormatDateTime (maybe id max systemMessageFrom systemMessageLastChanged) <*> mkHideForm smId sm)
     .| C.consume
-  let messages = sortOn (\(SystemMessage{..}, _, _, _, _) -> (Down $ maybe id max systemMessageFrom systemMessageLastChanged, systemMessageSeverity)) messages'
+  let messages = sortOn (\(SystemMessage{..}, _, _, _, _) -> (Down systemMessageManualPriority, Down $ maybe id max systemMessageFrom systemMessageLastChanged, systemMessageSeverity)) messages'
 
   hiddenUrl <- toTextUrl (NewsR, [(toPathPiece GetHidden, "")])
 

src/Handler/SystemMessage.hs

@@ -41,6 +41,7 @@ postMessageR cID = do
           <*> apopt checkBoxField (fslI MsgSystemMessageNewsOnly) (Just systemMessageNewsOnly)
           <*> apopt checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just systemMessageAuthenticatedOnly)
           <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just systemMessageSeverity)
+          <*> aopt (natFieldI MsgSystemMessagePriorityNegative) (fslI MsgSystemMessagePriority) (Just systemMessageManualPriority)
           <*> pure systemMessageCreated
           <*> (bool systemMessageLastChanged now <$> apopt checkBoxField (fslI MsgSystemMessageRecordChanged & setTooltip MsgSystemMessageRecordChangedTip) (Just True))
           <*> (bool systemMessageLastUnhide now <$> apopt checkBoxField (fslI MsgSystemMessageUnhide & setTooltip MsgSystemMessageUnhideTip) (Just False))
@@ -175,6 +176,7 @@ postMessageListR = do
       , sortable (Just "news-only") (i18nCell MsgSystemMessageNewsOnly) $ \DBRow { dbrOutput = (Entity _ SystemMessage{..}, _) } -> tickmarkCell systemMessageNewsOnly
       , sortable (Just "authenticated") (i18nCell MsgSystemMessageAuthenticatedOnly) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> tickmarkCell systemMessageAuthenticatedOnly
       , sortable (Just "severity") (i18nCell MsgSystemMessageSeverity) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> i18nCell systemMessageSeverity
+      , sortable (Just "priority") (i18nCell MsgSystemMessagePriority) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> maybe mempty numCell systemMessageManualPriority
       , sortable (Just "created") (i18nCell MsgSystemMessageCreated) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ formatTimeW SelFormatDateTime systemMessageCreated
       , sortable (Just "last-changed") (i18nCell MsgSystemMessageLastChanged) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ formatTimeW SelFormatDateTime systemMessageLastChanged
       , sortable (Just "last-unhide") (i18nCell MsgSystemMessageLastUnhide) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ formatTimeW SelFormatDateTime systemMessageLastUnhide
@@ -212,6 +214,9 @@ postMessageListR = do
       , ( "severity"
         , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageSeverity
         )
+      , ( "priority"
+        , SortColumn (E.^. SystemMessageManualPriority)
+        )
       , ( "created"
         , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageCreated
         )
@@ -283,6 +288,7 @@ postMessageListR = do
     <*> apopt checkBoxField (fslI MsgSystemMessageNewsOnly) (Just False)
     <*> apopt checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just False)
     <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just Info)
+    <*> aopt (natFieldI MsgSystemMessagePriorityNegative) (fslI MsgSystemMessagePriority) (Just Nothing)
     <*> pure now <*> pure now <*> pure now
     <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just $ NonEmpty.head appLanguages)
     <*> areq htmlField (fslI MsgSystemMessageContent) Nothing

test/Database/Fill.hs

@@ -922,6 +922,7 @@ fillDb = do
     , systemMessageTo = Nothing
     , systemMessageAuthenticatedOnly = False
     , systemMessageSeverity = Success
+    , systemMessageManualPriority = Nothing
     , systemMessageDefaultLanguage = "de"
     , systemMessageContent = "System-Nachrichten werden angezeigt"
     , systemMessageSummary = Nothing
@@ -936,6 +937,7 @@ fillDb = do
     , systemMessageTo = Nothing
     , systemMessageAuthenticatedOnly = False
     , systemMessageSeverity = Info
+    , systemMessageManualPriority = Nothing
     , systemMessageDefaultLanguage = "de"
     , systemMessageContent = "System-Nachrichten können längeren Inhalt enthalten"
     , systemMessageSummary = Just "System-Nachricht Zusammenfassung"
@@ -949,6 +951,7 @@ fillDb = do
     , systemMessageTo = Just now
     , systemMessageAuthenticatedOnly = False
     , systemMessageSeverity = Info
+    , systemMessageManualPriority = Nothing
     , systemMessageDefaultLanguage = "de"
     , systemMessageContent = "System-Nachrichten haben Ablaufdaten"
     , systemMessageSummary = Nothing
@@ -962,6 +965,7 @@ fillDb = do
     , systemMessageTo = Nothing
     , systemMessageAuthenticatedOnly = False
     , systemMessageSeverity = Error
+    , systemMessageManualPriority = Nothing
     , systemMessageDefaultLanguage = "de"
     , systemMessageContent = "System-Nachrichten können Inaktiv sein"
     , systemMessageSummary = Nothing
@@ -975,6 +979,7 @@ fillDb = do
     , systemMessageTo = Nothing
     , systemMessageAuthenticatedOnly = False
     , systemMessageSeverity = Error
+    , systemMessageManualPriority = Nothing
     , systemMessageDefaultLanguage = "de"
     , systemMessageContent = "System-Nachrichten können nur auf \"Aktuelles\" angezeigt werden"
     , systemMessageSummary = Nothing