~alcinnz/hurl

ref: f7a8c1d76fa7ee17b7a81db535639ca2be1b77e5 hurl/src/Network/URI/Locale.hs -rw-r--r-- 1.7 KiB
f7a8c1d7 — Adrian Cochrane Improve data: URI handling, provide utility to convert other URIs to data: URIs. 4 years ago
                                                                                
e0988f7e Adrian Cochrane
c72f07c9 Adrian Cochrane
e0988f7e Adrian Cochrane
214ebf86 Adrian Cochrane
c72f07c9 Adrian Cochrane
214ebf86 Adrian Cochrane
c72f07c9 Adrian Cochrane
47f9ef33 Adrian Cochrane
214ebf86 Adrian Cochrane
47f9ef33 Adrian Cochrane
214ebf86 Adrian Cochrane
c72f07c9 Adrian Cochrane
214ebf86 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
45
46
47
-- | 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], [String])
rfc2616Locale = do
    locales <- forM ["LANGUAGE", "LC_ALL", "LC_MESSAGES", "LANG"] lookupEnv
    let posix = split ":" $ firstJust locales "en_US"
    let ietf = mapMaybe toRFC2616Lang posix
    return (explode ietf, explode posix)

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

explode locales = locales ++ [l | l <- extractLangs locales, l `notElem` locales]

firstJust (Just a:_) _ | a /= "" = a
firstJust (_:maybes) fallback = firstJust maybes fallback
firstJust [] fallback = fallback

split b (a:as) | a `elem` b = [] : split b as
        | (head':tail') <- split b as = (a:head') : tail'
split _ [] = [[]]