diff --git a/frontend/src/utils/inputs/checkbox.js b/frontend/src/utils/inputs/checkbox.js index e93c88856..6f52ea3ae 100644 --- a/frontend/src/utils/inputs/checkbox.js +++ b/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 { diff --git a/frontend/src/utils/inputs/checkbox.scss b/frontend/src/utils/inputs/checkbox.scss index 5dc0c9995..817aa5f3a 100644 --- a/frontend/src/utils/inputs/checkbox.scss +++ b/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; diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index aef920e2b..825036b04 100644 --- a/messages/uniworx/de.msg +++ b/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? \ No newline at end of file +ShowSexTip: Sollen in Kursteilnehmer-Tabellen u.Ä. die Geschlechter der Nutzer angezeigt werden? + +MenuLanguage: Sprache +LanguageChanged: Sprache erfolgreich geändert \ No newline at end of file diff --git a/messages/uniworx/en.msg b/messages/uniworx/en.msg new file mode 100644 index 000000000..c6e1dc4ad --- /dev/null +++ b/messages/uniworx/en.msg @@ -0,0 +1,2 @@ +MenuLanguage: Language +LanguageChanged: Language changed successfully \ No newline at end of file diff --git a/package.yaml b/package.yaml index 45137e732..e002f165f 100644 --- a/package.yaml +++ b/package.yaml @@ -140,6 +140,7 @@ dependencies: - retry - generic-lens - array + - cookie other-extensions: - GeneralizedNewtypeDeriving diff --git a/routes b/routes index 582834521..b64e379b5 100644 --- a/routes +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index 4b54a9fd1..9294d7d8e 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index fbb3093cf..7b9f922b1 100644 --- a/src/Handler/Profile.hs +++ b/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"] diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index eb212bc1a..52024081d 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -228,6 +228,7 @@ data FormIdentifier | FIDAssignSubmissions | FIDUserAuthMode | FIDAllUsersAction + | FIDLanguage deriving (Eq, Ord, Read, Show) instance PathPiece FormIdentifier where diff --git a/src/Utils/Lang.hs b/src/Utils/Lang.hs index a8ebe1878..da8eafcda 100644 --- a/src/Utils/Lang.hs +++ b/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 diff --git a/templates/widgets/navbar/navbar.hamlet b/templates/widgets/navbar/navbar.hamlet index 966223643..77e1184a9 100644 --- a/templates/widgets/navbar/navbar.hamlet +++ b/templates/widgets/navbar/navbar.hamlet @@ -7,7 +7,8 @@ $newline never $# manually add favorites to navbar for small screens
  • - +
    +
    _{MsgNavigationFavourites} $forall (menuItem@MenuItem{menuItemType, menuItemRoute, menuItemModal}, menuIdent, _) <- menuTypes @@ -36,3 +37,12 @@ $newline never $else ^{navbarItem (menuItem, menuIdent)} $of _ +
  • + +
    + ^{langFormView'} +
    +