3 files changed, 56 insertions(+), 3 deletions(-)

M hurl.cabal
M src/Network/URI/Fetch.hs
A src/Network/URI/Locale.hs

@@ 82,7 82,8 @@ library
   
   if flag(http)
     CPP-options:   -DWITH_HTTP_URI
-    build-depends: http-client >= 0.6 && <0.7, http-types >= 0.12 && <0.13
+    build-depends: http-client >= 0.6 && <0.7, http-types >= 0.12 && <0.13,
+                   http-client-tls >= 0.3 && <0.4
   if flag(file)
     CPP-options:   -DWITH_FILE_URI
   if flag(data)

@@ 1,6 1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Network.URI.Fetch(fetchURL) where
+module Network.URI.Fetch(Session(..), newSession, fetchURL) where
 import qualified Data.Text as Txt
 import           Data.Text (Text)
 import           Network.URI


@@ 9,6 9,7 @@ import qualified Data.ByteString.Lazy as B
 
 #ifdef WITH_HTTP_URI
 import qualified Network.HTTP.Client as HTTP
+import qualified Network.HTTP.Client.TLS as TLS
 import           Network.HTTP.Types
 import           Network.URI.Charset
 import           Data.List (intercalate)


@@ 19,12 20,28 @@ import qualified Data.ByteString.Char8 as C8
 import qualified Data.ByteString.Base64 as B64
 #endif
 
+import Network.URI.Locale
+
 data Session = Session {
+    locale :: [String],
 #ifdef WITH_HTTP_URI
     managerHTTP :: HTTP.Manager
 #endif
 }
 
+newSession :: IO Session
+newSession = do
+    locale' <- rfc2616Locale
+#ifdef WITH_HTTP_URI
+    managerHTTP' <- HTTP.newManager TLS.tlsManagerSettings
+#endif
+    return Session {
+        locale = locale',
+#ifdef WITH_HTTP_URI
+        managerHTTP = managerHTTP'
+#endif
+    }
+
 fetchURL :: Session -> [String] -> URI -> IO (String, Either Text ByteString)
 #ifdef WITH_HTTP_URI
 fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "https:"] = do


@@ 32,7 49,8 @@ fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "ht
     response <- HTTP.httpLbs request {
             HTTP.cookieJar = Nothing, -- Will only be supported by Rhapsode when submitting a form.
             HTTP.requestHeaders = [
-                ("Accept", C8.pack $ intercalate ", " accept)
+                ("Accept", C8.pack $ intercalate ", " accept),
+                ("Accept-Language", C8.pack $ intercalate ", " $ locale session)
             ]
         } $ managerHTTP session
     return $ case (

@@ 0,0 1,34 @@
+module Network.URI.Locale(rfc2616Locale) where
+
+import System.Environment (lookupEnv)
+import Control.Monad (forM)
+import Data.Maybe (mapMaybe)
+import Data.Char (toLower)
+
+--- This file is based on logic in GNOME's LibSoup & GLib.
+
+rfc2616Locale :: IO [String]
+rfc2616Locale = do
+    locales <- forM ["LANGUAGE", "LC_ALL", "LC_MESSAGES", "LANG"] lookupEnv
+    return $ mapMaybe toRFC2616Lang $ split ':' $ firstJust locales "en_US"
+
+toRFC2616Lang "C" = Nothing
+toRFC2616Lang ('C':'.':_) = Nothing
+toRFC2616Lang ('C':'@':_) = Nothing
+toRFC2616Lang lang = case toRFC2616Lang' lang of
+    "" -> Nothing
+    lang' -> Just lang'
+
+toRFC2616Lang' ('_':cs) = '-' : toRFC2616Lang' cs
+toRFC2616Lang' ('.':_) = []
+toRFC2616Lang' ('@':_) = []
+toRFC2616Lang' (c:cs) = toLower c : toRFC2616Lang' cs
+toRFC2616Lang' [] = []
+
+firstJust (Just a:_) _ | a /= "" = a
+firstJust (_:maybes) fallback = firstJust maybes fallback
+firstJust [] fallback = fallback
+
+split b (a:as) | a == b = [] : split b as
+        | (head':tail') <- split b as = (a:head') : tail'
+split _ [] = [[]]