-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Steffen Jost ,Winnie Ros -- -- SPDX-License-Identifier: AGPL-3.0-or-later -- To add new language files: -- 1. include new statement, e.g. mkMessageAddition ''UniWorX "Print" "messages/uniworx/categories/print" "de-de-formal" -- 2. create appropriate translation files in the specified folder -- 3. add constructor to list of module exports {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Foundation.I18n ( appLanguages, appLanguagesOpts , UniWorXMessage(..), UniWorXTestMessage(..), UniWorXSettingsMessage(..) , UniWorXHelpMessage(..), UniWorXNavigationMessage(..) , UniWorXCourseMessage(..), UniWorXExamMessage(..) , UniWorXSheetMessage(..), UniWorXAdminMessage(..), UniWorXSubmissionMessage(..) , UniWorXTutorialMessage(..), UniWorXUserMessage(..), UniWorXButtonMessage(..) , UniWorXFormMessage(..), UniWorXRatingMessage(..), UniWorXTableColumnMessage(..) , UniWorXTablePaginationMessage(..),UniWorXUtilMessage(..), UniWorXAuthorizationMessage(..) , UniWorXMaterialMessage(..), UniWorXParticipantsMessage(..), UniWorXHealthMessage(..), UniWorXInfoMessage(..) , UniWorXMetricsMessage(..), UniWorXNewsMessage(..), UniWorXSchoolMessage(..), UniWorXSystemMessageMessage(..) , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..) , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..) , UniWorXQualificationMessage(..) , UniWorXPrintMessage(..) , UniWorXFirmMessage(..) , UniWorXAvsMessage(..) , UniWorXAuthorshipStatementMessage(..) , ShortTermIdentifier(..) , MsgLanguage(..) , ShortSex(..) , ShortWeekDay(..) , SheetType'(..), classifySheetType , SheetArchiveFileTypeDirectory(..) , ShortStudyDegree(..) , ShortStudyTerms(..) , StudyDegreeTerm(..) , ShortStudyFieldType(..) , StudyDegreeTermType(..) , ErrorResponseTitle(..) , UniWorXMessages(..) , uniworxMessages , unRenderMessage, unRenderMessage', unRenderMessageLenient , SomeMessages(..) , someMessages , module Foundation.I18n.TH ) where import Foundation.Type import Import.NoFoundation import Auth.LDAP import Auth.PWHash import Auth.Dummy import Data.CaseInsensitive (original, mk) import qualified Data.Text as Text import Utils.Form import qualified GHC.Exts (IsList(..)) import Yesod.Form.I18n.German import Yesod.Form.I18n.English import qualified Data.Char as Char import Text.Unidecode (unidecode) import Data.Text.Lens (packed) import Data.List ((!!)) -- import qualified Data.Scientific as Scientific import Foundation.I18n.TH pluralDE :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ Singular -> Text -- ^ Plural -> Text pluralDE num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm -- pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text -- -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ -- pluralDEx c n t = pluralDE n t $ t `snoc` c -- -- | like `pluralDEe` but also prefixes with the number -- pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text -- pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t) pluralDEe :: (Eq a, Num a) => a -> Text -> Text -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ pluralDEe n t = pluralDE n t $ t `snoc` 'e' -- | like `pluralDEe` but also prefixes with the number pluralDEeN :: (Eq a, Num a, Show a) => a -> Text -> Text pluralDEeN n t = tshow n <> cons ' ' (pluralDEe n t) noneOneMoreDE :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ None -> Text -- ^ Singular -> Text -- ^ Plural -> Text noneOneMoreDE num noneText singularForm pluralForm | num == 0 = noneText | num == 1 = singularForm | otherwise = pluralForm -- noneMoreDE :: (Eq a, Num a) -- => a -- ^ Count -- -> Text -- ^ None -- -> Text -- ^ Some -- -> Text -- noneMoreDE num noneText someText -- | num == 0 = noneText -- | otherwise = someText pluralEN :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ Singular -> Text -- ^ Plural -> Text pluralEN num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm pluralENs :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ Singular -> Text -- ^ @pluralENs n "foo" = pluralEN n "foo" "foos"@ pluralENs n t = pluralEN n t $ t `snoc` 's' -- | like `pluralENs` but also prefixes with the number pluralENsN :: (Eq a, Num a, Show a) => a -> Text -> Text pluralENsN n t = tshow n <> cons ' ' (pluralENs n t) noneOneMoreEN :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ None -> Text -- ^ Singular -> Text -- ^ Plural -> Text noneOneMoreEN num noneText singularForm pluralForm | num == 0 = noneText | num == 1 = singularForm | otherwise = pluralForm -- noneMoreEN :: (Eq a, Num a) -- => a -- ^ Count -- -> Text -- ^ None -- -> Text -- ^ Some -- -> Text -- noneMoreEN num noneText someText -- | num == 0 = noneText -- | otherwise = someText _ordinalEN :: ToMessage a => a -> Text _ordinalEN (toMessage -> numStr) = case lastChar of Just '1' -> [st|#{numStr}st|] Just '2' -> [st|#{numStr}nd|] Just '3' -> [st|#{numStr}rd|] _other -> [st|#{numStr}th|] where lastChar = last <$> fromNullable numStr notDE :: Bool -> Text notDE = bool "nicht" "" notEN :: Bool -> Text notEN = bool "not" "" {- -- TODO: use this is message eventually -- Commonly used plurals data Thing = Person | Examinee deriving (Eq) thingDE :: Int -> Thing -> Text thingDE num = (tshow num <>) . Text.cons ' ' . thing where thing :: Thing -> Text thing Person = pluralDE num "Person" "Personen" thing Examinee = pluralDE num "Prüfling" "Prüflinge" thingEN :: Int -> Thing -> Text thingEN num t = tshow num <> Text.cons ' ' (thing t) where thing :: Thing -> Text thing Person = pluralENs num "person" thing Examinee = pluralENs num "examinee" -} -- | Convenience function for i18n messages definitions maybeToMessage :: ToMessage m => Text -> Maybe m -> Text -> Text maybeToMessage _ Nothing _ = mempty maybeToMessage before (Just x) after = before <> toMessage x <> after maybeBoolMessage :: Maybe Bool -> Text -> Text -> Text -> Text maybeBoolMessage Nothing n _ _ = n maybeBoolMessage (Just True) _ t _ = t maybeBoolMessage (Just False) _ _ f = f newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier deriving stock (Eq, Ord, Read, Show) -- Messages creates type UniWorXMessage and RenderMessage UniWorX instance mkMessage ''UniWorX "messages/uniworx/misc" "de-de-formal" mkMessageAddition ''UniWorX "Test" "messages/uniworx/test" "de-de-formal" mkMessageAddition ''UniWorX "Settings" "messages/uniworx/categories/settings" "de-de-formal" mkMessageAddition ''UniWorX "Help" "messages/uniworx/categories/help" "de-de-formal" mkMessageAddition ''UniWorX "Navigation" "messages/uniworx/utils/navigation" "de-de-formal" mkMessageAddition ''UniWorX "Course" "messages/uniworx/categories/courses/courses" "de-de-formal" mkMessageAddition ''UniWorX "Exam" "messages/uniworx/categories/courses/exam" "de-de-formal" mkMessageAddition ''UniWorX "Sheet" "messages/uniworx/categories/courses/sheet" "de-de-formal" mkMessageAddition ''UniWorX "Admin" "messages/uniworx/categories/admin" "de-de-formal" mkMessageAddition ''UniWorX "Submission" "messages/uniworx/categories/courses/submission" "de-de-formal" mkMessageAddition ''UniWorX "Tutorial" "messages/uniworx/categories/courses/tutorial" "de-de-formal" mkMessageAddition ''UniWorX "Material" "messages/uniworx/categories/courses/material" "de-de-formal" mkMessageAddition ''UniWorX "Authorization" "messages/uniworx/categories/authorization" "de-de-formal" mkMessageAddition ''UniWorX "Health" "messages/uniworx/categories/health" "de-de-formal" mkMessageAddition ''UniWorX "Info" "messages/uniworx/categories/info" "de-de-formal" mkMessageAddition ''UniWorX "Metrics" "messages/uniworx/categories/metrics" "de-de-formal" mkMessageAddition ''UniWorX "News" "messages/uniworx/categories/news" "de-de-formal" mkMessageAddition ''UniWorX "School" "messages/uniworx/categories/school" "de-de-formal" mkMessageAddition ''UniWorX "SystemMessage" "messages/uniworx/categories/system_message" "de-de-formal" mkMessageAddition ''UniWorX "Participants" "messages/uniworx/categories/courses/participants" "de-de-formal" mkMessageAddition ''UniWorX "Term" "messages/uniworx/categories/term" "de-de-formal" mkMessageAddition ''UniWorX "Error" "messages/uniworx/categories/error" "de-de-formal" mkMessageAddition ''UniWorX "I18n" "messages/uniworx/categories/I18n" "de-de-formal" mkMessageAddition ''UniWorX "JobsHandler" "messages/uniworx/categories/jobs_handler" "de-de-formal" mkMessageAddition ''UniWorX "ModelTypes" "messages/uniworx/categories/model_types" "de-de-formal" mkMessageAddition ''UniWorX "Send" "messages/uniworx/categories/send" "de-de-formal" mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal" mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal" mkMessageAddition ''UniWorX "Print" "messages/uniworx/categories/print" "de-de-formal" mkMessageAddition ''UniWorX "Firm" "messages/uniworx/categories/firm" "de-de-formal" mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal" mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal" mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal" mkMessageAddition ''UniWorX "TablePagination" "messages/uniworx/utils/table_pagination" "de-de-formal" mkMessageAddition ''UniWorX "Util" "messages/uniworx/utils/utils" "de-de-formal" mkMessageAddition ''UniWorX "Rating" "messages/uniworx/utils/rating" "de-de-formal" mkMessageAddition ''UniWorX "SiteLayout" "messages/uniworx/utils/site_layout" "de-de-formal" mkMessageAddition ''UniWorX "AuthorshipStatement" "messages/uniworx/utils/authorship_statement" "de-de-formal" mkMessageVariant ''UniWorX ''CampusMessage "messages/auth/campus" "de" mkMessageVariant ''UniWorX ''DummyMessage "messages/auth/dummy" "de" mkMessageVariant ''UniWorX ''PWHashMessage "messages/auth/pw-hash" "de" mkMessageVariant ''UniWorX ''ButtonMessage "messages/button" "de" mkMessageVariant ''UniWorX ''FrontendMessage "messages/frontend" "de-de-formal" embedRenderMessage ''UniWorX ''AvsLicence id -- required by UniWorXAvsMessages mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal" mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-formal" embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) newtype SomeMessages master = SomeMessages [SomeMessage master] deriving newtype (Semigroup, Monoid) instance master ~ master' => RenderMessage master (SomeMessages master') where renderMessage a b (SomeMessages msgs) = Text.intercalate " " $ renderMessage a b <$> msgs -- | convenienience function if all messages happen to belong to the exact same type someMessages :: RenderMessage master msg => [msg] -> SomeMessages master someMessages msgs = SomeMessages $ SomeMessage <$> msgs instance RenderMessage UniWorX (Maybe LmsStatus) where -- useful for Filter with optionsFinite renderMessage f ls (Just s) = renderMessage f ls s renderMessage f ls Nothing = renderMessage f ls MsgLmsStateOpen instance RenderMessage UniWorX AvsDataCardColor where renderMessage _foundation _ls (AvsCardColorMisc t) = Text.cons '*' t renderMessage f ls AvsCardColorGrün = renderMessage f ls MsgAvsCardColorGreen renderMessage f ls AvsCardColorBlau = renderMessage f ls MsgAvsCardColorBlue renderMessage f ls AvsCardColorRot = renderMessage f ls MsgAvsCardColorRed renderMessage f ls AvsCardColorGelb = renderMessage f ls MsgAvsCardColorYellow instance RenderMessage UniWorX TermIdentifier where renderMessage _foundation _ls = termToText -- TODO: respect user selected Datetime Format instance RenderMessage UniWorX ShortTermIdentifier where renderMessage _foundation _ls (ShortTermIdentifier tid) = termToText tid -- TODO: implement shorttermidentifier properly instance RenderMessage UniWorX String where renderMessage f ls str = renderMessage f ls $ Text.pack str -- TODO: raw number representation; instead, display e.g. 1000 as 1.000 or 1,000 or ... (language-dependent!) instance RenderMessage UniWorX Int where renderMessage f ls = renderMessage f ls . tshow instance RenderMessage UniWorX Int64 where renderMessage f ls = renderMessage f ls . tshow instance RenderMessage UniWorX Integer where renderMessage f ls = renderMessage f ls . tshow instance RenderMessage UniWorX Natural where renderMessage f ls = renderMessage f ls . tshow instance RenderMessage UniWorX Word64 where renderMessage f ls = renderMessage f ls . tshow instance HasResolution a => RenderMessage UniWorX (Fixed a) where renderMessage f ls = renderMessage f ls . showFixed True instance RenderMessage UniWorX Load where renderMessage foundation ls = renderMessage foundation ls . \case Load { byTutorial = Nothing , byProportion = p } -> MsgCorByProportionOnly p Load { byTutorial = Just True , byProportion = p } -> MsgCorByProportionIncludingTutorial p Load { byTutorial = Just False, byProportion = p } -> MsgCorByProportionExcludingTutorial p data MsgLanguage = MsgLanguage { unMsgLanguage :: Lang } | MsgLanguageEndonym { unMsgLanguage :: Lang } deriving stock (Eq, Ord, Show, Read) instance RenderMessage UniWorX MsgLanguage where renderMessage foundation ls msg@(unMsgLanguage -> lang@(map mk . Text.splitOn "-" -> lang')) | ("de" : "DE" : _) <- lang' = mr MsgGermanGermany | ("de" : _) <- lang' = mr MsgGerman | ("en" : "EU" : _) <- lang' = mr MsgEnglishEurope | ("en" : _) <- lang' = mr MsgEnglish | otherwise = lang where mr = renderMessage foundation $ case msg of MsgLanguageEndonym _ -> lang : filter (/= lang) ls MsgLanguage _ -> ls appLanguagesOpts :: ( MonadHandler m , RenderMessage (HandlerSite m) MsgLanguage ) => m (OptionList Lang) -- ^ Authoritive list of supported Languages appLanguagesOpts = do MsgRenderer mr <- getMsgRenderer let mkOption l = Option { optionDisplay = mr $ MsgLanguage l , optionInternalValue = l , optionExternalValue = l } langOptions = map mkOption $ toList appLanguages return $ mkOptionList langOptions embedRenderMessage ''UniWorX ''HealthCheck id embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>) embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel embedRenderMessage ''UniWorX ''StudyFieldType id embedRenderMessage ''UniWorX ''SheetFileType id embedRenderMessage ''UniWorX ''SubmissionFileType id embedRenderMessage ''UniWorX ''CorrectorState ("Sheet" <>) embedRenderMessage ''UniWorX ''SubmissionSinkException ("SubmissionSinkException" <>) embedRenderMessage ''UniWorX ''SheetGrading ("SheetGrading" <>) embedRenderMessage ''UniWorX ''AuthTag $ ("AuthTag" <>) . concat . drop 1 . splitCamel embedRenderMessage ''UniWorX ''EncodedSecretBoxException id embedRenderMessage ''UniWorX ''LecturerType id embedRenderMessage ''UniWorX ''SubmissionModeDescr $ let verbMap [_, _, "None"] = "NoSubmissions" verbMap [_, _, v] = v <> "Submissions" verbMap _ = error "Invalid number of verbs" in verbMap . splitCamel embedRenderMessage ''UniWorX ''UploadModeDescr id embedRenderMessage ''UniWorX ''SecretJSONFieldException id embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel embedRenderMessage ''UniWorX ''SchoolFunction id embedRenderMessage ''UniWorX ''SystemFunction id embedRenderMessage ''UniWorX ''CsvPreset id embedRenderMessage ''UniWorX ''Quoting ("Csv" <>) embedRenderMessage ''UniWorX ''CsvFormat ("Csv" <>) embedRenderMessage ''UniWorX ''FavouriteReason id embedRenderMessage ''UniWorX ''Sex id embedRenderMessage ''UniWorX ''ExamGradingMode id embedRenderMessage ''UniWorX ''ExamAidsPreset id embedRenderMessage ''UniWorX ''ExamOnlinePreset id embedRenderMessage ''UniWorX ''ExamSynchronicityPreset id embedRenderMessage ''UniWorX ''ExamRequiredEquipmentPreset id embedRenderMessage ''UniWorX ''ChangelogItemKind id embedRenderMessage ''UniWorX ''RoomReference' $ dropSuffix "'" embedRenderMessage ''UniWorX ''AuthenticationMode id embedRenderMessage ''UniWorX ''RatingValidityException id embedRenderMessage ''UniWorX ''UrlFieldMessage id embedRenderMessageVariant ''UniWorX ''ADInvalidCredentials ("InvalidCredentials" <>) embedRenderMessage ''UniWorX ''SchoolAuthorshipStatementMode id embedRenderMessage ''UniWorX ''SheetAuthorshipStatementMode id embedRenderMessage ''UniWorX ''AuthorshipStatementSubmissionState $ concat . ("SubmissionAuthorshipStatementState" :) . drop 1 . splitCamel newtype ShortSex = ShortSex Sex embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>) data SheetType' = NotGraded' | Normal' | Bonus' | Informational' | ExamPartPoints' deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving (Universe, Finite) classifySheetType :: SheetType a -> SheetType' classifySheetType = \case NotGraded -> NotGraded' Normal{} -> Normal' Bonus{} -> Bonus' Informational{} -> Informational' ExamPartPoints{} -> ExamPartPoints' nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'") embedRenderMessage ''UniWorX ''SheetType' $ ("SheetType" <>) . fromMaybe (error "Expected SheetType' to have '") . stripSuffix "'" newtype SheetArchiveFileTypeDirectory = SheetArchiveFileTypeDirectory SheetFileType deriving (Eq, Ord, Read, Show, Generic) deriving newtype (Enum, Bounded, Universe, Finite) embedRenderMessageVariant ''UniWorX ''SheetArchiveFileTypeDirectory $ ("SheetArchiveFileTypeDirectory" <>) . concat . drop 1 . splitCamel instance RenderMessage UniWorX StudyDegree where renderMessage _found _ls StudyDegree{..} = fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand) newtype ShortStudyDegree = ShortStudyDegree StudyDegree instance RenderMessage UniWorX ShortStudyDegree where renderMessage _found _ls (ShortStudyDegree StudyDegree{..}) = fromMaybe (tshow studyDegreeKey) studyDegreeShorthand instance RenderMessage UniWorX StudyTerms where renderMessage _found _ls StudyTerms{..} = fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand) newtype ShortStudyTerms = ShortStudyTerms StudyTerms instance RenderMessage UniWorX ShortStudyTerms where renderMessage _found _ls (ShortStudyTerms StudyTerms{..}) = fromMaybe (tshow studyTermsKey) studyTermsShorthand data StudyDegreeTerm = StudyDegreeTerm StudyDegree StudyTerms instance RenderMessage UniWorX StudyDegreeTerm where renderMessage foundation ls (StudyDegreeTerm deg trm) = mr trm <> " (" <> mr (ShortStudyDegree deg) <> ")" where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls newtype ShortStudyFieldType = ShortStudyFieldType StudyFieldType embedRenderMessageVariant ''UniWorX ''ShortStudyFieldType ("Short" <>) data StudyDegreeTermType = StudyDegreeTermType StudyDegree StudyTerms StudyFieldType instance RenderMessage UniWorX StudyDegreeTermType where renderMessage foundation ls (StudyDegreeTermType deg trm typ) = mr trm <> " (" <> mr (ShortStudyDegree deg) <> ", " <> mr (ShortStudyFieldType typ) <> ")" where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls instance RenderMessage UniWorX ExamGrade where renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade instance RenderMessage UniWorX ExamPassed where renderMessage foundation ls = \case ExamPassed True -> mr MsgExamPassed ExamPassed False -> mr MsgExamNotPassed where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where renderMessage foundation ls = \case ExamAttended{..} -> mr examResult ExamNoShow -> mr MsgExamResultNoShow ExamVoided -> mr MsgExamResultVoided where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where renderMessage foundation ls = either mr mr where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls instance RenderMessage UniWorX CourseParticipantState where renderMessage foundation ls = \case CourseParticipantActive -> mr MsgCourseParticipantActive CourseParticipantInactive False -> mr MsgCourseParticipantInactive CourseParticipantInactive True -> mr MsgCourseParticipantNoShow where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls instance RenderMessage UniWorX ExamCloseMode where renderMessage foundation ls = \case ExamCloseSeparate -> mr MsgExamCloseModeSeparate ExamCloseOnFinished False -> mr MsgExamCloseModeOnFinished ExamCloseOnFinished True -> mr MsgExamCloseModeOnFinishedHidden where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls -- ToMessage instances for converting raw numbers to Text (no internationalization) -- FIXME: Use RenderMessage always instance ToMessage Int where toMessage = tshow instance ToMessage Int64 where toMessage = tshow instance ToMessage Integer where toMessage = tshow instance ToMessage Natural where toMessage = tshow instance ToMessage Word64 where toMessage = tshow instance HasResolution a => ToMessage (Fixed a) where toMessage = toMessage . showFixed True -- Do not use toMessage on Rationals and round them automatically. Instead, use rationalToFixed3 (declared in src/Utils.hs) to convert a Rational to Fixed E3! -- instance ToMessage Rational where -- toMessage = toMessage . fromRational' -- where fromRational' = fromRational :: Rational -> Fixed E3 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>) newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX] deriving stock (Generic) deriving newtype (Semigroup, Monoid) instance IsList UniWorXMessages where type Item UniWorXMessages = SomeMessage UniWorX fromList = UniWorXMessages toList (UniWorXMessages msgs) = msgs instance RenderMessage UniWorX UniWorXMessages where renderMessage foundation ls (UniWorXMessages msgs) = Text.unwords $ map (renderMessage foundation ls) msgs uniworxMessages :: [UniWorXMessage] -> UniWorXMessages uniworxMessages = UniWorXMessages . map SomeMessage -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage UniWorX FormMessage where renderMessage _ ls | lang == "en" = englishFormMessage | otherwise = germanFormMessage where lang = selectLanguage' ("de" :| ["en"]) ls instance RenderMessage UniWorX (ValueRequired UniWorX) where renderMessage foundation ls (ValueRequired label') | [w] <- Text.words label , let w' = Text.strip w , not $ Text.null w' = mr $ MsgValueRequiredLabeledSimple w' | Text.null $ Text.strip label = mr MsgValueRequired | otherwise = mr . MsgValueRequiredLabeledMultiWord $ Text.strip label where label = mr label' mr :: forall msg. RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls instance RenderRoute UniWorX => RenderMessage UniWorX (UnsupportedAuthPredicate AuthTag (Route UniWorX)) where renderMessage f ls (UnsupportedAuthPredicate tag route) = mr . MsgUnsupportedAuthPredicate (mr tag) $ Text.intercalate "/" pieces where mr :: forall msg. RenderMessage UniWorX msg => msg -> Text mr = renderMessage f ls (pieces, _) = renderRoute route instance RenderMessage UniWorX WeekDay where renderMessage _ ls wDay = pack . fst $ wDays (getTimeLocale' ls) !! (fromEnum wDay `mod` 7) newtype ShortWeekDay = ShortWeekDay { longWeekDay :: WeekDay } instance RenderMessage UniWorX ShortWeekDay where renderMessage _ ls (ShortWeekDay wDay) = pack . snd $ wDays (getTimeLocale' ls) !! (fromEnum wDay `mod` 7) embedRenderMessage ''UniWorX ''ButtonSubmit id instance RenderMessage UniWorX VolatileClusterSettingsKey where renderMessage foundation ls = \case ClusterVolatileQuickActionsEnabled -> mr MsgClusterVolatileQuickActionsEnabled where mr :: forall msg. RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls unRenderMessage' :: (Ord a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a] unRenderMessage' cmp foundation inp = nubOrd $ do l <- appLanguages' x <- universeF guard $ renderMessage foundation (l : filter (/= l) appLanguages') x `cmp` inp return x where appLanguages' = toList appLanguages unRenderMessage :: (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a] unRenderMessage = unRenderMessage' (==) unRenderMessageLenient :: forall a master. (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a] unRenderMessageLenient = unRenderMessage' cmp where cmp = (==) `on` mk . under packed (filter Char.isAlphaNum . concatMap unidecode) instance Default DateTimeFormatter where def = mkDateTimeFormatter (getTimeLocale' []) def appTZ instance RenderMessage UniWorX Address where renderMessage s l a@Address{addressName = Just aname} = aname <> cons ' ' (renderMessage s l a{addressName=Nothing}) renderMessage _ _ Address{addressEmail = mail} = "<" <> mail <> ">"