imp: web: --lang sets the language of every page

hledger-web/Hledger/Web/App.hs

@@ -142,14 +142,16 @@ instance Yesod App where
     here <- fromMaybe RootR <$> getCurrentRoute
     VD{opts, j, qparam, q, qopts, perms, trs} <- getViewData
     msg <- getMessage
-    -- An explicit ?_LANG= choice is remembered in a cookie, which Yesod's
-    -- languages reads on later requests; only a tag naming an available
-    -- catalog is accepted. And since the page varies by language, say so
-    -- for any cache in front of a shared server.
-    mlangparam <- lookupGetParam "_LANG"
-    for_ (mlangparam >>= \l -> resolveLang (M.keys $ appTranslations master) [l]) $ \l ->
-      addHeader "Set-Cookie" $ "_LANG=" <> l <> "; Path=/; Max-Age=31536000; SameSite=Lax"
-    addHeader "Vary" "Cookie, Accept-Language"
+    -- Unless --lang fixes the language: an explicit ?_LANG= choice is
+    -- remembered in a cookie, which Yesod's languages reads on later
+    -- requests; only a tag naming an available catalog is accepted. And
+    -- since the page varies by language, say so for any cache in front of
+    -- a shared server.
+    unless (langFixed master) $ do
+      mlangparam <- lookupGetParam "_LANG"
+      for_ (mlangparam >>= \l -> resolveLang (M.keys $ appTranslations master) [l]) $ \l ->
+        addHeader "Set-Cookie" $ "_LANG=" <> l <> "; Path=/; Max-Age=31536000; SameSite=Lax"
+      addHeader "Vary" "Cookie, Accept-Language"
     let lang = trLang trs
     showSidebar <- shouldShowSidebar
     -- The policy is sent from here rather than from a middleware, so that
@@ -225,15 +227,23 @@ instance Yesod App where
 ----------------------------------------------------------------------
 -- translations
 
--- | The translations for a viewer (as listed
+-- | The translations for a viewer. When hledger-web was started with a
+-- --lang naming a language, that one, whatever the viewer asks for.
+-- Otherwise the first available one in the viewer's preferences (as listed
 -- by Yesod's 'languages': the _LANG query parameter, cookie and session
--- variable, then the Accept-Language header): the first available one,
--- trying each preference with its subtags dropped before moving on to the
--- next. Falls back to the server's --lang.
+-- variable, then the Accept-Language header), trying each preference with
+-- its subtags dropped before moving on to the next; falling back to English,
+-- or with --lang=auto, the language of hledger-web's environment.
 translationsFor :: App -> [Lang] -> Translations
-translationsFor App{appOpts, appTranslations} langs =
-  fromMaybe serverdefault $ (`M.lookup` appTranslations) =<< resolveLang (M.keys appTranslations) langs
-  where serverdefault = translations_ $ _rsReportOpts $ reportspec_ $ cliopts_ appOpts
+translationsFor app@App{appTranslations} langs
+  | langFixed app = servertrs
+  | otherwise = fromMaybe servertrs $ (`M.lookup` appTranslations) =<< resolveLang (M.keys appTranslations) langs
+  where servertrs = translations_ $ _rsReportOpts $ reportspec_ $ cliopts_ $ appOpts app
+
+-- | Was hledger-web started with a --lang naming a language, which then
+-- applies to every page? (--lang=auto leaves the choice to each viewer.)
+langFixed :: App -> Bool
+langFixed = maybe False (/= "auto") . maybestringopt "lang" . rawopts_ . cliopts_ . appOpts
 
 -- | The translations for the current request's language.
 requestTranslations :: Handler Translations

hledger-web/Hledger/Web/Test.hs

@@ -41,7 +41,7 @@ module Hledger.Web.Test (
   hledgerWebTest
 ) where
 
-import Control.Exception (bracket_)
+import Control.Exception (bracket, bracket_)
 import Data.Aeson (encode)
 import Data.ByteString qualified as BS
 import Data.String (fromString)
@@ -55,7 +55,7 @@ import Network.HTTP.Types (HeaderName)
 import Network.Wai.Test (SResponse(..))
 import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removeDirectoryRecursive)
 import System.Entropy (getEntropy)
-import System.Environment (setEnv, unsetEnv)
+import System.Environment (lookupEnv, setEnv, unsetEnv)
 import System.FilePath ((</>))
 import Test.Hspec (describe, expectationFailure, hspec, it, shouldBe)
 import Text.Printf (printf)
@@ -416,6 +416,33 @@ hledgerWebTest = do
       bodyContains "Intervall:"
       bodyContains "title=\"Eine Spalte pro Monat anzeigen\">Monatlich</a>"
 
+  runTests "hledger-web with --lang" [("lang","de")] nulljournal $ do
+
+    yit "uses the --lang language whatever the viewer asks for, setting no language cookie" $ do
+      request $ do
+        setMethod "GET"
+        setUrl (JournalR, [("_LANG", "en")])
+        addRequestHeader ("Accept-Language", "en")
+      statusIs 200
+      bodyContains "lang=\"de\""
+      bodyContains "Buchung hinzufügen"
+      cookies <- headerValues "Set-Cookie"
+      assertEq "no language cookie" (any (T.isInfixOf "_LANG=") cookies) False
+
+  -- With --lang=auto the environment's language is only the fallback,
+  -- here English (LC_ALL=C), so that it can't be mistaken for the viewer's.
+  bracket (lookupEnv "LC_ALL" <* setEnv "LC_ALL" "C") (maybe (unsetEnv "LC_ALL") (setEnv "LC_ALL")) $ \_ ->
+    runTests "hledger-web with --lang=auto" [("lang","auto")] nulljournal $ do
+
+      yit "leaves the language to the viewer" $ do
+        request $ do
+          setMethod "GET"
+          setUrl JournalR
+          addRequestHeader ("Accept-Language", "de")
+        statusIs 200
+        bodyContains "lang=\"de\""
+        bodyContains "Buchung hinzufügen"
+
   -- A translation is viewer-controlled text: it must be rendered as text
   -- wherever it lands, including inside attributes.
   withTempConfigDir $ \xdg -> do

hledger-web/hledger-web.m4.md

@@ -491,15 +491,20 @@ To capture debug output in a log file instead, you can usually redirect stderr,
 
 hledger-web's pages can be shown in another language when a translation catalog is available
 (see [Languages](hledger.md#languages) in the hledger manual).
-The language is chosen per request, and the first of these naming an available translation wins:
+
+When hledger-web is started with `--lang LANG`, eg `--lang de`, every page is in that language,
+whatever the browser asks for.
+So you can use hledger-web in a language other than your browser's,
+or give every user of a shared server the same language.
+
+Otherwise the language is chosen per request, and the first of these naming an available translation wins:
 
 1. a `_LANG` query parameter, eg `?_LANG=de`. This choice is remembered in a `_LANG` cookie.
 2. the `_LANG` cookie
 3. the browser's `Accept-Language` header, ie the browser's or system's language settings
-4. the `--lang` option hledger-web was started with
 
-So viewers usually get their browser's language automatically, if hledger-web has it;
-otherwise English, or the language given with `--lang`.
+If none does, pages are in English, or with `--lang auto`, in the language of hledger-web's environment.
+So viewers usually get their browser's language automatically, if hledger-web has it.
 Catalogs, including any in the config directory, are loaded when hledger-web starts.
 
 # ENVIRONMENT