feat(i18n): basic language switching

frontend/src/utils/inputs/checkbox.js

@@ -5,7 +5,7 @@ var CHECKBOX_CLASS = 'checkbox';
 var CHECKBOX_INITIALIZED_CLASS = 'checkbox--initialized';
 
 @Utility({
-  selector: 'input[type="checkbox"]',
+  selector: 'input[type="checkbox"]:not([uw-no-checkbox])',
 })
 export class Checkbox {
 

frontend/src/utils/inputs/checkbox.scss

@@ -1,19 +1,20 @@
 
 /* CUSTOM CHECKBOXES */
 /* Completely replaces legacy checkbox */
+.checkbox [type='checkbox'], #lang-checkbox {
+  position: fixed;
+  top: -1px;
+  left: -1px;
+  width: 1px;
+  height: 1px;
+  overflow: hidden;
+  display: none;
+}
+
 .checkbox {
   position: relative;
   display: inline-block;
 
-  [type='checkbox'] {
-    position: fixed;
-    top: -1px;
-    left: -1px;
-    width: 1px;
-    height: 1px;
-    overflow: hidden;
-  }
-
   label {
     display: block;
     height: 20px;

messages/uniworx/de.msg

@@ -778,6 +778,8 @@ MailTestDateTime: Test der Datumsformattierung:
 
 German: Deutsch
 GermanGermany: Deutsch (Deutschland)
+English: English
+EnglishEurope: English (Europe)
 
 MailSubjectSubmissionRated csh@CourseShorthand: Ihre #{csh}-Abgabe wurde korrigiert
 MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{courseName} (#{termDesc}) wurde korrigiert.
@@ -1979,4 +1981,7 @@ ShortSexFemale: w
 ShortSexNotApplicable: k.A.
 
 ShowSex: Geschlechter anderer Nutzer anzeigen
-ShowSexTip: Sollen in Kursteilnehmer-Tabellen u.Ä. die Geschlechter der Nutzer angezeigt werden?
+ShowSexTip: Sollen in Kursteilnehmer-Tabellen u.Ä. die Geschlechter der Nutzer angezeigt werden?
+
+MenuLanguage: Sprache
+LanguageChanged: Sprache erfolgreich geändert

messages/uniworx/en.msg

@@ -0,0 +1,2 @@
+MenuLanguage: Language
+LanguageChanged: Language changed successfully

package.yaml

@@ -140,6 +140,7 @@ dependencies:
   - retry
   - generic-lens
   - array
+  - cookie
 
 other-extensions:
   - GeneralizedNewtypeDeriving

routes

@@ -73,6 +73,7 @@
 /user/authpreds            AuthPredsR          GET POST        !free
 /user/set-display-email    SetDisplayEmailR    GET POST        !free
 /user/csv-options          CsvOptionsR         GET POST        !free
+/user/lang                 LangR                   POST        !free
 
 /exam-office               ExamOfficeR                         !exam-office:
   /                        EOExamsR            GET

src/Foundation.hs

@@ -72,6 +72,7 @@ import Utils.SystemMessage
 import Text.Shakespeare.Text (st)
 
 import Yesod.Form.I18n.German
+import Yesod.Form.I18n.English
 import qualified Yesod.Auth.Message as Auth
 
 import qualified Data.Conduit.List as C
@@ -257,11 +258,6 @@ mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de"
 mkMessageVariant "UniWorX" "Button" "messages/button" "de"
 mkMessageVariant "UniWorX" "Frontend" "messages/frontend" "de"
 
--- 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 _ _  = germanFormMessage -- TODO
-
 instance RenderMessage UniWorX TermIdentifier where
   renderMessage foundation ls TermIdentifier{..} = case season of
     Summer -> renderMessage' $ MsgSummerTerm year
@@ -304,6 +300,8 @@ instance RenderMessage UniWorX MsgLanguage where
   renderMessage foundation ls (MsgLanguage lang@(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 ls
@@ -511,13 +509,13 @@ instance Button UniWorX ButtonSubmit where
 
 
 getTimeLocale' :: [Lang] -> TimeLocale
-getTimeLocale' = $(timeLocaleMap [("de", "de_DE.utf8")])
+getTimeLocale' = $(timeLocaleMap [("de", "de_DE.utf8"), ("en", "en_IE.utf8")])
 
 appTZ :: TZ
 appTZ = $(includeSystemTZ "Europe/Berlin")
 
 appLanguages :: NonEmpty Lang
-appLanguages = "de-DE" :| []
+appLanguages = "de" :| ["en"]
 
 appLanguagesOpts :: ( MonadHandler m
                     , HandlerSite m ~ UniWorX
@@ -533,6 +531,13 @@ appLanguagesOpts = do
       langOptions = map mkOption $ toList appLanguages
   return $ mkOptionList langOptions
 
+-- 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 = case lang of
+      ("en" : _) -> englishFormMessage
+      _other     -> germanFormMessage
+      where lang = Text.splitOn "-" $ selectLanguage' appLanguages ls
 
 instance RenderMessage UniWorX WeekDay where
   renderMessage _ ls wDay = pack $ map fst (wDays $ getTimeLocale' ls) !! fromEnum wDay
@@ -1683,6 +1688,17 @@ instance Yesod UniWorX where
     makeLogger = readTVarIO . snd . appLogger
 
 
+langForm :: Form (Lang, Route UniWorX)
+langForm csrf = do
+  lang <- selectLanguage appLanguages
+  route <- getCurrentRoute
+  (urlRes, urlView) <- mreq hiddenField ("" & addName ("referer" :: Text)) route
+  (langBoxRes, langBoxView) <- mreq
+    (selectField appLanguagesOpts)
+    ("" & addAttr "multiple" "multiple" & addAttr "size" (tshow . min 10 $ length appLanguages) & addAutosubmit & addName ("lang" :: Text))
+    (Just lang)
+  return ((,) <$> langBoxRes <*> urlRes, toWidget csrf <> fvInput urlView <> fvInput langBoxView)
+
 siteLayoutMsg :: (RenderMessage site msg, site ~ UniWorX) => msg -> Widget -> Handler Html
 siteLayoutMsg msg widget = do
   mr <- getMessageRender
@@ -1785,6 +1801,13 @@ siteLayout' headingOverride widget = do
           \authTag -> addMessageWidget Info $ msgModal [whamlet|_{MsgUnauthorizedDisabledTag authTag}|] (Left $ SomeRoute (AuthPredsR, catMaybes [(toPathPiece GetReferer, ) . toPathPiece <$> mcurrentRoute]))
         getMessages
 
+  (langFormView, langFormEnctype) <- generateFormPost $ identifyForm FIDLanguage langForm
+  let langFormView' = wrapForm langFormView def
+        { formAction = Just $ SomeRoute LangR
+        , formSubmit = FormAutoSubmit
+        , formEncoding = langFormEnctype
+        }
+
   let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
       highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
                       navItems = map (view _2) favourites ++ map (urlRoute . menuItemRoute . view _1) menuTypes
@@ -3681,7 +3704,10 @@ instance YesodAuth UniWorX where
       addMessage Error $ toHtml msg
       redirect dest
 
-    renderAuthMessage _ _ = Auth.germanMessage -- TODO
+    renderAuthMessage _ ls = case lang of
+      ("en" : _) -> Auth.englishMessage
+      _other     -> Auth.germanMessage
+      where lang = Text.splitOn "-" $ selectLanguage' appLanguages ls
 
 instance YesodAuthPersist UniWorX
 

src/Handler/Profile.hs

@@ -5,6 +5,7 @@ module Handler.Profile
   , getUserNotificationR, postUserNotificationR
   , getSetDisplayEmailR, postSetDisplayEmailR
   , getCsvOptionsR, postCsvOptionsR
+  , postLangR
   ) where
 
 import Import
@@ -22,11 +23,15 @@ import qualified Data.Set as Set
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 -- import           Database.Esqueleto      ((^.))
+import qualified Data.Text as Text
+import Data.List (inits)
 
 import qualified Data.CaseInsensitive as CI
 
 import Jobs
 
+import Web.Cookie
+
 
 data SettingsForm = SettingsForm
       { stgDisplayName          :: UserDisplayName
@@ -837,3 +842,24 @@ postCsvOptionsR = do
       , formEncoding = optionsEnctype
       , formAttrs = [ asyncSubmitAttr | isModal ]
       }
+
+postLangR :: Handler ()
+postLangR = do
+  ((langRes, _), _) <- runFormPost $ identifyForm FIDLanguage langForm
+
+  now <- liftIO getCurrentTime
+  formResult langRes $ \(lang, route) -> do
+    setCookie $ def
+      { setCookieName    = "_LANG"
+      , setCookieValue   = encodeUtf8 lang
+      , setCookieExpires = Just $ addUTCTime (400 * avgNominalYear) now
+      }
+    setLanguage lang
+    -- TODO: Write to user
+
+    app <- getYesod
+    let mr = renderMessage app . map (Text.intercalate "-") . reverse . inits $ Text.splitOn "-" lang
+    addMessage Success . toHtml $ mr MsgLanguageChanged
+    redirect route
+
+  invalidArgs ["Language form required"]

src/Utils/Form.hs

@@ -228,6 +228,7 @@ data FormIdentifier
   | FIDAssignSubmissions
   | FIDUserAuthMode
   | FIDAllUsersAction
+  | FIDLanguage
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where

src/Utils/Lang.hs

@@ -6,6 +6,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 
 import qualified Data.Text as Text
+import qualified Data.List as List
 
 
 selectLanguage :: MonadHandler m
@@ -18,13 +19,13 @@ selectLanguage' :: NonEmpty Lang -- ^ Available translations, first is default
                 -> Lang
 selectLanguage' (defL :| _) [] = defL
 selectLanguage' avL (l:ls)
-  | not $ null l
-  , Just l' <- find (== l) (NonEmpty.toList avL)
-  = l'
   | not $ null l
   , Just lParts <- NonEmpty.nonEmpty $ Text.splitOn "-" l
-  , found <- find ((NonEmpty.toList lParts `isPrefixOf`) . Text.splitOn "-") avL
-  = flip fromMaybe found $ selectLanguage' avL $ Text.intercalate "-" (NonEmpty.tail lParts) : ls
+  , found <- [ l' | lParts' <- reverse . List.inits $ NonEmpty.toList lParts
+                  , l' <- NonEmpty.toList avL
+                  , langMatches (Text.intercalate "-" lParts') l'
+                  ]
+  = fromMaybe (selectLanguage' avL ls) $ listToMaybe found
   | otherwise = selectLanguage' avL ls
 
 langMatches :: Lang -- ^ Needle

templates/widgets/navbar/navbar.hamlet

@@ -7,7 +7,8 @@ $newline never
       $# manually add favorites to navbar for small screens
       <li .navbar__list-item.navbar__list-item--favorite>
         <a .navbar__link-wrapper href="#">
-          <i .fas.fa-star>
+          <div .navbar__link-icon>
+            <i .fas .fa-2x .fa-star>
           <div .navbar__link-label>_{MsgNavigationFavourites}
 
       $forall (menuItem@MenuItem{menuItemType, menuItemRoute, menuItemModal}, menuIdent, _) <- menuTypes
@@ -36,3 +37,12 @@ $newline never
               $else
                 ^{navbarItem (menuItem, menuIdent)}
           $of _
+      <li .navbar__list-item--lang-wrapper>
+        <input type="checkbox" id="lang-checkbox" uw-no-checkbox>
+        <div id="lang-dropdown">
+          ^{langFormView'}
+        <div .navbar__list-item .navbar__list-item--language>
+          <label .navbar__link-wrapper for="lang-checkbox">
+            <div .navbar__link-icon>
+              <i .fas .fa-2x .fa-flag>
+            <div .navbar__link-label>_{MsgMenuLanguage}

templates/widgets/navbar/navbar.lucius

@@ -68,14 +68,7 @@
   color: var(--color-lightwhite);
   transition: height .2s cubic-bezier(0.03, 0.43, 0.58, 1);
   overflow: hidden;
-
-  &:hover {
-    color: var(--color-lightwhite);
-
-    .navbar__link-icon {
-      opacity: 1;
-    }
-  }
+  cursor: pointer;
 }
 
 .navbar__link-icon {
@@ -88,6 +81,7 @@
   transition: opacity .2s ease;
   padding: 2px 4px;
   text-transform: uppercase;
+  font-weight: 600;
 }
 
 @media (min-width: 769px) {
@@ -146,7 +140,9 @@
 .navbar__list-item {
   position: relative;
   transition: background-color .1s ease;
-
+  &:not(.navbar__list-item--favorite) + .navbar__list-item--lang-wrapper {
+    margin-left: 12px;
+  }
   &:not(.navbar__list-item--favorite) + .navbar__list-item {
     margin-left: 12px;
   }
@@ -160,6 +156,9 @@
     &:not(.navbar__list-item--favorite) + .navbar__list-item {
       margin-left: 0;
     }
+    &:not(.navbar__list-item--favorite) + .navbar__list-item--lang-wrapper {
+      margin-left: 0;
+    }
   }
 }
 
@@ -219,9 +218,13 @@
   color: var(--color-dark);
 }
 
-.navbar .navbar__list-item:not(.navbar__list-item--active):not(.navbar__list-item--favorite):hover .navbar__link-wrapper {
+.navbar .navbar__list-item:not(.navbar__list-item--active):not(.navbar__list-item--favorite):hover .navbar__link-wrapper, #lang-checkbox:checked ~ * .navbar__link-wrapper {
   background-color: var(--color-dark);
   color: var(--color-lightwhite);
+
+  .navbar__link-icon {
+    opacity: 1;
+  }
 }
 
 /* sticky state */
@@ -267,3 +270,36 @@
     height: var(--header-height-collapsed);
   }
 }
+
+
+#lang-dropdown {
+    display: none;
+
+    position: fixed;
+    top: var(--header-height);
+    right: 0;
+    min-width: 200px;
+    z-index: 10;
+    background-color: white;
+    border-radius: 2px;
+    box-shadow: 0 0 10px rgba(0,0,0,0.3);
+
+    select {
+      display: block;
+    }
+
+    button {
+      display: block;
+      width: 100%;
+    }
+}
+
+#lang-checkbox:checked ~ #lang-dropdown {
+  display: block;
+}
+
+@media (max-width: 768px) {
+    #lang-dropdown {
+      top: var(--header-height-collapsed);
+    }
+}