{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
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(..), 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)
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"
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 :: Maybe (Lang, Maybe Translations)
stTranslations = (Lang, Maybe Translations) -> Maybe (Lang, Maybe Translations)
forall a. a -> Maybe a
Just (Lang
lang, Maybe Translations
forall a. Maybe a
Nothing) }
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
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
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
ByteString
bs <- String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
fp
case Text -> Either Text Translations
readTranslations (ByteString -> Text
UTF8.toText ByteString
bs) 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)
(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 :: Maybe (Lang, Maybe Translations)
stTranslations = Maybe (Lang, Maybe Translations)
forall a. Maybe a
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 :: Maybe (Lang, Maybe Translations)
stTranslations = (Lang, Maybe Translations) -> Maybe (Lang, Maybe Translations)
forall a. a -> Maybe a
Just (Lang
lang, Translations -> Maybe Translations
forall a. a -> Maybe a
Just Translations
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
""
(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 :: Maybe (Lang, Maybe Translations)
stTranslations = Maybe (Lang, Maybe Translations)
forall a. Maybe a
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))
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
""