{-# 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(..), toTextM, report)
import Text.Pandoc.Class.CommonState (CommonState(..))
import Text.Pandoc.Data (readDataFile)
import Data.Containers.ListUtils (nubOrd)
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 translationFiles :: [String]
translationFiles = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> String
"translations/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".yaml")
               ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd [Lang -> Text
renderLang Lang
lang,
                      Lang -> Text
langLanguage Lang
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Lang -> Maybe Text
langScript Lang
lang),
                      Lang -> Text
langLanguage Lang
lang])
         let getTrans :: [String] -> m Translations
getTrans [] = Translations -> m Translations
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
forall a. Monoid a => a
mempty
             getTrans (String
fp:[String]
fps) = do
               result <- m (Either Text Text)
-> (PandocError -> m (Either Text Text)) -> m (Either Text Text)
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> m Text -> m (Either Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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))
                             (\PandocError
_ -> Either Text Text -> m (Either Text Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text Text
forall a b. a -> Either a b
Left Text
""))
               case result >>= readTranslations of
                  Left Text
e
                    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fps -> 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
                    | Bool
otherwise -> [String] -> m Translations
getTrans [String]
fps
                  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
         [String] -> m Translations
forall {m :: * -> *}. PandocMonad m => [String] -> m Translations
getTrans [String]
translationFiles

-- | 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
""