diff --git a/src/Rib/Markup.hs b/src/Rib/Markup.hs index e07199c..fa36c7f 100644 --- a/src/Rib/Markup.hs +++ b/src/Rib/Markup.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -13,9 +14,11 @@ module Rib.Markup -- * Document type Document (..), + mkDocumentFrom, ) where +import Control.Monad.Except hiding (fail) import Data.Aeson import Lucid (Html) import Named @@ -39,6 +42,27 @@ data Document repr } deriving (Generic, Show) +mkDocumentFrom :: + forall b repr. + Markup repr => + -- | File path, used only to identify (not access) the document + "relpath" :! Path Rel File -> + -- | Actual file path, for access and reading + "path" :! Path b File -> + IO (Either (MarkupError repr) (Document repr)) +mkDocumentFrom (Arg k) (Arg f) = runExceptT $ do + -- HACK: this looks bad + v :: repr <- + liftEither + =<< ( lift $ + readDoc @repr @b + ! #relpath k + ! #path f + ) + let meta = extractMeta v + h <- liftEither $ renderDoc v + pure $ Document k v h meta + -- | Class for denoting Markup representations. -- -- See `Rib.Markup.Pandoc` and `Rib.Markup.MMark` for two available instances. @@ -54,19 +78,24 @@ class Markup repr where Path Rel File -> -- | Markup text to parse Text -> - Either (MarkupError repr) (Document repr) + Either (MarkupError repr) repr -- | Like `parseDoc` but take the actual filepath instead of text. readDoc :: + forall b. -- | 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 repr) (Document repr)) + IO (Either (MarkupError repr) repr) + + extractMeta :: + repr -> + Maybe Value -- | Render the document as Lucid HTML renderDoc :: - Document repr -> + repr -> Either (MarkupError repr) (Html ()) -- | Convert `MarkupError` to string diff --git a/src/Rib/Markup/MMark.hs b/src/Rib/Markup/MMark.hs index 2d4b4bd..32d5df2 100644 --- a/src/Rib/Markup/MMark.hs +++ b/src/Rib/Markup/MMark.hs @@ -40,16 +40,15 @@ instance Markup MMark where parseDoc f s = case MMark.parse (toFilePath f) s of Left e -> Left e - Right doc -> - let doc' = MMark.useExtensions exts $ useTocExt doc - meta = MMark.projectYaml doc - in Right $ Document f doc' (MMark.render doc') meta + Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc readDoc (Arg k) (Arg f) = do content <- readFileText (toFilePath f) pure $ parseDoc k content - renderDoc = Right . MMark.render . _document_val + extractMeta = MMark.projectYaml + + renderDoc = Right . MMark.render showMarkupError = toText . M.errorBundlePretty diff --git a/src/Rib/Markup/Pandoc.hs b/src/Rib/Markup/Pandoc.hs index 29394d8..8c979ea 100644 --- a/src/Rib/Markup/Pandoc.hs +++ b/src/Rib/Markup/Pandoc.hs @@ -61,8 +61,7 @@ instance Markup Pandoc where $ liftEither $ detectReader k withExcept RibPandocError_PandocError $ - mkDoc k - =<< parsePure r s + parsePure r s readDoc (Arg k) (Arg f) = runExceptT $ do content <- readFileText $ toFilePath f @@ -70,21 +69,21 @@ instance Markup Pandoc where withExceptT RibPandocError_UnknownFormat $ detectReader k withExceptT RibPandocError_PandocError $ - mkDoc k - =<< parse r content + parse r content + + extractMeta (Pandoc meta _) = flattenMeta meta renderDoc = fmap toHtmlRaw . first RibPandocError_PandocError . liftEither . render' - . _document_val showMarkupError = toText @String . show -- | Parse and render the markup directly to HTML renderPandoc :: Path Rel File -> Text -> Html () -renderPandoc f s = either (error . showMarkupError @Pandoc) id $ runExcept $ do +renderPandoc f s = either (error . show) id $ runExcept $ do doc <- liftEither $ parseDoc @Pandoc f s liftEither $ renderDoc doc @@ -104,7 +103,7 @@ parsePure r = -- Supports the [includeCode](https://github.com/owickstrom/pandoc-include-code) extension. parse :: (MonadIO m, MonadError PandocError m) => - -- | Document format. Example: `Text.Pandoc.Readers.readMarkdown` + -- | Markup format. Example: `Text.Pandoc.Readers.readMarkdown` (ReaderOptions -> Text -> PandocIO Pandoc) -> -- | Source text to parse Text -> @@ -192,14 +191,6 @@ detectReader f = do -- MonadError instead. catchInMonadError ef = either (throwError . ef) pure -mkDoc :: MonadError PandocError m => Path Rel File -> Pandoc -> m (Document Pandoc) -mkDoc f v = do - h <- liftEither $ render' v - pure $ Document f v h $ getMetadata v - -getMetadata :: Pandoc -> Maybe Value -getMetadata (Pandoc meta _) = flattenMeta meta - -- | Flatten a Pandoc 'Meta' into a well-structured JSON object. -- -- Renders Pandoc text objects into plain strings along the way. diff --git a/src/Rib/Shake.hs b/src/Rib/Shake.hs index 01eab7a..ab5ce47 100644 --- a/src/Rib/Shake.hs +++ b/src/Rib/Shake.hs @@ -91,7 +91,7 @@ readDocMulti pat = do need $ toFilePath <$> [input f] result <- liftIO $ - readDoc + mkDocumentFrom ! #relpath f ! #path (input f) case result of