From 417ada31f54e04e01e30ab111dbba95b6d7413bf Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Wed, 17 Sep 2008 12:22:17 +0000
Subject: [PATCH] fastcgi server: add /mylanguage resource, which selects the
 language that best matches the Accept-language header.

---
 src/server/MainFastCGI.hs  | 15 +++++++++++++++
 src/server/gf-server.cabal | 10 +++++-----
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/src/server/MainFastCGI.hs b/src/server/MainFastCGI.hs
index a769e23e0..181af7836 100644
--- a/src/server/MainFastCGI.hs
+++ b/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
diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal
index 67935e491..afbad3283 100644
--- a/src/server/gf-server.cabal
+++ b/src/server/gf-server.cabal
@@ -12,11 +12,11 @@ executable gf.fcgi
                  unix,
                  directory,
                  containers,
-                 gf,
-                 cgi,
-                 fastcgi,
-                 json,
-                 utf8-string
+                 gf >= 3.0,
+                 cgi >= 3001.1.7.0,
+                 fastcgi >= 3001.0.2.1,
+                 json >= 0.3.3,
+                 utf8-string >= 0.3.1.1
   main-is: MainFastCGI.hs
   other-modules:
     FastCGIUtils