From e49b8304e43d8381a2c7693643ab648f32482359 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 29 Jun 2018 22:32:49 +0200
Subject: Use HsYAML instead of yaml for translations, YAML metadata.

yaml wraps a C library; HsYAML is pure Haskell.
Closes #4747.  Advances #4535.
---
 src/Text/Pandoc/Translations.hs | 39 +++++++++++++++++++++++++++++++--------
 1 file changed, 31 insertions(+), 8 deletions(-)

(limited to 'src/Text/Pandoc/Translations.hs')

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"
-- 
cgit v1.2.3