{-# LANGUAGE CPP #-}
-- | Install/load the right Gettext files for your chosen language and
--   application.
--
-- Copyright   : (C) Keera Studios Ltd, 2013
-- License     : BSD3
-- Maintainer  : support@keera.co.uk
module Hails.I18N.Language where

import qualified Control.Exception         as E
import           Control.Exception.Extra   (anyway)
import           Control.Monad             (unless, void)
import           Data.Maybe                (fromMaybe, listToMaybe)
import           System.Directory          (getAppUserDataDirectory)
import           System.Environment.SetEnv (setEnv)
import           System.FilePath           ((</>))
import           System.Locale.SetLocale   (Category (LC_ALL), setLocale)
import           Text.I18N.GetText         (bindTextDomain, textDomain)

-- | Install the current language using the LC_ALL and LANGUAGE
-- environment variables and other gettext methods. This requires
-- the application's name, and it loads the language from a file
-- called "default-language" in the application's config dir.
installLanguage :: String -> IO ()
installLanguage :: String -> IO ()
installLanguage String
appName = IO (Maybe String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe String) -> IO ()) -> IO (Maybe String) -> IO ()
forall a b. (a -> b) -> a -> b
$ do

    -- Read the config file if it exists
    String
userDataDir <- String -> IO String
getAppUserDataDirectory String
appName
    let languageFile :: String
languageFile = String
userDataDir String -> String -> String
</> String
"default-language"

    -- lang == "" if no value was found
    String
lang <- (SomeException -> IO String) -> IO String -> IO String
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (IO String -> SomeException -> IO String
forall a. a -> SomeException -> a
anyway (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")) (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ do
              (String -> [String] -> String
forall a. a -> [a] -> a
safeHead String
"" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
languageFile

    -- Update locale and language only if a value has been found
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
lang) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (IO () -> SomeException -> IO ()
forall a. a -> SomeException -> a
anyway (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Category -> Maybe String -> IO (Maybe String)
setLocale Category
LC_ALL (String -> Maybe String
forall a. a -> Maybe a
Just String
lang)
      String -> String -> IO ()
setEnv String
"LANGUAGE" String
lang
#if MIN_VERSION_hgettext(0,1,5)
    bindTextDomain appName $ Just "."
#else
    String -> String -> IO (Maybe String)
bindTextDomain String
appName String
"."
#endif
#if MIN_VERSION_hgettext(0,1,6)
    textDomain $ Just appName
#else
    String -> IO (Maybe String)
textDomain String
appName
#endif

  where

    safeHead :: a -> [a] -> a
    safeHead :: a -> [a] -> a
safeHead a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe