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

chore(alert messages): minor code cleaning

Browse Source
This commit is contained in:
Steffen Jost 2019-07-25 07:39:18 +02:00
parent d70a9585f0
commit d838d36239
1 changed files with 14 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/Utils/Message.hs
View File

@ -1,13 +1,12 @@
module Utils.Message module Utils.Message
( MessageStatus(..), MessageIconStatus(..) ( MessageStatus(..)
, UnknownMessageStatus(..) -- , UnknownMessageStatus(..)
, getMessages , getMessages
, addMessage',addMessageIcon, addMessageIconI -- messages with special icons (needs registering in alert-icons.js) , addMessage',addMessageIcon, addMessageIconI -- messages with special icons (needs registering in alert-icons.js)
, addMessage, addMessageI, addMessageIHamlet, addMessageFile, addMessageWidget , addMessage, addMessageI, addMessageIHamlet, addMessageFile, addMessageWidget
, statusToUrgencyClass , statusToUrgencyClass
, Message(..) , Message(..)
, messageI, messageIHamlet, messageFile, messageWidget , messageI, messageIHamlet, messageFile, messageWidget
, encodeMessageIconStatus, decodeMessageIconStatus, decodeMessageIconStatus'
) where ) where
import Data.Universe import Data.Universe
@ -45,13 +44,11 @@ deriveJSON defaultOptions
nullaryPathPiece ''MessageStatus camelToPathPiece nullaryPathPiece ''MessageStatus camelToPathPiece
derivePersistField "MessageStatus" derivePersistField "MessageStatus"
newtype UnknownMessageStatus = UnknownMessageStatus Text newtype UnknownMessageStatus = UnknownMessageStatus Text -- kann das weg?
deriving (Eq, Ord, Read, Show, Generic, Typeable) deriving (Eq, Ord, Read, Show, Generic, Typeable)
instance Exception UnknownMessageStatus instance Exception UnknownMessageStatus
-- ms2mis :: MessageStatus -> MessageIconStatus
-- ms2mis s = def { misStatus= s}
data MessageIconStatus = MIS { misStatus :: MessageStatus, misIcon :: Maybe Icon } data MessageIconStatus = MIS { misStatus :: MessageStatus, misIcon :: Maybe Icon }
deriving (Eq, Ord, Show, Read, Lift) deriving (Eq, Ord, Show, Read, Lift)
@ -72,23 +69,23 @@ encodeMessageIconStatus = decodeUtf8 . toStrict . encode
decodeMessageIconStatus :: Text -> Maybe MessageIconStatus decodeMessageIconStatus :: Text -> Maybe MessageIconStatus
decodeMessageIconStatus = decode' . fromStrict . encodeUtf8 decodeMessageIconStatus = decode' . fromStrict . encodeUtf8
decodeMessageIconStatus' :: Text -> MessageIconStatus -- decodeMessageIconStatus' :: Text -> MessageIconStatus
decodeMessageIconStatus' t -- decodeMessageIconStatus' t
| Just mis <- decodeMessageIconStatus t = mis -- | Just mis <- decodeMessageIconStatus t = mis
| otherwise = def -- | otherwise = def
decodeMessage :: (Text, Html) -> Message decodeMessage :: (Text, Html) -> Message
decodeMessage (mis, msgContent) decodeMessage (mis, msgContent)
| Just MIS{ misStatus=messageStatus, misIcon=messageIcon } <- decodeMessageIconStatus mis | Just MIS{ misStatus=messageStatus, misIcon=messageIcon } <- decodeMessageIconStatus mis
= let messageContent = msgContent in Message{..} = let messageContent = msgContent in Message{..}
| Just messageStatus <- fromPathPiece mis | Just messageStatus <- fromPathPiece mis -- should not happen
= let messageIcon = Nothing -- legacy case, should no longer occur ($logDebug ???) = let messageIcon = Nothing
messageContent = msgContent <> "!!!" messageContent = msgContent <> "!!" -- mark legacy case, should no longer occur ($logDebug instead ???)
in Message{..} in Message{..}
| otherwise -- should not happen, if refactored correctly ($logDebug ???) | otherwise -- should not happen
= let messageStatus = Utils.Message.Warning = let messageStatus = Utils.Message.Error
messageContent = msgContent <> "!!!!" messageContent = msgContent <> "!!!" -- mark legacy case, should no longer occur ($logDebug instead ???)
messageIcon = Nothing messageIcon = Nothing
in Message{..} in Message{..}