{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeApplications           #-}
{- |
   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.List.NonEmpty as NE
import qualified Yamlet as Y
import Yamlet.Aeson
import Text.Collate.Lang (Lang(..), renderLang)

-- | Parse YAML translations. The file path is used in error messages.
readTranslations :: FilePath -> T.Text -> Either T.Text Translations
readTranslations :: FilePath -> Text -> Either Text Translations
readTranslations FilePath
fp Text
s =
  case forall a. FromYaml a => Text -> Either (NonEmpty Error) [a]
Y.decodeAllText @(ViaAeson Translations) Text
s of
       Left NonEmpty Error
errs -> 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
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
         (Error -> Text) -> [Error] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text) -> (Error -> FilePath) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Error -> FilePath
Y.prettyError FilePath
fp) (NonEmpty Error -> [Error]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Error
errs)
       Right (ViaAeson Translations
t:[ViaAeson 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 -> Either Text Translations)
-> Text -> Either Text Translations
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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 ->
    case CommonState -> Maybe (Lang, Maybe Translations)
stTranslations CommonState
st of
      -- if a translation table is already loaded for this language,
      -- keep it, so we don't have to parse the translation file again:
      Just (Lang
l, Just Translations
_) | Lang
l Lang -> Lang -> Bool
forall a. Eq a => a -> a -> Bool
== Lang
lang -> CommonState
st
      Maybe (Lang, Maybe Translations)
_ -> 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 :: [FilePath]
translationFiles = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> FilePath
"translations/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
x FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".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 :: [FilePath] -> 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 (FilePath
fp:[FilePath]
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
<$> (FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
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
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
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 (FilePath -> Text
T.pack FilePath
fp)))
               case result >>= readTranslations fp of
                  Left Text
e
                    | [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
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) 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 -> [FilePath] -> m Translations
getTrans [FilePath]
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
         [FilePath] -> m Translations
forall {m :: * -> *}. PandocMonad m => [FilePath] -> m Translations
getTrans [FilePath]
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
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Term -> FilePath
forall a. Show a => a -> FilePath
show Term
term
         Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""