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