Merge pull request #50 from srid/pandoc-error-improvements

Minor error type refactors

src/Rib/Markup.hs

@@ -24,32 +24,34 @@ import Path
 
 -- | A document written in a lightweight markup language (LML)
 --
--- The type variable `t` indicates the type of Markup parser to use.
-data Document t
+-- The type variable `repr` indicates the representation type of the Markup
+-- parser to be used.
+data Document repr
   = Document
       { -- | Path to the document; relative to the source directory.
         _document_path :: Path Rel File,
-        _document_val :: t,
+        _document_val :: repr,
         -- | Metadata associated with the document as an aeson Value. If no metadata
         -- is provided this will be Nothing.
         _document_meta :: Maybe Value
       }
   deriving (Generic, Show)
 
-getDocumentMeta :: FromJSON meta => Document t -> meta
+getDocumentMeta :: FromJSON meta => Document repr -> meta
 getDocumentMeta (Document fp _ mmeta) = case mmeta of
   Nothing -> error $ toText $ "No metadata in document: " <> toFilePath fp -- TODO: handle errors gracefully
   Just meta -> case fromJSON meta of
     Error e -> error $ toText e
     Success v -> v
 
--- | Markup class abstracts over the different markup libraries
+-- | Class for denoting Markup representations.
 --
 -- See `Rib.Markup.Pandoc` and `Rib.Markup.MMark` for two available instances.
-class Markup t where
+class Markup repr where
 
-  -- | Type representing parse errors
-  type MarkupError t :: *
+  -- | Type representing errors associated with parsing to, and rendering from,
+  -- this representation.
+  type MarkupError repr :: *
 
   -- | Parse the given markup text
   parseDoc ::
@@ -57,18 +59,18 @@ class Markup t where
     Path Rel File ->
     -- | Markup text to parse
     Text ->
-    Either (MarkupError t) (Document t)
+    Either (MarkupError repr) (Document repr)
 
-  -- | Like `parseDoc` but take the actual filepath instead of text.
+  -- | Like `reproc` but take the actual filepath instead of text.
   readDoc ::
     -- | File path, used to identify the document only.
     "relpath" :! Path Rel File ->
     -- | Actual path to the file to parse.
     "path" :! Path b File ->
-    IO (Either (MarkupError t) (Document t))
+    IO (Either (MarkupError repr) (Document repr))
 
   -- | Render the document as Lucid HTML
-  renderDoc :: Document t -> Html ()
+  renderDoc :: Document repr -> Html ()
 
   -- | Convert `MarkupError` to string
-  showMarkupError :: MarkupError t -> Text
+  showMarkupError :: MarkupError repr -> Text

src/Rib/Markup/Pandoc.hs

@@ -27,7 +27,6 @@ module Rib.Markup.Pandoc
   )
 where
 
-import Control.Monad.Catch
 import Control.Monad.Except
 import Data.Aeson
 import Lucid (Html, toHtmlRaw)
@@ -43,14 +42,14 @@ import qualified Text.Show
 
 data RibPandocError
   = RibPandocError_PandocError PandocError
-  | RibPandocError_UnsupportedExtension String
+  | RibPandocError_UnknownFormat UnknownExtension
 
 instance Show RibPandocError where
   show = \case
     RibPandocError_PandocError e ->
       show e
-    RibPandocError_UnsupportedExtension ext ->
-      "Unsupported extension: " <> ext
+    RibPandocError_UnknownFormat s ->
+      "Unsupported extension: " <> show s
 
 instance Markup Pandoc where
 
@@ -58,9 +57,8 @@ instance Markup Pandoc where
 
   parseDoc k s = runExcept $ do
     r <-
-      withExcept RibPandocError_UnsupportedExtension
+      withExcept RibPandocError_UnknownFormat
         $ liftEither
-        $ first show
         $ detectReader k
     withExcept RibPandocError_PandocError $
       mkDoc k
@@ -69,7 +67,7 @@ instance Markup Pandoc where
   readDoc (Arg k) (Arg f) = runExceptT $ do
     content <- readFileText $ toFilePath f
     r <-
-      withExceptT RibPandocError_UnsupportedExtension $
+      withExceptT RibPandocError_UnknownFormat $
         detectReader k
     withExceptT RibPandocError_PandocError $
       mkDoc k
@@ -163,33 +161,36 @@ exts =
 
 -- Internal code
 
-data UnknownException
-  = UnknownException String
-  deriving (Show, Eq, Typeable)
-
-instance Exception UnknownException
+data UnknownExtension
+  = UnknownExtension String
+  deriving (Show, Eq)
 
 -- | Detect the Pandoc reader to use based on file extension
 detectReader ::
   forall m m1.
-  (MonadThrow m, PandocMonad m1) =>
+  (MonadError UnknownExtension m, PandocMonad m1) =>
   Path Rel File ->
   m (ReaderOptions -> Text -> m1 Pandoc)
 detectReader f = do
-  ext <- fileExtension f
-  case formats !? ext of
-    Nothing -> throwM $ UnknownException ext
-    Just r -> pure r
+  ext <-
+    catchInMonadError (UnknownExtension . show) $
+      fileExtension f
+  liftEither $ maybeToRight (UnknownExtension ext) $
+    formats !? ext
   where
-    -- TODO: This should compute using `Text.Pandoc.Readers.readers`
     formats :: Map String (ReaderOptions -> Text -> m1 Pandoc)
     formats =
+      -- TODO: Expand this list, cf. `Text.Pandoc.Readers.readers`
       fromList
         [ (".md", readMarkdown),
           (".rst", readRST),
           (".org", readOrg),
-          (".tex", readLaTeX)
+          (".tex", readLaTeX),
+          (".ipynb", readIpynb)
         ]
+    -- Re-constrain code constrained by MonadThrow to be constrained by
+    -- MonadError instead.
+    catchInMonadError ef = either (throwError . ef) pure
 
 mkDoc :: Path Rel File -> Pandoc -> Document Pandoc
 mkDoc f v = Document f v $ getMetadata v