{-# LANGUAGE CPP                        #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Translations
   Copyright   : Copyright (C) 2017-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Functions for getting localized translations of terms.
-}
module Text.Pandoc.Translations (
                           module Text.Pandoc.Translations.Types
                         , readTranslations
                         , getTranslations
                         , setTranslations
                         , translateTerm
                         )
where
import Text.Pandoc.Translations.Types
import Text.Pandoc.Class (PandocMonad(..), CommonState(..), toTextM, report)
import Text.Pandoc.Data (readDataFile)
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.Logging (LogMessage(..))
import Control.Monad.Except (catchError)
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import qualified Text.Pandoc.UTF8 as UTF8
import Data.Yaml (prettyPrintParseException)
import Text.Collate.Lang (Lang(..), renderLang)

-- | Parse YAML translations.
readTranslations :: T.Text -> Either T.Text Translations
readTranslations :: Text -> Either Text Translations
readTranslations Text
s =
  case forall a. FromJSON a => ByteString -> Either ParseException [a]
Yaml.decodeAllEither' forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText Text
s of
       Left ParseException
err' -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ParseException -> String
prettyPrintParseException ParseException
err'
       Right (Translations
t:[Translations]
_)     -> forall a b. b -> Either a b
Right Translations
t
       Right []        -> forall a b. a -> Either a b
Left Text
"empty YAML document"

-- | Select the language to use with 'translateTerm'.
-- Note that this does not read a translation file;
-- that is only done the first time 'translateTerm' is
-- used.
setTranslations :: PandocMonad m => Lang -> m ()
setTranslations :: forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
lang =
  forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. a -> Maybe a
Just (Lang
lang, forall a. Maybe a
Nothing) }

-- | Load term map.
getTranslations :: PandocMonad m => m Translations
getTranslations :: forall (m :: * -> *). PandocMonad m => m Translations
getTranslations = do
  Maybe (Lang, Maybe Translations)
mbtrans <- forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe (Lang, Maybe Translations)
stTranslations
  case Maybe (Lang, Maybe Translations)
mbtrans of
       Maybe (Lang, Maybe Translations)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty  -- no language defined
       Just (Lang
_, Just Translations
t) -> forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
       Just (Lang
lang, Maybe Translations
Nothing) -> do  -- read from file
         let translationFile :: Text
translationFile = Text
"translations/" forall a. Semigroup a => a -> a -> a
<> Lang -> Text
renderLang Lang
lang forall a. Semigroup a => a -> a -> a
<> Text
".yaml"
         let fallbackFile :: Text
fallbackFile = Text
"translations/" forall a. Semigroup a => a -> a -> a
<> Lang -> Text
langLanguage Lang
lang forall a. Semigroup a => a -> a -> a
<> Text
".yaml"
         let getTrans :: String -> m Translations
getTrans String
fp = do
               Text
txt <- forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m Text
toTextM String
fp
               case Text -> Either Text Translations
readTranslations Text
txt of
                    Left Text
e   -> do
                      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotLoadTranslations (Lang -> Text
renderLang Lang
lang)
                        (String -> Text
T.pack String
fp forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
e)
                      -- make sure we don't try again...
                      forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
                        CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. Maybe a
Nothing }
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                    Right Translations
t -> do
                      forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
                                  CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. a -> Maybe a
Just (Lang
lang, forall a. a -> Maybe a
Just Translations
t) }
                      forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
         forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall {m :: * -> *}. PandocMonad m => String -> m Translations
getTrans forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
translationFile)
           (\PandocError
_ ->
             forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall {m :: * -> *}. PandocMonad m => String -> m Translations
getTrans forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fallbackFile)
               (\PandocError
e -> do
                 forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotLoadTranslations (Lang -> Text
renderLang Lang
lang)
                          forall a b. (a -> b) -> a -> b
$ case PandocError
e of
                               PandocCouldNotFindDataFileError Text
_ ->
                                 Text
"data file " forall a. Semigroup a => a -> a -> a
<> Text
fallbackFile forall a. Semigroup a => a -> a -> a
<> Text
" not found"
                               PandocError
_ -> Text
""
                 -- make sure we don't try again...
                 forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. Maybe a
Nothing }
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty))

-- | Get a translation from the current term map.
-- Issue a warning if the term is not defined.
translateTerm :: PandocMonad m => Term -> m T.Text
translateTerm :: forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
term = do
  Translations
translations <- forall (m :: * -> *). PandocMonad m => m Translations
getTranslations
  case Term -> Translations -> Maybe Text
lookupTerm Term
term Translations
translations of
       Just Text
s -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
       Maybe Text
Nothing -> do
         forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
NoTranslation forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Term
term
         forall (m :: * -> *) a. Monad m => a -> m a
return Text
""