This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Utils/SystemMessage.hs
2020-04-09 11:56:29 +02:00

32 lines
1.4 KiB
Haskell

module Utils.SystemMessage where
import Import.NoFoundation
import qualified Data.List.NonEmpty as NonEmpty
import Data.List (findIndex)
getSystemMessage :: MonadHandler m
=> NonEmpty Lang -- ^ `appLanguages`
-> SystemMessageId
-> ReaderT SqlBackend m (Maybe (SystemMessage, Maybe SystemMessageTranslation))
getSystemMessage appLanguages smId = runMaybeT $ do
SystemMessage{..} <- MaybeT $ get smId
translations <- lift $ selectList [SystemMessageTranslationMessage ==. smId] []
let
avL = NonEmpty.sortWith (\l -> NTop $ findIndex (langMatches l) $ NonEmpty.toList appLanguages) $ systemMessageDefaultLanguage :| map (systemMessageTranslationLanguage . entityVal) translations
lang <- selectLanguage avL
return (SystemMessage{..}, find (langMatches lang . systemMessageTranslationLanguage) $ map entityVal translations)
systemMessageToTranslation :: SystemMessageId
-> (SystemMessage, Maybe SystemMessageTranslation)
-> SystemMessageTranslation
systemMessageToTranslation systemMessageTranslationMessage (SystemMessage{..}, Nothing)
= SystemMessageTranslation
{ systemMessageTranslationMessage
, systemMessageTranslationLanguage = systemMessageDefaultLanguage
, systemMessageTranslationContent = systemMessageContent
, systemMessageTranslationSummary = systemMessageSummary
}
systemMessageToTranslation _ (_, Just t) = t