{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Rib.Markup.MMark
(
renderMarkdown,
getFirstImg,
MMark,
)
where
import Control.Foldl (Fold (..))
import Control.Monad.Except
import Lucid (Html)
import Named
import Path
import Rib.Markup
import Text.MMark (MMark)
import qualified Text.MMark as MMark
import qualified Text.MMark.Extension as Ext
import qualified Text.MMark.Extension.Common as Ext
import qualified Text.Megaparsec as M
import Text.URI (URI)
instance Markup MMark where
parseDoc f s = case MMark.parse (toFilePath f) s of
Left e -> Left $ toText $ M.errorBundlePretty e
Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc
readDoc (Arg k) (Arg f) = do
content <- readFileText (toFilePath f)
pure $ parseDoc k content
extractMeta = fmap Right . MMark.projectYaml
renderDoc = Right . MMark.render
renderMarkdown :: Text -> Html ()
renderMarkdown s = either error id $ runExcept $ do
doc <- liftEither $ parseDoc @MMark [relfile|<memory>.md|] s
liftEither $ renderDoc doc
getFirstImg :: MMark -> Maybe URI
getFirstImg = flip MMark.runScanner $ Fold f Nothing id
where
f acc blk = acc <|> listToMaybe (mapMaybe getImgUri (inlinesContainingImg blk))
getImgUri = \case
Ext.Image _ uri _ -> Just uri
_ -> Nothing
inlinesContainingImg :: Ext.Bni -> [Ext.Inline]
inlinesContainingImg = \case
Ext.Naked xs -> toList xs
Ext.Paragraph xs -> toList xs
_ -> []
exts :: [MMark.Extension]
exts =
[ Ext.fontAwesome,
Ext.footnotes,
Ext.kbd,
Ext.linkTarget,
Ext.mathJax (Just '$'),
Ext.obfuscateEmail "protected-email",
Ext.punctuationPrettifier,
Ext.ghcSyntaxHighlighter,
Ext.skylighting
]
useTocExt :: MMark -> MMark
useTocExt doc = MMark.useExtension (Ext.toc "toc" toc) doc
where
toc = MMark.runScanner doc $ Ext.tocScanner (\x -> x > 1 && x < 5)