aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Translations.hs
blob: 00562e1896f9ac09f838cfbd8f0bf8a8521e8bec (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
{-# 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 <[email protected]>
   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 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 s =
  case Yaml.decodeAllEither' $ UTF8.fromText s of
       Left err' -> Left $ T.pack $ prettyPrintParseException err'
       Right (t:_)     -> Right t
       Right []        -> Left "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 lang =
  modifyCommonState $ \st -> st{ stTranslations = Just (lang, Nothing) }

-- | Load term map.
getTranslations :: PandocMonad m => m Translations
getTranslations = do
  mbtrans <- getsCommonState stTranslations
  case mbtrans of
       Nothing -> return mempty  -- no language defined
       Just (_, Just t) -> return t
       Just (lang, Nothing) -> do  -- read from file
         let translationFile = "translations/" <> renderLang lang <> ".yaml"
         let fallbackFile = "translations/" <> langLanguage lang <> ".yaml"
         let getTrans fp = do
               txt <- readDataFile fp >>= toTextM fp
               case readTranslations txt of
                    Left e   -> do
                      report $ CouldNotLoadTranslations (renderLang lang)
                        (T.pack fp <> ": " <> e)
                      -- make sure we don't try again...
                      modifyCommonState $ \st ->
                        st{ stTranslations = Nothing }
                      return mempty
                    Right t -> do
                      modifyCommonState $ \st ->
                                  st{ stTranslations = Just (lang, Just t) }
                      return t
         catchError (getTrans $ T.unpack translationFile)
           (\_ ->
             catchError (getTrans $ T.unpack fallbackFile)
               (\e -> do
                 report $ CouldNotLoadTranslations (renderLang lang)
                          $ case e of
                               PandocCouldNotFindDataFileError _ ->
                                 "data file " <> fallbackFile <> " not found"
                               _ -> ""
                 -- make sure we don't try again...
                 modifyCommonState $ \st -> st{ stTranslations = Nothing }
                 return 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 term = do
  translations <- getTranslations
  case lookupTerm term translations of
       Just s -> return s
       Nothing -> do
         report $ NoTranslation $ T.pack $ show term
         return ""