diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Class.hs | 13 | ||||
-rw-r--r-- | src/Text/Pandoc/Translations.hs | 59 |
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 |