Change to yaml for translation files.

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