{-# LANGUAGE CPP                        #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Translations
   Copyright   : Copyright (C) 2017-2024 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 ByteString -> Either ParseException [Translations]
forall a. FromJSON a => ByteString -> Either ParseException [a]
Yaml.decodeAllEither' (ByteString -> Either ParseException [Translations])
-> ByteString -> Either ParseException [Translations]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText Text
s of
       Left ParseException
err' -> Text -> Either Text Translations
forall a b. a -> Either a b
Left (Text -> Either Text Translations)
-> Text -> Either Text Translations
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseException -> String
prettyPrintParseException ParseException
err'
       Right (Translations
t:[Translations]
_)     -> Translations -> Either Text Translations
forall a b. b -> Either a b
Right Translations
t
       Right []        -> Text -> Either Text Translations
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 =
  (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stTranslations = Just (lang, Nothing) }

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