aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Class.hs13
-rw-r--r--src/Text/Pandoc/Translations.hs59
2 files changed, 44 insertions, 28 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 80ebd58b4..074181c92 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -79,7 +79,7 @@ module Text.Pandoc.Class ( PandocMonad(..)
, toLang
, setTranslations
, translateTerm
- , Translations(..)
+ , Translations
, Term(..)
) where
@@ -135,7 +135,8 @@ import System.IO (stderr)
import qualified Data.Map as M
import Text.Pandoc.Error
import Text.Pandoc.BCP47 (Lang(..), parseBCP47, renderLang)
-import Text.Pandoc.Translations (Term(..), Translations(..), readTranslations)
+import Text.Pandoc.Translations (Term(..), Translations, lookupTerm,
+ readTranslations)
import qualified Debug.Trace
#ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles)
@@ -343,8 +344,8 @@ getTranslations = do
Nothing -> return mempty -- no language defined
Just (_, Just t) -> return t
Just (lang, Nothing) -> do -- read from file
- let translationFile = "translations/" ++ renderLang lang ++ ".trans"
- let fallbackFile = "translations/" ++ langLanguage lang ++ ".trans"
+ let translationFile = "translations/" ++ renderLang lang ++ ".yaml"
+ let fallbackFile = "translations/" ++ langLanguage lang ++ ".yaml"
let getTrans bs =
case readTranslations (UTF8.toString bs) of
Left e -> do
@@ -374,8 +375,8 @@ getTranslations = do
-- Issue a warning if the term is not defined.
translateTerm :: PandocMonad m => Term -> m String
translateTerm term = do
- Translations termMap <- getTranslations
- case M.lookup term termMap of
+ translations <- getTranslations
+ case lookupTerm term translations of
Just s -> return s
Nothing -> do
report $ NoTranslation (show term)
diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs
index 2185366fd..e2091f0a8 100644
--- a/src/Text/Pandoc/Translations.hs
+++ b/src/Text/Pandoc/Translations.hs
@@ -40,13 +40,19 @@ just the language part. File format is:
-}
module Text.Pandoc.Translations (
Term(..)
- , Translations(..)
+ , Translations
+ , lookupTerm
, readTranslations
)
where
+import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import GHC.Generics (Generic)
-import Text.Pandoc.Shared (trim, safeRead)
+import qualified Text.Pandoc.UTF8 as UTF8
+import Data.Text as T
+import Text.Pandoc.Shared (safeRead)
+import Data.Yaml as Yaml
+import Data.Aeson.Types (typeMismatch)
data Term =
Preface
@@ -68,27 +74,36 @@ data Term =
| SeeAlso
| Cc
| To
- deriving (Show, Eq, Ord, Generic, Read)
+ deriving (Show, Eq, Ord, Generic, Enum, Read)
newtype Translations = Translations (M.Map Term String)
- deriving (Show, Eq, Ord, Generic, Monoid)
+ deriving (Show, Generic, Monoid)
-readTranslations :: String -> Either String Translations
-readTranslations = foldr parseLine (Right mempty) . lines
+instance FromJSON Term where
+ parseJSON (String t) = case safeRead (T.unpack t) of
+ Just t' -> pure t'
+ Nothing -> fail $ "Invalid Term name " ++
+ show t
+ parseJSON invalid = typeMismatch "Term" invalid
+
+instance FromJSON Translations where
+ parseJSON (Object hm) = do
+ xs <- mapM addItem (HM.toList hm)
+ return $ Translations (M.fromList xs)
+ where addItem (k,v) =
+ case safeRead (T.unpack k) of
+ Nothing -> fail $ "Invalid Term name " ++ show k
+ Just t ->
+ case v of
+ (String s) -> return (t, T.unpack $ T.strip s)
+ inv -> typeMismatch "String" inv
+ parseJSON invalid = typeMismatch "Translations" invalid
-parseLine :: String
- -> Either String Translations
- -> Either String Translations
-parseLine _ (Left s) = Left s
-parseLine ('#':_) x = x
-parseLine [] x = x
-parseLine t (Right (Translations tm)) =
- if null rest
- then Left $ "no colon in " ++ term
- else
- case safeRead term of
- Nothing -> Left $ term ++ " is not a recognized term name"
- Just term' -> Right (Translations $ (M.insert term' defn) tm)
- where (trm, rest) = break (\c -> c == ':') t
- defn = trim $ drop 1 rest
- term = trim trm
+lookupTerm :: Term -> Translations -> Maybe String
+lookupTerm t (Translations tm) = M.lookup t tm
+
+readTranslations :: String -> Either String Translations
+readTranslations s =
+ case Yaml.decodeEither' $ UTF8.fromString s of
+ Left err' -> Left $ prettyPrintParseException err'
+ Right t -> Right t