Merge branch 'master' into groff_reader

1 files changed, 31 insertions, 8 deletions

diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs
index 4a216af92..13dcb3b61 100644
--- a/src/Text/Pandoc/Translations.hs
+++ b/src/Text/Pandoc/Translations.hs
@@ -48,11 +48,12 @@ module Text.Pandoc.Translations (
                          )
 where
 import Prelude
-import Data.Aeson.Types (typeMismatch)
+import Data.Aeson.Types (Value(..), FromJSON(..))
+import qualified Data.Aeson.Types as Aeson
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map as M
 import Data.Text as T
-import Data.Yaml as Yaml
+import qualified Data.YAML as YAML
 import GHC.Generics (Generic)
 import Text.Pandoc.Shared (safeRead)
 import qualified Text.Pandoc.UTF8 as UTF8
@@ -90,7 +91,15 @@ instance FromJSON Term where
                                Just t' -> pure t'
                                Nothing -> fail $ "Invalid Term name " ++
                                                  show t
-  parseJSON invalid = typeMismatch "Term" invalid
+  parseJSON invalid = Aeson.typeMismatch "Term" invalid
+
+instance YAML.FromYAML Term where
+  parseYAML (YAML.Scalar (YAML.SStr t)) =
+                         case safeRead (T.unpack t) of
+                               Just t' -> pure t'
+                               Nothing -> fail $ "Invalid Term name " ++
+                                                 show t
+  parseYAML invalid = YAML.typeMismatch "Term" invalid
 
 instance FromJSON Translations where
   parseJSON (Object hm) = do
@@ -102,14 +111,28 @@ instance FromJSON Translations where
                  Just t  ->
                    case v of
                         (String s) -> return (t, T.unpack $ T.strip s)
-                        inv        -> typeMismatch "String" inv
-  parseJSON invalid = typeMismatch "Translations" invalid
+                        inv        -> Aeson.typeMismatch "String" inv
+  parseJSON invalid = Aeson.typeMismatch "Translations" invalid
+
+instance YAML.FromYAML Translations where
+  parseYAML = YAML.withMap "Translations" $
+    \tr -> Translations .M.fromList <$> mapM addItem (M.toList tr)
+   where addItem (n@(YAML.Scalar (YAML.SStr k)), v) =
+            case safeRead (T.unpack k) of
+                 Nothing -> YAML.typeMismatch "Term" n
+                 Just t  ->
+                   case v of
+                        (YAML.Scalar (YAML.SStr s)) ->
+                          return (t, T.unpack (T.strip s))
+                        n' -> YAML.typeMismatch "String" n'
+         addItem (n, _) = YAML.typeMismatch "String" n
 
 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
+  case YAML.decodeStrict $ UTF8.fromString s of
+       Left err'   -> Left err'
+       Right (t:_) -> Right t
+       Right []    -> Left "empty YAML document"