~alcinnz/hurl

ref: 6370ab8a13697df679fb756e7906a4a6a400337e hurl/src/Network/URI/Locale.hs -rw-r--r-- 1.6 KiB
6370ab8a — Adrian Cochrane Draft AppStream loading code. 4 years ago
                                                                                
e0988f7e Adrian Cochrane
c72f07c9 Adrian Cochrane
e0988f7e Adrian Cochrane
c72f07c9 Adrian Cochrane
47f9ef33 Adrian Cochrane
c72f07c9 Adrian Cochrane
47f9ef33 Adrian Cochrane
c72f07c9 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
-- | Internal module for retrieving languages to localize to.
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.

-- | Returns the languages to which responses should be localized.
-- Retrieved from Gettext configuration & reformatted for use in the
-- HTTP Accept-Language request header.
rfc2616Locale :: IO [String]
rfc2616Locale = do
    locales <- forM ["LANGUAGE", "LC_ALL", "LC_MESSAGES", "LANG"] lookupEnv
    let locales' = mapMaybe toRFC2616Lang $ split ':' $ firstJust locales "en_US"
    return (locales' ++ [l | l <- extractLangs locales', l `notElem` locales'])

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' [] = []

-- Makes sure to include the raw languages, and not just localized variants.
extractLangs (locale:locales) | (lang:_) <- split '-' locale = lang : extractLangs locales
extractLangs (_:locales) = extractLangs locales
extractLangs [] = []

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 _ [] = [[]]