diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 3dd02a5f9..aaf161329 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -17,7 +17,7 @@ BtnExamSwitchOccurrence: Zu Prüfungstermin/-raum wechseln
 BtnExamDeregister: Von der Prüfung abmelden
 BtnHijack: Sitzung übernehmen
 BtnSave: Speichern
-PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes "Speichern" gespeichert.
+PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes „_{MsgBtnSave}“ gespeichert.
 BtnHandIn: Abgeben
 BtnNameCandidatesInfer: Studienfach-Namens-Zuordnung automatisch lernen
 BtnNameCandidatesDeleteConflicts: Namenskonflikte löschen
@@ -151,7 +151,7 @@ CourseMemberOf: Teilnehmer von
 CourseAssociatedWith: assoziiert mit
 CourseMembersCount n@Int: #{n}
 CourseMembersCountLimited n@Int max@Int: #{n}/#{max}
-CourseMembersCountOf n@Int mbNum@IntMaybe: #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"}
+CourseMembersCountOf n@Int mbNum@(Maybe Int): #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"}
 CourseName: Kurstitel
 CourseDescription: Beschreibung
 CourseHomepageExternal: Externe Homepage
@@ -2146,8 +2146,8 @@ CsvImportExplanationLabel: Hinweise zum CSV-Import
 CsvExampleData: Beispiel-Datei
 CsvExportExample: Beispiel-CSV exportieren
 
-Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
-ProportionNoRatio c@Text of@Text: #{c}/#{of}
+Proportion c@Text of'@Text prop@Rational: #{c}/#{of'} (#{rationalToFixed2 (100 * prop)}%)
+ProportionNoRatio c@Text of'@Text: #{c}/#{of'}
 
 CourseUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-teilnehmer
 ExamUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-teilnehmer
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index 0ab958e2c..fe58afd6a 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -2145,8 +2145,8 @@ CsvImportExplanationLabel: Informating regarding CSV import
 CsvExampleData: Example data
 CsvExportExample: Export example CSV
 
-Proportion c of prop: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
-ProportionNoRatio c of: #{c}/#{of}
+Proportion c of' prop: #{c}/#{of'} (#{rationalToFixed2 (100 * prop)}%)
+ProportionNoRatio c of': #{c}/#{of'}
 
 CourseUserCsvName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-participants
 ExamUserCsvName tid ssh csh examn: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-participants
diff --git a/package.yaml b/package.yaml
index 00f9f0d85..a3ca91a98 100644
--- a/package.yaml
+++ b/package.yaml
@@ -161,6 +161,7 @@ dependencies:
   - psqueues
   - nonce
   - IntervalMap
+  - haskell-src-meta
 other-extensions:
   - GeneralizedNewtypeDeriving
   - IncoherentInstances
diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs
index b8b7527bf..95aff88ef 100644
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@@ -52,6 +52,8 @@ import qualified Data.Scientific as Scientific
 
 import Utils.Workflow (RouteWorkflowScope)
 
+import Foundation.I18n.TH
+
 
 pluralDE :: (Eq a, Num a)
             =>    a -- ^ Count
@@ -123,16 +125,13 @@ ordinalEN (toMessage -> numStr) = case lastChar of
     lastChar = last <$> fromNullable numStr
 
 
--- Convenience Type for Messages, since Yesod messages cannot deal with compound type identifiers
-type IntMaybe  = Maybe Int
-
 -- | 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
 
 -- Messages creates type UniWorXMessage and RenderMessage UniWorX instance
