From 4d9ffe2c34aed204c19ea76529af34eeb291750f Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Tue, 26 Nov 2019 21:58:43 -0500
Subject: [PATCH] Handle parsing errors in Pandoc metadata

---
 CONTRIBUTING.md          |  2 +-
 src/Rib/Document.hs      | 18 +++++++-----------
 src/Rib/Markup.hs        |  4 ++--
 src/Rib/Markup/MMark.hs  |  2 +-
 src/Rib/Markup/Pandoc.hs | 32 +++++++++++++++++---------------
 5 files changed, 28 insertions(+), 30 deletions(-)

diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index d1240ce..53e5cf4 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -1,4 +1,4 @@
-Rib is designed to be used not only its author, but also by others. To that end, if you notice that the library can be changed or improved in anyway so as to make it easier to write your own static sites, please do not hesitate to write a short proposal in the Issue tracker.
+Rib is designed to be used by not only its author, but also others. To that end, if you notice that the library can be changed or improved in anyway so as to make it easier to write your own static sites, please do not hesitate to write a short proposal in the Issue tracker.
 
 ## Coding style
 
diff --git a/src/Rib/Document.hs b/src/Rib/Document.hs
index a3a232a..2dc8fb2 100644
--- a/src/Rib/Document.hs
+++ b/src/Rib/Document.hs
@@ -36,9 +36,6 @@ data Document repr meta
         _document_val :: repr,
         -- | HTML rendering of the parsed representation.
         _document_html :: Html (),
-        -- | Metadata associated with the document as an aeson Value. If no metadata
-        -- is provided this will be Nothing.
-        _document_metaValue :: Maybe Value,
         -- | The parsed metadata.
         _document_meta :: meta
       }
@@ -47,13 +44,13 @@ data Document repr meta
 data DocumentError
   = DocumentError_MarkupError Text
   | DocumentError_MetadataMissing
-  | DocumentError_MetadataBadJSON Text
+  | DocumentError_MetadataMalformed Text
 
 instance Show DocumentError where
   show = \case
     DocumentError_MarkupError e -> toString e
     DocumentError_MetadataMissing -> "Metadata missing"
-    DocumentError_MetadataBadJSON msg -> "Bad metadata JSON: " <> toString msg
+    DocumentError_MetadataMalformed msg -> "Bad metadata JSON: " <> toString msg
 
 -- | Parse, render to HTML and extract metadata from the given file.
 --
@@ -75,17 +72,16 @@ mkDocumentFrom k@(arg #relpath -> k') f = do
     liftEither
       $ first DocumentError_MarkupError
       $ renderDoc v
-  let metaValueM = extractMeta v
   metaValue <-
-    maybeToEither
-      DocumentError_MetadataMissing
-      metaValueM
+    liftEither
+      . (first DocumentError_MetadataMalformed)
+      =<< maybeToEither DocumentError_MetadataMissing (extractMeta v)
   meta <-
     liftEither
-      $ first (DocumentError_MetadataBadJSON . toText)
+      $ first (DocumentError_MetadataMalformed . toText)
       $ resultToEither
       $ fromJSON metaValue
-  pure $ Document k' v html metaValueM meta
+  pure $ Document k' v html meta
   where
     maybeToEither e = \case
       Nothing -> throwError e
diff --git a/src/Rib/Markup.hs b/src/Rib/Markup.hs
index 6cf3c7c..b4cf77c 100644
--- a/src/Rib/Markup.hs
+++ b/src/Rib/Markup.hs
@@ -13,7 +13,7 @@ module Rib.Markup
   )
 where
 
-import Data.Aeson
+import Data.Aeson (Value)
 import Lucid (Html)
 import Named
 import Path
@@ -42,7 +42,7 @@ class Markup repr where
 
   extractMeta ::
     repr ->
-    Maybe Value
+    Maybe (Either Text Value)
 
   -- | Render the document as Lucid HTML
   renderDoc ::
diff --git a/src/Rib/Markup/MMark.hs b/src/Rib/Markup/MMark.hs
index a78064c..2ce3874 100644
--- a/src/Rib/Markup/MMark.hs
+++ b/src/Rib/Markup/MMark.hs
@@ -44,7 +44,7 @@ instance Markup MMark where
     content <- readFileText (toFilePath f)
     pure $ parseDoc k content
 
-  extractMeta = MMark.projectYaml
+  extractMeta = fmap Right . MMark.projectYaml
 
   renderDoc = Right . MMark.render
 
diff --git a/src/Rib/Markup/Pandoc.hs b/src/Rib/Markup/Pandoc.hs
index 1ceacfc..d28ed31 100644
--- a/src/Rib/Markup/Pandoc.hs
+++ b/src/Rib/Markup/Pandoc.hs
@@ -77,10 +77,8 @@ instance Markup Pandoc where
   extractMeta (Pandoc meta _) = flattenMeta meta
 
   renderDoc =
-    bimap show toHtmlRaw
-      . first RibPandocError_PandocError
+    bimap (show . RibPandocError_PandocError) toHtmlRaw
       . liftEither
-      . fmap toHtmlRaw
       . runPure
       . writeHtml5String writerSettings
 
@@ -170,16 +168,20 @@ detectReader f = do
 -- | Flatten a Pandoc 'Meta' into a well-structured JSON object.
 --
 -- Renders Pandoc text objects into plain strings along the way.
-flattenMeta :: Meta -> Maybe Value
-flattenMeta (Meta meta) = toJSON . fmap go <$> guarded null meta
+flattenMeta :: Meta -> Maybe (Either Text Value)
+flattenMeta (Meta meta) = fmap toJSON . traverse go <$> guarded null meta
   where
-    go :: MetaValue -> Value
-    go (MetaMap m) = toJSON $ fmap go m
-    go (MetaList m) = toJSONList $ fmap go m
-    go (MetaBool m) = toJSON m
-    go (MetaString m) = toJSON m
-    go (MetaInlines m) = toJSON (runPure' . writer $ Pandoc mempty [Plain m])
-    go (MetaBlocks m) = toJSON (runPure' . writer $ Pandoc mempty m)
-    runPure' :: PandocPure a -> a
-    runPure' = either (error . show) id . runPure
-    writer = writePlain def
+    go :: MetaValue -> Either Text Value
+    go (MetaMap m) = toJSON <$> traverse go m
+    go (MetaList m) = toJSONList <$> traverse go m
+    go (MetaBool m) = pure $ toJSON m
+    go (MetaString m) = pure $ toJSON m
+    go (MetaInlines m) =
+      bimap show toJSON
+        $ runPure . plainWriter
+        $ Pandoc mempty [Plain m]
+    go (MetaBlocks m) =
+      bimap show toJSON
+        $ runPure . plainWriter
+        $ Pandoc mempty m
+    plainWriter = writePlain def