diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg similarity index 99% rename from messages/uniworx/de-de-formal.msg rename to messages/uniworx/misc/de-de-formal.msg index aaf161329..3be85654d 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -1,5 +1,3 @@ -PrintDebugForStupid name@Text: Debug message "#{name}" - Logo: Uni2work BtnSubmit: Senden diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/misc/en-eu.msg similarity index 99% rename from messages/uniworx/en-eu.msg rename to messages/uniworx/misc/en-eu.msg index fe58afd6a..3f425b064 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -1,5 +1,3 @@ -PrintDebugForStupid name: Debug message "#{name}" - Logo: Uni2work BtnSubmit: Submit diff --git a/messages/uniworx/test/de-de-formal.msg b/messages/uniworx/test/de-de-formal.msg new file mode 100644 index 000000000..001e9a1cf --- /dev/null +++ b/messages/uniworx/test/de-de-formal.msg @@ -0,0 +1 @@ +PrintDebugForStupid name@Text: Debug message "#{name}" diff --git a/messages/uniworx/test/en-eu.msg b/messages/uniworx/test/en-eu.msg new file mode 100644 index 000000000..bc2776f24 --- /dev/null +++ b/messages/uniworx/test/en-eu.msg @@ -0,0 +1 @@ +PrintDebugForStupid name: Debug message "#{name}" diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 95aff88ef..fa5a52c2b 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -3,7 +3,7 @@ module Foundation.I18n ( appLanguages, appLanguagesOpts - , UniWorXMessage(..) + , UniWorXMessage(..), UniWorXTestMessage(..) , ShortTermIdentifier(..) , MsgLanguage(..) , ShortSex(..) @@ -20,11 +20,11 @@ module Foundation.I18n , UniWorXMessages(..) , uniworxMessages , unRenderMessage, unRenderMessage', unRenderMessageLenient + , module Foundation.I18n.TH ) where import Foundation.Type - import Import.NoFoundation import Auth.LDAP @@ -131,12 +131,13 @@ maybeToMessage _ Nothing _ = mempty maybeToMessage before (Just x) after = before <> toMessage x <> after -- Messages creates type UniWorXMessage and RenderMessage UniWorX instance -mkMessage ''UniWorX "messages/uniworx" "de-de-formal" -mkMessageVariant "UniWorX" "Campus" "messages/campus" "de" -mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de" -mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de" -mkMessageVariant "UniWorX" "Button" "messages/button" "de" -mkMessageVariant "UniWorX" "Frontend" "messages/frontend" "de-de-formal" +mkMessage ''UniWorX "messages/uniworx/misc" "de-de-formal" +mkMessageAddition ''UniWorX "Test" "messages/uniworx/test" "de-de-formal" +mkMessageVariant ''UniWorX ''CampusMessage "messages/campus" "de" +mkMessageVariant ''UniWorX ''DummyMessage "messages/dummy" "de" +mkMessageVariant ''UniWorX ''PWHashMessage "messages/pw-hash" "de" +mkMessageVariant ''UniWorX ''ButtonMessage "messages/button" "de" +mkMessageVariant ''UniWorX ''FrontendMessage "messages/frontend" "de-de-formal" instance RenderMessage UniWorX TermIdentifier where renderMessage foundation ls TermIdentifier{..} = case season of diff --git a/src/Foundation/I18n/TH.hs b/src/Foundation/I18n/TH.hs index 06e756e4e..0068a5391 100644 --- a/src/Foundation/I18n/TH.hs +++ b/src/Foundation/I18n/TH.hs @@ -1,7 +1,7 @@ {-# LANGUAGE UndecidableInstances #-} module Foundation.I18n.TH - ( mkMessage + ( mkMessage, mkMessageFor, mkMessageVariant, mkMessageAddition ) where import Import.NoFoundation @@ -113,17 +113,37 @@ mkMessage :: TH.Name -- ^ Foundation type -> FilePath -- ^ Base directory of translation files -> Lang -- ^ Default translation language -> TH.DecsQ -mkMessage dt folder lang = mkMessageCommon True "Msg" "Message" dt (TH.nameBase dt) folder lang +mkMessage dt folder lang = mkMessageCommon True "Msg" dt (TH.mkName $ TH.nameBase dt <> "Message") folder lang + +mkMessageFor :: TH.Name -- ^ Foundation type + -> TH.Name -- ^ Existing type to add translations for + -> FilePath -- ^ Base directory of translation files + -> Lang -- ^ Default translation language + -> TH.DecsQ +mkMessageFor master dt folder lang = mkMessageCommon False "" master dt folder lang + +mkMessageVariant :: TH.Name -- ^ Foundation type + -> TH.Name -- ^ Existing type to add translations for + -> FilePath -- ^ Base directory of translation files + -> Lang -- ^ Default translation language + -> TH.DecsQ +mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" master dt folder lang + +mkMessageAddition :: TH.Name -- ^ Foundation type + -> String -- ^ Qualifier to insert into name of message type + -> FilePath -- ^ Base directory of translation files + -> Lang -- ^ Default translation language + -> TH.DecsQ +mkMessageAddition master dt folder lang = mkMessageCommon True "Msg" master (TH.mkName $ TH.nameBase master <> dt <> "Message") folder lang mkMessageCommon :: Bool -- ^ Generate new datatype -> String -- ^ String to prepend to constructor names - -> String -- ^ String to append to datatype name -> TH.Name -- ^ Name of master datatype - -> String -- ^ Basename of translation datatype + -> TH.Name -- ^ Name of translation datatype -> FilePath -- ^ Base directory of translation files -> Lang -- ^ Default translation language -> TH.DecsQ -mkMessageCommon genType prefix postfix master dt folder defLang = do +mkMessageCommon genType prefix master datName folder defLang = do files <- fmap DirTree.zipPaths . liftIO $ DirTree.readDirectoryWith (runExceptT . parseMsgFile) folder forMOf_ (folded . _1) files TH.addDependentFile @@ -153,7 +173,6 @@ mkMessageCommon genType prefix postfix master dt folder defLang = do unless (null extraDefns) . fail $ "Extraneous message definitions:\n" <> indent 2 (unlines extraDefnsErrs) let defnName defn = TH.mkName $ prefix <> defn - datName = TH.mkName $ dt <> postfix execWriterT @_ @[TH.Dec] $ do when genType $ do diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index fdfe301ec..3ca061080 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -233,3 +233,5 @@ postAdminTestR = do

_{MsgTestDownload} ^{testDownloadWidget} |] + + i18n $ MsgPrintDebugForStupid "DebugForStupid" diff --git a/src/Handler/Info.hs b/src/Handler/Info.hs index 43110c6cc..f12f96e44 100644 --- a/src/Handler/Info.hs +++ b/src/Handler/Info.hs @@ -104,7 +104,7 @@ getGlossaryR = mkI18nWidgetEnum "FAQ" "faq" -mkMessageFor "UniWorX" "FAQItem" "messages/faq" "de-de-formal" +mkMessageFor ''UniWorX ''FAQItem "messages/faq" "de-de-formal" faqsWidget :: ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index afa50f03e..7ca1dcaaa 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -22,7 +22,7 @@ import ClassyPrelude.Yesod as Import , sinkFile, sourceFile , defaultYesodMiddleware , authorizationCheck - , mkMessage + , mkMessage, mkMessageFor, mkMessageVariant ) import UnliftIO.Async.Utils as Import