-mkMessage "UniWorX" "messages/uniworx" "de-de-formal"
+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"
diff --git a/src/Foundation/I18n/TH.hs b/src/Foundation/I18n/TH.hs
new file mode 100644
index 000000000..06e756e4e
--- /dev/null
+++ b/src/Foundation/I18n/TH.hs
@@ -0,0 +1,305 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Foundation.I18n.TH
+  ( mkMessage
+  ) where
+
+import Import.NoFoundation
+import qualified Language.Haskell.TH.Lib as TH
+import qualified Language.Haskell.TH.Syntax as TH
+
+import qualified System.Directory.Tree as DirTree
+
+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
+import Data.HashSet.InsOrd (InsOrdHashSet)
+import qualified Data.HashSet.InsOrd as InsOrdHashSet
+import qualified Data.Foldable as F
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.HashSet as HashSet
+import qualified Data.Map.Strict as Map
+
+import qualified Text.Parsec as P
+import qualified Text.Parsec.Text.Lazy as P
+
+import qualified Language.Haskell.Meta.Parse as Meta
+
+import qualified Data.List.NonEmpty as NonEmpty
+
+import qualified Data.Text as Text
+
+import Utils.TH.AlphaConversion (alphaConvE)
+
+
+newtype MsgFile f g = MsgFile
+  { msgFileContent :: InsOrdHashMap String (f (MsgDef f g))
+  } deriving (Generic, Typeable)
+
+deriving stock instance Eq (f (MsgDef f g)) => Eq (MsgFile f g)
+deriving stock instance Show (f (MsgDef f g)) => Show (MsgFile f g)
+
+instance Semigroup (f (MsgDef f g)) => Monoid (MsgFile f g) where
+  mempty = MsgFile InsOrdHashMap.empty
+instance Semigroup (f (MsgDef f g)) => Semigroup (MsgFile f g) where
+  MsgFile a <> MsgFile b = MsgFile $ InsOrdHashMap.unionWith (<>) a b
+
+data MsgDef f g = MsgDef
+  { msgDefVars :: InsOrdHashMap String (f (g TH.Type))
+  , msgDefContent :: [MsgDefContent]
+  } deriving (Generic, Typeable)
+
+deriving stock instance Eq (f (g TH.Type)) => Eq (MsgDef f g)
+deriving stock instance Show (f (g TH.Type)) => Show (MsgDef f g)
+
+data MsgDefContent = MsgDefContentLiteral String
+                   | MsgDefContentSplice Bool {- Recurse? -} TH.Exp
+  deriving (Eq, Ord, Show, Generic, Typeable)
+
+
+disambiguateMsgFile :: MsgFile NonEmpty Maybe -> Either (InsOrdHashSet String, InsOrdHashMap String (InsOrdHashSet String)) (MsgFile Identity Maybe)
+disambiguateMsgFile MsgFile{..}
+  | not (InsOrdHashSet.null duplicateDefs) || not (InsOrdHashMap.null duplicateVars)
+  = Left (duplicateDefs, duplicateVars)
+  | otherwise
+  = Right $ MsgFile{ msgFileContent = fmap msgDefToSingletons <$> toSingletons msgFileContent, .. }
+  where
+    toDuplicates :: forall k v. (Eq k, Hashable k) => InsOrdHashMap k (NonEmpty v) -> InsOrdHashSet k
+    toDuplicates = InsOrdHashSet.fromList . InsOrdHashMap.keys . InsOrdHashMap.filter (minLength 2)
+    duplicateDefs = toDuplicates msgFileContent
+    duplicateVars = InsOrdHashMap.mapMaybe (assertM' (not . InsOrdHashSet.null) . toDuplicates . msgDefVars . NonEmpty.head) msgFileContent
+
+    toSingletons :: forall k v. InsOrdHashMap k (NonEmpty v) -> InsOrdHashMap k (Identity v)
+    toSingletons = InsOrdHashMap.map $ \case
+      x NonEmpty.:| [] -> Identity x
+      xs -> error $ "toSingletons: Expected length 1, but got: " <> show (NonEmpty.length xs)
+    msgDefToSingletons :: MsgDef NonEmpty Maybe -> MsgDef Identity Maybe
+    msgDefToSingletons MsgDef{..} = MsgDef
+      { msgDefVars = toSingletons msgDefVars
+      , ..
+      }
+
+ensureTypesMsgFile :: MsgFile Identity Maybe -> Either (InsOrdHashMap String (InsOrdHashSet String)) (MsgFile Identity Identity)
+ensureTypesMsgFile MsgFile{..}
+  | not $ InsOrdHashMap.null untyped
+  = Left untyped
+  | otherwise
+  = Right $ MsgFile{ msgFileContent = over _Wrapped msgDefToTyped <$> msgFileContent, .. }
+  where
+    untyped = InsOrdHashMap.mapMaybe (assertM' (not . InsOrdHashSet.null) . InsOrdHashSet.fromList . InsOrdHashMap.keys . InsOrdHashMap.filter (is _Nothing . runIdentity) . msgDefVars . runIdentity) msgFileContent
+
+    msgDefToTyped MsgDef{..} = MsgDef
+      { msgDefVars = flip InsOrdHashMap.map msgDefVars $ \case
+          Identity (Just x) -> Identity $ Identity x
+          _other -> error "msgDefToTyped got Nothing"
+      , ..
+      }
+
+
+accumInsOrdHashMap :: (Foldable f, Eq k, Hashable k)
+                   => f (k, v)
+                   -> InsOrdHashMap k (NonEmpty v)
+accumInsOrdHashMap = F.foldl' (\acc (k, v) -> InsOrdHashMap.insertWith (<>) k (pure v) acc) InsOrdHashMap.empty
+
+unionsInsOrdHashMap :: (Foldable f, Eq k, Hashable k)
+                    => f (InsOrdHashMap k (NonEmpty v))
+                    -> InsOrdHashMap k (NonEmpty v)
+unionsInsOrdHashMap = F.foldl' (InsOrdHashMap.unionWith (<>)) InsOrdHashMap.empty
+
+insOrdHashMapKeysSet :: InsOrdHashMap k v -> HashSet k
+insOrdHashMapKeysSet = HashMap.keysSet . InsOrdHashMap.toHashMap
+
+
+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
+
+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
+                -> FilePath -- ^ Base directory of translation files
+                -> Lang     -- ^ Default translation language
+                -> TH.DecsQ
+mkMessageCommon genType prefix postfix master dt folder defLang = do
+  files <- fmap DirTree.zipPaths . liftIO $ DirTree.readDirectoryWith (runExceptT . parseMsgFile) folder
+  forMOf_ (folded . _1) files TH.addDependentFile
+
+  let (errors, successes) = flip (foldMapOf $ folded . _2) files $ \case
+        Left  err -> ([err], mempty)
+        Right (lang, x) -> (mempty, MergeHashMap $ HashMap.singleton lang x)
+  unless (null errors) . fail $ "Errors occurred while parsing message files:\n" <> indent 2 (unlines $ map show errors)
+
+  let (ambiguous, disambiguated) = flip ifoldMap successes $ \lang x -> case disambiguateMsgFile x of
+        Left errs -> ([(lang, errs)], mempty)
+        Right x'  -> (mempty, HashMap.singleton lang x')
+      ambiguousError (lang, (ambigDefs, ambigVars)) = "Language " <> unpack lang <> ":\n" <> unlines errs
+        where
+          errs = bool (pure $ "Duplicate message definitions:\n" <> indent 1 (unlines ambigDefsErrs)) [] (InsOrdHashSet.null ambigDefs)
+              ++ bool (pure $ "Duplicate variable names:\n" <> indent 1 (unlines ambigVarsErrs)) [] (InsOrdHashMap.null ambigVars)
+          ambigDefsErrs = InsOrdHashSet.toList ambigDefs
+          ambigVarsErrs = map (\(defn, InsOrdHashSet.toList -> vars) -> defn <> ": " <> intercalate ", " vars) $ InsOrdHashMap.toList ambigVars
+  unless (null ambiguous) . fail . indent' 2 . unlines $ map ambiguousError ambiguous
+
+  defMsgFile <- case HashMap.lookup defLang disambiguated of
+    Nothing -> fail $ "Default language (" <> unpack defLang <> ") not found; found instead: " <> intercalate ", " (unpack <$> HashMap.keys disambiguated)
+    Just x  -> return x
+
+  let allDefns = insOrdHashMapKeysSet $ msgFileContent defMsgFile
+      extraDefns = flip HashMap.mapMaybe disambiguated $ \MsgFile{..} -> assertM' (not . HashSet.null) $ insOrdHashMapKeysSet msgFileContent `HashSet.difference` allDefns
+      extraDefnsErrs = flip map (HashMap.toList extraDefns) $ \(lang, extra) -> "Language " <> unpack lang <> ":\n" <> indent 1 (intercalate ", " $ HashSet.toList extra)
+  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
+      typedDefMsgFile <- case ensureTypesMsgFile defMsgFile of
+        Left untypedVars -> fail $ "Default language (" <> unpack defLang <> ") contains untyped variables:\n" <> indent 2 (unlines . flip map (InsOrdHashMap.toList $ InsOrdHashSet.toList <$> untypedVars) $ \(defn, vs) -> defn <> ": " <> intercalate ", " vs)
+        Right x -> return x
+      
+      let
+        datCons :: [TH.ConQ]
+        datCons = flip foldMap (InsOrdHashMap.toList $ msgFileContent typedDefMsgFile) $ \(defn, Identity MsgDef{ msgDefVars }) ->
+          pure . TH.normalC (defnName defn) . flip foldMap (InsOrdHashMap.toList msgDefVars) $ \(_, Identity (Identity varT)) ->
+            pure . TH.bangType (TH.bang TH.noSourceUnpackedness TH.sourceStrict) $ return varT
+        
+      tellMPoint $ TH.dataD (TH.cxt []) datName [] Nothing datCons []
+
+    renderLangs <- iforM disambiguated $ \lang MsgFile{..} -> do
+      let missing = allDefns `HashSet.difference` insOrdHashMapKeysSet msgFileContent
+          complete = HashSet.null missing
+      unless complete $
+        lift . TH.reportWarning $ "Language " <> unpack lang <> " is not complete, missing:\n" <> indent 2 (unlines $ HashSet.toList missing)
+      funName <- lift $ newUniqueName "renderLang"
+      tellMPoint $ TH.sigD funName [t| $(TH.conT master) -> [Lang] -> $(TH.conT datName) -> $(bool [t|Maybe Text|] [t|Text|] complete) |]
+      masterN <- lift $ TH.newName "_master"
+      langsN <- lift $ TH.newName "_langs"
+      let
+        lamExp :: TH.ExpQ
+        lamExp = TH.lamCaseE $ bool (++ [TH.match TH.wildP (TH.normalB [e|Nothing|]) []]) id complete matches
+          where matches :: [TH.MatchQ]
+                matches = flip map (InsOrdHashMap.toList msgFileContent) $ \(defn, Identity MsgDef{..}) -> do
+                  varns <- flip foldMapM (InsOrdHashMap.toList msgDefVars) $ \(varn, Identity mType) -> InsOrdHashMap.singleton varn . (, mType) <$> TH.newName ("_" <> varn)
+                  let transE :: TH.ExpQ
+                      transE
+                        | Just (x NonEmpty.:| xs) <- NonEmpty.nonEmpty msgDefContent = go x xs
+                        | otherwise = [e|Text.empty|]
+                        where
+                          go' (MsgDefContentLiteral (pack -> t)) = TH.lift (t :: Text) 
+                          go' (MsgDefContentSplice isRec spliceE)
+                            | isRec = [e|renderMessage $(TH.varE masterN) $(TH.varE langsN) $(return $ alphaConv spliceE)|]
+                            | otherwise = [e|toMessage $(return $ alphaConv spliceE)|]
+
+                          go c [] = go' c
+                          go (MsgDefContentLiteral t1) (MsgDefContentLiteral t2 : cs) = go (MsgDefContentLiteral $ t1 <> t2) cs
+                          go c1 (c2:cs) = [e|$(go' c1) `Text.append` $(go c2 cs)|]
+
+                          alphaConv = alphaConvE . Map.fromList . map ((,) <$> views _1 TH.mkName <*> view (_2 . _1)) $ InsOrdHashMap.toList varns
+
+                      defnP :: TH.PatQ
+                      defnP = TH.conP (defnName defn) . map varP $ F.toList varns
+                        where varP (varn, Nothing) = TH.varP varn
+                              varP (varn, Just typ) = TH.sigP (varP (varn, Nothing)) $ return typ
+                  TH.match defnP (TH.normalB $ bool [e|Just $(transE)|] transE complete) []
+      tellMPoint . TH.funD funName . pure $ TH.clause [TH.varP masterN, TH.varP langsN] (TH.normalB lamExp) []
+      tellMPoint $ TH.pragInlD funName TH.Inlinable TH.FunLike TH.AllPhases
+      return (complete, funName)
+
+    allRenderers <- lift $ newUniqueName "langRendereres"
+    tellMPoint $ TH.sigD allRenderers [t|HashMap Lang (Either ($(TH.conT master) -> [Lang] -> $(TH.conT datName) -> Maybe Text) ($(TH.conT master) -> [Lang] -> $(TH.conT datName) -> Text))|]
+    let allRenderers' = TH.listE . flip map (HashMap.toList renderLangs) $ \(lang, (complete, funName)) -> [e|($(TH.lift lang), $(bool [e|Left|] [e|Right|] complete) $(TH.varE funName))|]
+     in tellMPoint . TH.funD allRenderers . pure $ TH.clause [] (TH.normalB [e|HashMap.fromList $(allRenderers')|]) []
+    tellMPoint $ TH.pragInlD allRenderers TH.NoInline TH.FunLike TH.AllPhases
+
+    let defRender = views _2 TH.varE $ HashMap.findWithDefault (error "could not find default language in renderLangs") defLang renderLangs
+     in tellMPoint . TH.instanceD (TH.cxt []) [t|RenderMessage $(TH.conT master) $(TH.conT datName)|] . pure $
+          TH.funD 'renderMessage . pure $
+             TH.clause [] (TH.normalB [e|renderMessageDispatch $(TH.lift defLang) $(defRender) $(TH.varE allRenderers)|]) []
+  where
+    indent, indent' :: Int -> String -> String
+    indent n = unlines . map (replicate (4 * n) ' ' <>) . lines
+    indent' n = unlines . over (_tail . traverse) (replicate (4 * n) ' ' <>) . lines
+
+parseMsgFile :: FilePath -> ExceptT P.ParseError IO (Lang, MsgFile NonEmpty Maybe)
+parseMsgFile fPath = do
+  let msgFileLang = pack $ takeBaseName fPath
+  msgFileContent <- either throwE return <=< liftIO $ P.parseFromFile (pMsgFile <* P.eof) fPath
+  return (msgFileLang, MsgFile{..})
+
+pMsgFile, pMsgLine :: P.Parser (InsOrdHashMap String (NonEmpty (MsgDef NonEmpty Maybe)))
+pMsgFile = flip P.label ".msg file" . fmap unionsInsOrdHashMap $ pMsgLine `P.sepEndBy` P.try (P.many1 P.endOfLine)
+pMsgLine = flip P.label ".msg line" $ do
+  spaces
+  P.choice
+    [ flip P.label "comment line" $ InsOrdHashMap.empty <$ P.char '#' <* P.manyTill P.anyChar (P.lookAhead . P.try $ void P.endOfLine <|> P.eof)
+    , flip P.label "empty line" $ InsOrdHashMap.empty <$ P.try P.endOfLine
+    , flip P.label "message line" $ do
+        constrBase <- (:) <$> P.upper <*> P.many (P.upper <|> P.lower <|> P.digit <|> P.char '\'')
+        msgDefVars <- P.option InsOrdHashMap.empty $ do
+          P.skipMany1 P.space
+          accumInsOrdHashMap <$> P.sepEndBy pMsgDefVar (P.many1 P.space)
+        spaces
+        void $ P.char ':'
+        spaces
+        msgDefContent <- P.manyTill pMsgDefContent . P.lookAhead . P.try $ void P.endOfLine <|> P.eof
+        return . InsOrdHashMap.singleton constrBase $ (NonEmpty.:| []) MsgDef{..}
+    ]
+
+pMsgDefVar :: P.Parser (String, Maybe TH.Type)
+pMsgDefVar = do
+  varBase <- (:) <$> P.lower <*> P.many (P.upper <|> P.lower <|> P.digit <|> P.char '\'')
+  varTyp <- P.optionMaybe $
+       P.char '@'
+    *> parseToSeparator Meta.parseType (fmap pure $ P.char ':' <|> P.space)
+  return (varBase, varTyp)
+
+pMsgDefContent :: P.Parser MsgDefContent
+pMsgDefContent = flip P.label "message definition content" $ choice
+  [ MsgDefContentLiteral . pure <$ P.char '\\' <*> (P.char '_' <|> P.char '#' <|> P.char '\\')
+  , do
+      isRecurse <- P.try $
+            (True  <$ P.string "_{")
+        <|> (False <$ P.string "#{")
+      spliceExp <- parseToSeparator Meta.parseExp (pure <$> P.char '}')
+      void $ P.char '}'
+      return $ MsgDefContentSplice isRecurse spliceExp
+  , MsgDefContentLiteral <$> many1Till P.anyChar (P.lookAhead . P.try $ void (P.char '_') <|> void (P.char '#') <|> void P.endOfLine <|> P.eof)
+  ]
+  
+parseToSeparator :: (String -> Either String a) -> P.Parser String -> P.Parser a
+parseToSeparator innerP sepP = do
+  w <- many1Till P.anyChar $ P.lookAhead endOfWord
+  let cont mErrStr = do
+        endStr <- endOfWord
+        case endStr of
+          Nothing -> maybe mzero fail mErrStr
+          Just sepStr -> parseToSeparator (innerP . ((w <> sepStr) <>)) sepP
+  case innerP w of
+    Right res   -> return res
+               <|> cont Nothing
+    Left errStr -> cont $ Just errStr
+  where
+    endOfWord = (Just    <$> P.try sepP       )
+            <|> (Nothing <$  P.try P.endOfLine)
+  
+
+many1Till :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m end -> P.ParsecT s u m [a]
+many1Till p end = (:) <$> p <*> P.manyTill p end
+
+notLookAhead :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m not -> P.ParsecT s u m a
+notLookAhead p n = do
+  followingNot <- (True <$ P.lookAhead n) <|> pure False
+  bool p mzero followingNot
+
+spaces :: P.Parser ()
+spaces = P.skipMany $ notLookAhead P.space P.endOfLine
+
+-- | Stolen from Richard Eisenberg: <https://gitlab.haskell.org/ghc/ghc/-/issues/13054>
+newUniqueName :: TH.Quasi q => String -> q TH.Name
+newUniqueName str = do
+  n <- TH.qNewName str
+  TH.qNewName $ show n
diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs
index fcd7cecbc..afa50f03e 100644
--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@@ -22,6 +22,7 @@ import ClassyPrelude.Yesod    as Import
          , sinkFile, sourceFile
          , defaultYesodMiddleware
          , authorizationCheck
+         , mkMessage
          )
 
 import UnliftIO.Async.Utils as Import
diff --git a/src/Utils/Lang.hs b/src/Utils/Lang.hs
index 09a076fdb..4a5f948f6 100644
--- a/src/Utils/Lang.hs
+++ b/src/Utils/Lang.hs
@@ -21,6 +21,8 @@ import qualified Network.Wai.Parse as NWP
 import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Reader.Class (local)
 
+import qualified Data.HashMap.Strict as HashMap
+
 
 selectLanguage :: MonadHandler m
                => NonEmpty Lang -- ^ Available translations, first is default
@@ -71,3 +73,23 @@ languagesMiddleware avL act = do
   let langs = toList $ selectLanguages avL pLangs
       setLangs hData = hData{ handlerRequest = (handlerRequest hData){ reqLangs = langs } }
   local setLangs $ ($logDebugS "languages" . tshow . (pLangs,langs,) =<< languages) *> act
+
+
+renderMessageDispatch :: forall msg site.
+                         Lang -- ^ Default language
+                      -> (site -> [Lang] -> msg -> Text) -- ^ Default renderer
+                      -> HashMap Lang (Either (site -> [Lang] -> msg -> Maybe Text) (site -> [Lang] -> msg -> Text)) -- ^ All renderers
+                      -> site -> [Lang] -> msg -> Text
+renderMessageDispatch defLang defRender extraRenders app langs msg = go $ selectLanguages avLangs langs
+  where
+    avLangs = defLang :| HashMap.keys extraRenders
+
+    go (l :| []) = case HashMap.lookup l extraRenders of
+      Nothing -> defRender app langs msg
+      Just (Left pRender) -> fromMaybe (defRender app langs msg) $ pRender app langs msg
+      Just (Right tRender) -> tRender app langs msg
+    go (l1 :| l2 : ls) = case HashMap.lookup l1 extraRenders of
+      Nothing -> go (l2 :| ls)
+      Just (Left pRender) -> fromMaybe (go $ l2 :| ls) $ pRender app langs msg
+      Just (Right tRender) -> tRender app langs msg
+{-# INLINE renderMessageDispatch #-}
diff --git a/src/Utils/TH/AlphaConversion.hs b/src/Utils/TH/AlphaConversion.hs
new file mode 100644
index 000000000..d380f997d
--- /dev/null
+++ b/src/Utils/TH/AlphaConversion.hs
@@ -0,0 +1,71 @@
+module Utils.TH.AlphaConversion
+  ( alphaConvE
+  ) where
+
+import Import.NoModel
+  
+import Language.Haskell.TH
+
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+
+alphaConvE :: Map Name Name -> Exp -> Exp
+alphaConvE ns = alphaConvE' Set.empty
+  where
+    alphaConvE' bound = \case
+      VarE varn
+        | Just varn' <- Map.lookup varn $ ns `Map.withoutKeys` bound
+          -> VarE varn'
+      o@(VarE _) -> o
+      o@(ConE _) -> o
+      o@(LitE _) -> o
+      AppE f x -> AppE (alphaConvE' bound f) (alphaConvE' bound x)
+      AppTypeE f t -> AppTypeE (alphaConvE' bound f) t
+      InfixE mA o mB -> InfixE (alphaConvE' bound <$> mA) (alphaConvE' bound o) (alphaConvE' bound <$> mB)
+      UInfixE a o b -> UInfixE (alphaConvE' bound a) (alphaConvE' bound o) (alphaConvE' bound b)
+      ParensE e -> ParensE $ alphaConvE' bound e
+      LamE ps e -> LamE ps $ alphaConvE' (bound `Set.union` foldMap pVars ps) e
+      LamCaseE _ -> error "alphaConvE: LamCaseE not implemented"
+      TupE es -> TupE $ over (traverse . _Just) (alphaConvE' bound) es
+      UnboxedTupE es -> UnboxedTupE $ over (traverse . _Just) (alphaConvE' bound) es
+      UnboxedSumE e sAlt sAry -> UnboxedSumE (alphaConvE' bound e) sAlt sAry
+      CondE i t e -> CondE (alphaConvE' bound i) (alphaConvE' bound t) (alphaConvE' bound e)
+      MultiIfE _ -> error "alphaConvE: MultiIfE not implemented"
+      LetE _ _ -> error "alphaConvE: LetE not implemented"
+      CaseE _ _ -> error "alphaConvE: CaseE not implemented"
+      DoE _ -> error "alphaConvE: DoE not implemented"
+      MDoE _ -> error "alphaConvE: MDoE not implemented"
+      CompE _ -> error "alphaConvE: CompE not implemented"
+      ArithSeqE (FromR e) -> ArithSeqE . FromR $ alphaConvE' bound e
+      ArithSeqE (FromThenR e1 e2) -> ArithSeqE $ FromThenR (alphaConvE' bound e1) (alphaConvE' bound e2)
+      ArithSeqE (FromToR e1 e2) -> ArithSeqE $ FromToR (alphaConvE' bound e1) (alphaConvE' bound e2)
+      ArithSeqE (FromThenToR e1 e2 e3) -> ArithSeqE $ FromThenToR (alphaConvE' bound e1) (alphaConvE' bound e2) (alphaConvE' bound e3)
+      ListE es -> ListE $ map (alphaConvE' bound) es
+      SigE e t -> SigE (alphaConvE' bound e) t
+      RecConE rN es -> RecConE rN $ over (traverse . _2) (alphaConvE' bound) es
+      RecUpdE e es -> RecUpdE (alphaConvE' bound e) $ over (traverse . _2) (alphaConvE' bound) es
+      StaticE e -> StaticE $ alphaConvE' bound e
+      o@(UnboundVarE _) -> o
+      o@(LabelE _) -> o
+      o@(ImplicitParamVarE _) -> o
+
+pVars :: Pat -> Set Name
+pVars = \case
+  LitP _            -> Set.empty
+  VarP n            -> Set.singleton n
+  TupP ps           -> foldMap pVars ps
+  UnboxedTupP ps    -> foldMap pVars ps
+  UnboxedSumP p _ _ -> pVars p
+  ConP _ ps         -> foldMap pVars ps
+  InfixP p1 _ p2    -> pVars p1 `Set.union` pVars p2
+  UInfixP p1 _ p2   -> pVars p1 `Set.union` pVars p2
+  ParensP p         -> pVars p
+  TildeP p          -> pVars p
+  BangP p           -> pVars p
+  AsP n p           -> Set.insert n $ pVars p
+  WildP             -> Set.empty
+  RecP _ ps         -> foldMapOf (folded . _2) pVars ps
+  ListP ps          -> foldMap pVars ps
+  SigP p _          -> pVars p
+  ViewP _ p         -> pVars p