msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

PGFService: userLanguage now defaults to English, if present in the grammar

Browse Source 
The userLangauge is the name of the concrete syntax that has a languageCode
that matches the user's preferred language, as reported by the web browser.
If no matching language code is found, the PGF service now sets userLanguage
to the concrete syntax for English (e.g. FoodsEng) if present, and defaults
to the first concrete syntax (e.g. FoodsAfr) only if English is not present
in the grammar.
This commit is contained in:
Thomas Hallgren
2019-11-26 15:27:02 +01:00
parent e6b33ac8b8
commit 33aeb53f7a
1 changed files with 14 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/server/PGFService.hs
View File

@@ -39,7 +39,7 @@ import Control.Monad.State(State,evalState,get,put)
import Control.Monad.Catch(bracket_) import Control.Monad.Catch(bracket_)
import Data.Char import Data.Char
--import Data.Function (on) --import Data.Function (on)
import Data.List ({-sortBy,-}intersperse,mapAccumL,nub,isSuffixOf,nubBy) import Data.List ({-sortBy,-}intersperse,mapAccumL,nub,isSuffixOf,nubBy,stripPrefix)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe import Data.Maybe
import System.Random import System.Random
@@ -1048,16 +1048,23 @@ linearizeAndUnlex pgf (mto,unlex) tree =
langs = if null mto then PGF.languages pgf else mto langs = if null mto then PGF.languages pgf else mto
selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language
selectLanguage pgf macc = case acceptable of selectLanguage pgf macc =
[] -> case PGF.languages pgf of case acceptable of
[] -> error "No concrete syntaxes in PGF grammar." [] -> case PGF.languages pgf of
l:_ -> l [] -> error "No concrete syntaxes in PGF grammar."
Language c:_ -> fromJust (langCodeLanguage pgf c) ls@(l1:_) -> case [l | l<-ls, langPart pgf l==Just "Eng"] of
eng:_ -> eng
_ -> l1
Language c:_ -> fromJust (langCodeLanguage pgf c)
where langCodes = mapMaybe (PGF.languageCode pgf) (PGF.languages pgf) where langCodes = mapMaybe (PGF.languageCode pgf) (PGF.languages pgf)
acceptable = negotiate (map Language langCodes) macc acceptable = negotiate (map Language langCodes) macc
langCodeLanguage :: PGF -> String -> Maybe PGF.Language langCodeLanguage :: PGF -> String -> Maybe PGF.Language
langCodeLanguage pgf code = listToMaybe [l | l <- PGF.languages pgf, PGF.languageCode pgf l == Just code] langCodeLanguage pgf code =
listToMaybe [l | l <- PGF.languages pgf, PGF.languageCode pgf l == Just code]
langPart pgf lang =
stripPrefix (PGF.showCId (PGF.abstractName pgf)) (PGF.showCId lang)
-- * General utilities -- * General utilities