    {-# 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
      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 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
                   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 readTranslations 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 <- m Translations
    forall (m :: * -> *). PandocMonad m => m Translations
    getTranslations
      case lookupTerm term 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
    ""