-- | This module is most near to be a drop-in replacement for @hgettext@ API.
-- It provides an @instance Localized IO@ by using process-level global variables (IORefs) for
-- storing current language and translations.
--
-- Being mostly an example, this module can though be usable for relatively simple applications,
-- for which you do not need to change languages a lot.
module Text.Localize.IO
  (setupTranslations,
   setLanguage, withLanguage,
   setContext, withContext
  ) where

import Data.IORef
import System.IO.Unsafe (unsafePerformIO)

import Text.Localize.Types
import Text.Localize.Load
import Text.Localize.Locale

currentContext :: IORef (Maybe Context)
currentContext :: IORef (Maybe Context)
currentContext = IO (IORef (Maybe Context)) -> IORef (Maybe Context)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe Context)) -> IORef (Maybe Context))
-> IO (IORef (Maybe Context)) -> IORef (Maybe Context)
forall a b. (a -> b) -> a -> b
$ Maybe Context -> IO (IORef (Maybe Context))
forall a. a -> IO (IORef a)
newIORef Maybe Context
forall a. Maybe a
Nothing
{-# NOINLINE currentContext #-}

currentLanguage :: IORef LanguageId
currentLanguage :: IORef LanguageId
currentLanguage = IO (IORef LanguageId) -> IORef LanguageId
forall a. IO a -> a
unsafePerformIO (IO (IORef LanguageId) -> IORef LanguageId)
-> IO (IORef LanguageId) -> IORef LanguageId
forall a b. (a -> b) -> a -> b
$ do
    LanguageId
language <- IO LanguageId
languageFromLocale
    LanguageId -> IO (IORef LanguageId)
forall a. a -> IO (IORef a)
newIORef LanguageId
language
{-# NOINLINE currentLanguage #-}

currentTranslations :: IORef Translations
currentTranslations :: IORef Translations
currentTranslations = IO (IORef Translations) -> IORef Translations
forall a. IO a -> a
unsafePerformIO (IO (IORef Translations) -> IORef Translations)
-> IO (IORef Translations) -> IORef Translations
forall a b. (a -> b) -> a -> b
$ Translations -> IO (IORef Translations)
forall a. a -> IO (IORef a)
newIORef Translations
forall a. HasCallStack => a
undefined
{-# NOINLINE currentTranslations #-}

instance Localized IO where
  getLanguage :: IO LanguageId
getLanguage = IORef LanguageId -> IO LanguageId
forall a. IORef a -> IO a
readIORef IORef LanguageId
currentLanguage
  getTranslations :: IO Translations
getTranslations = IORef Translations -> IO Translations
forall a. IORef a -> IO a
readIORef IORef Translations
currentTranslations
  getContext :: IO (Maybe Context)
getContext = IORef (Maybe Context) -> IO (Maybe Context)
forall a. IORef a -> IO a
readIORef IORef (Maybe Context)
currentContext

-- | This function must be called before any translation function call,
-- otherwise you will get runtime error.
--
-- Current language is selected from process locale at startup. You can
-- change it later by calling @setLanguage@ or @withLanguage@.
setupTranslations :: LocatePolicy -> IO ()
setupTranslations :: LocatePolicy -> IO ()
setupTranslations LocatePolicy
p = do
  Translations
translations <- LocatePolicy -> IO Translations
forall (m :: * -> *). MonadIO m => LocatePolicy -> m Translations
locateTranslations LocatePolicy
p
  IORef Translations -> Translations -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Translations
currentTranslations Translations
translations

-- | Set current language.
setLanguage :: LanguageId -> IO ()
setLanguage :: LanguageId -> IO ()
setLanguage LanguageId
language = IORef LanguageId -> LanguageId -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef LanguageId
currentLanguage LanguageId
language

-- | Execute some actions with specific language, and
-- then return to previously used language.
withLanguage :: LanguageId -> IO a -> IO a
withLanguage :: LanguageId -> IO a -> IO a
withLanguage LanguageId
language IO a
actions = do
  LanguageId
oldLang <- IO LanguageId
forall (m :: * -> *). Localized m => m LanguageId
getLanguage
  LanguageId -> IO ()
setLanguage LanguageId
language
  a
result <- IO a
actions
  LanguageId -> IO ()
setLanguage LanguageId
oldLang
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Set current context.
setContext :: Maybe Context -> IO ()
setContext :: Maybe Context -> IO ()
setContext Maybe Context
mbContext = IORef (Maybe Context) -> Maybe Context -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Context)
currentContext Maybe Context
mbContext

-- | Execute some actions within specific context,
-- and then return to previously used context.
withContext :: Maybe Context -> IO a -> IO a
withContext :: Maybe Context -> IO a -> IO a
withContext Maybe Context
ctxt IO a
actions = do
  Maybe Context
oldContext <- IO (Maybe Context)
forall (m :: * -> *). Localized m => m (Maybe Context)
getContext
  Maybe Context -> IO ()
setContext Maybe Context
ctxt
  a
result <- IO a
actions
  Maybe Context -> IO ()
setContext Maybe Context
oldContext
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result