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