fastcgi server: add /mylanguage resource, which selects the language that best matches the Accept-language header.

src/server/MainFastCGI.hs

@@ -38,6 +38,7 @@ cgiMain pgf =
          "/translate"      -> return (doTranslate pgf) `ap` getText `ap` getCat `ap` getFrom `ap` getTo
          "/categories"     -> return $ doCategories pgf
          "/languages"      -> return $ doLanguages pgf
+         "/mylanguage"     -> return (doMyLanguage pgf) `ap` requestAcceptLanguage
          _                 -> throwCGIError 404 "Not Found" ["Resource not found: " ++ path]
        outputJSON json
   where
@@ -112,6 +113,8 @@ doCategories :: PGF -> JSValue
 doCategories pgf = showJSON $ map toJSObject
       [[("cat",cat)] | cat <- PGF.categories pgf]
 
+doMyLanguage :: PGF -> Maybe (Accept Language) -> JSValue
+doMyLanguage pgf macc = showJSON $ toJSObject [("languageName", selectLanguage pgf macc)]
 
 -- * PGF utilities
 
@@ -147,6 +150,18 @@ linearize' pgf mto tree =
       Nothing -> PGF.linearizeAllLang pgf tree
       Just to -> [(to,PGF.linearize pgf to tree)]
 
+selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language
+selectLanguage pgf macc = case acceptable of
+                            []  -> case PGF.languages pgf of
+                                     []  -> "" -- FIXME: error?
+                                     l:_ -> l
+                            Language c:_ -> fromJust (langCodeLanguage pgf c)
+  where langCodes = mapMaybe (PGF.languageCode pgf) (PGF.languages pgf)
+        acceptable = negotiate (map Language langCodes) macc
+
+langCodeLanguage :: PGF -> String -> Maybe PGF.Language
+langCodeLanguage pgf code = listToMaybe [l | l <- PGF.languages pgf, PGF.languageCode pgf l == Just code]
+
 -- * General CGI and JSON stuff
 
 outputJSON :: JSON a => a -> CGI CGIResult

src/server/gf-server.cabal

@@ -12,11 +12,11 @@ executable gf.fcgi
                  unix,
                  directory,
                  containers,
-                 gf,
+                 gf >= 3.0,
-                 cgi,
+                 cgi >= 3001.1.7.0,
-                 fastcgi,
+                 fastcgi >= 3001.0.2.1,
-                 json,
+                 json >= 0.3.3,
-                 utf8-string
+                 utf8-string >= 0.3.1.1
   main-is: MainFastCGI.hs
   other-modules:
     FastCGIUtils