Change to yaml for translation files.

This commit is contained in:
John MacFarlane 2017-08-12 12:17:38 -07:00
parent b6e0add76a
commit 622c3f2fa6
6 changed files with 45 additions and 29 deletions

View file

@ -73,7 +73,7 @@ Data-Files:
data/templates/default.epub2
data/templates/default.epub3
-- translations
data/translations/*.trans
data/translations/*.yaml
-- source files for reference.docx
data/docx/[Content_Types].xml
data/docx/_rels/.rels

View file

@ -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)

View file

@ -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)
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
lookupTerm :: Term -> Translations -> Maybe String
lookupTerm t (Translations tm) = M.lookup t tm
readTranslations :: String -> Either String Translations
readTranslations = foldr parseLine (Right mempty) . lines
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
readTranslations s =
case Yaml.decodeEither' $ UTF8.fromString s of
Left err' -> Left $ prettyPrintParseException err'
Right t -> Right t