{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Rib.Parser.MMark
(
parse,
parsePure,
parseWith,
parsePureWith,
defaultExts,
render,
getFirstImg,
getFirstParagraphText,
projectYaml,
MMark,
)
where
import Control.Foldl (Fold (..))
import Development.Shake (Action, readFile')
import Lucid.Base (HtmlT (..))
import Path
import Relude
import Rib.Shake (ribInputDir)
import Text.MMark (MMark, projectYaml)
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)
render :: Monad m => MMark -> HtmlT m ()
render :: MMark -> HtmlT m ()
render = HtmlT Identity () -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlT Identity () -> HtmlT m ()
liftHtml (HtmlT Identity () -> HtmlT m ())
-> (MMark -> HtmlT Identity ()) -> MMark -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMark -> HtmlT Identity ()
MMark.render
where
liftHtml :: Monad m => HtmlT Identity () -> HtmlT m ()
liftHtml :: HtmlT Identity () -> HtmlT m ()
liftHtml = m (HashMap Text Text -> Builder, ()) -> HtmlT m ()
forall (m :: * -> *) a.
m (HashMap Text Text -> Builder, a) -> HtmlT m a
HtmlT (m (HashMap Text Text -> Builder, ()) -> HtmlT m ())
-> (HtmlT Identity () -> m (HashMap Text Text -> Builder, ()))
-> HtmlT Identity ()
-> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text Text -> Builder, ())
-> m (HashMap Text Text -> Builder, ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HashMap Text Text -> Builder, ())
-> m (HashMap Text Text -> Builder, ()))
-> (HtmlT Identity () -> (HashMap Text Text -> Builder, ()))
-> HtmlT Identity ()
-> m (HashMap Text Text -> Builder, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (HashMap Text Text -> Builder, ())
-> (HashMap Text Text -> Builder, ())
forall a. Identity a -> a
runIdentity (Identity (HashMap Text Text -> Builder, ())
-> (HashMap Text Text -> Builder, ()))
-> (HtmlT Identity ()
-> Identity (HashMap Text Text -> Builder, ()))
-> HtmlT Identity ()
-> (HashMap Text Text -> Builder, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> Identity (HashMap Text Text -> Builder, ())
forall (m :: * -> *) a.
HtmlT m a -> m (HashMap Text Text -> Builder, a)
runHtmlT
parsePureWith ::
[MMark.Extension] ->
FilePath ->
Text ->
Either Text MMark
parsePureWith :: [Extension] -> FilePath -> Text -> Either Text MMark
parsePureWith exts :: [Extension]
exts k :: FilePath
k s :: Text
s = case FilePath -> Text -> Either (ParseErrorBundle Text MMarkErr) MMark
MMark.parse FilePath
k Text
s of
Left e :: ParseErrorBundle Text MMarkErr
e -> Text -> Either Text MMark
forall a b. a -> Either a b
Left (Text -> Either Text MMark) -> Text -> Either Text MMark
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text MMarkErr -> FilePath
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
M.errorBundlePretty ParseErrorBundle Text MMarkErr
e
Right doc :: MMark
doc -> MMark -> Either Text MMark
forall a b. b -> Either a b
Right (MMark -> Either Text MMark) -> MMark -> Either Text MMark
forall a b. (a -> b) -> a -> b
$ [Extension] -> MMark -> MMark
MMark.useExtensions [Extension]
exts (MMark -> MMark) -> MMark -> MMark
forall a b. (a -> b) -> a -> b
$ MMark -> MMark
useTocExt MMark
doc
parsePure ::
FilePath ->
Text ->
Either Text MMark
parsePure :: FilePath -> Text -> Either Text MMark
parsePure = [Extension] -> FilePath -> Text -> Either Text MMark
parsePureWith [Extension]
defaultExts
parse :: Path Rel File -> Action MMark
parse :: Path Rel File -> Action MMark
parse = [Extension] -> Path Rel File -> Action MMark
parseWith [Extension]
defaultExts
parseWith :: [MMark.Extension] -> Path Rel File -> Action MMark
parseWith :: [Extension] -> Path Rel File -> Action MMark
parseWith exts :: [Extension]
exts f :: Path Rel File
f =
(Text -> Action MMark)
-> (MMark -> Action MMark) -> Either Text MMark -> Action MMark
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Action MMark
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action MMark)
-> (Text -> FilePath) -> Text -> Action MMark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString) MMark -> Action MMark
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text MMark -> Action MMark)
-> Action (Either Text MMark) -> Action MMark
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Path Rel Dir
inputDir <- Action (Path Rel Dir)
ribInputDir
Text
s <- FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> Action FilePath -> Action Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => FilePath -> Action FilePath
FilePath -> Action FilePath
readFile' (Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath) -> Path Rel File -> FilePath
forall a b. (a -> b) -> a -> b
$ Path Rel Dir
inputDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f)
Either Text MMark -> Action (Either Text MMark)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text MMark -> Action (Either Text MMark))
-> Either Text MMark -> Action (Either Text MMark)
forall a b. (a -> b) -> a -> b
$ [Extension] -> FilePath -> Text -> Either Text MMark
parsePureWith [Extension]
exts (Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel File
f) Text
s
getFirstImg :: MMark -> Maybe URI
getFirstImg :: MMark -> Maybe URI
getFirstImg = (MMark -> Fold Bni (Maybe URI) -> Maybe URI)
-> Fold Bni (Maybe URI) -> MMark -> Maybe URI
forall a b c. (a -> b -> c) -> b -> a -> c
flip MMark -> Fold Bni (Maybe URI) -> Maybe URI
forall a. MMark -> Fold Bni a -> a
MMark.runScanner (Fold Bni (Maybe URI) -> MMark -> Maybe URI)
-> Fold Bni (Maybe URI) -> MMark -> Maybe URI
forall a b. (a -> b) -> a -> b
$ (Maybe URI -> Bni -> Maybe URI)
-> Maybe URI -> (Maybe URI -> Maybe URI) -> Fold Bni (Maybe URI)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe URI -> Bni -> Maybe URI
f Maybe URI
forall a. Maybe a
Nothing Maybe URI -> Maybe URI
forall a. a -> a
id
where
f :: Maybe URI -> Bni -> Maybe URI
f acc :: Maybe URI
acc blk :: Bni
blk = Maybe URI
acc Maybe URI -> Maybe URI -> Maybe URI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [URI] -> Maybe URI
forall a. [a] -> Maybe a
listToMaybe ((Inline -> Maybe URI) -> [Inline] -> [URI]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe URI
getImgUri (Bni -> [Inline]
inlinesContainingImg Bni
blk))
getImgUri :: Inline -> Maybe URI
getImgUri = \case
Ext.Image _ uri :: URI
uri _ -> URI -> Maybe URI
forall a. a -> Maybe a
Just URI
uri
_ -> Maybe URI
forall a. Maybe a
Nothing
inlinesContainingImg :: Ext.Bni -> [Ext.Inline]
inlinesContainingImg :: Bni -> [Inline]
inlinesContainingImg = \case
Ext.Naked xs :: NonEmpty Inline
xs -> NonEmpty Inline -> [Inline]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Inline
xs
Ext.Paragraph xs :: NonEmpty Inline
xs -> NonEmpty Inline -> [Inline]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Inline
xs
_ -> []
getFirstParagraphText :: MMark -> Maybe Text
getFirstParagraphText :: MMark -> Maybe Text
getFirstParagraphText =
(MMark -> Fold Bni (Maybe Text) -> Maybe Text)
-> Fold Bni (Maybe Text) -> MMark -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip MMark -> Fold Bni (Maybe Text) -> Maybe Text
forall a. MMark -> Fold Bni a -> a
MMark.runScanner (Fold Bni (Maybe Text) -> MMark -> Maybe Text)
-> Fold Bni (Maybe Text) -> MMark -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Bni -> Maybe Text)
-> Maybe Text
-> (Maybe Text -> Maybe Text)
-> Fold Bni (Maybe Text)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe Text -> Bni -> Maybe Text
f Maybe Text
forall a. Maybe a
Nothing Maybe Text -> Maybe Text
forall a. a -> a
id
where
f :: Maybe Text -> Bni -> Maybe Text
f acc :: Maybe Text
acc blk :: Bni
blk = Maybe Text
acc Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NonEmpty Inline -> Text
Ext.asPlainText (NonEmpty Inline -> Text) -> Maybe (NonEmpty Inline) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bni -> Maybe (NonEmpty Inline)
forall a. Block a -> Maybe a
getPara Bni
blk)
getPara :: Block a -> Maybe a
getPara = \case
Ext.Paragraph xs :: a
xs -> a -> Maybe a
forall a. a -> Maybe a
Just a
xs
_ -> Maybe a
forall a. Maybe a
Nothing
defaultExts :: [MMark.Extension]
defaultExts :: [Extension]
defaultExts =
[ Extension
Ext.fontAwesome,
Extension
Ext.footnotes,
Extension
Ext.kbd,
Extension
Ext.linkTarget,
Maybe Char -> Extension
Ext.mathJax (Char -> Maybe Char
forall a. a -> Maybe a
Just '$'),
Extension
Ext.punctuationPrettifier,
Extension
Ext.skylighting
]
useTocExt :: MMark -> MMark
useTocExt :: MMark -> MMark
useTocExt doc :: MMark
doc = Extension -> MMark -> MMark
MMark.useExtension (Text -> Toc -> Extension
Ext.toc "toc" Toc
toc) MMark
doc
where
toc :: Toc
toc = MMark -> Fold Bni Toc -> Toc
forall a. MMark -> Fold Bni a -> a
MMark.runScanner MMark
doc (Fold Bni Toc -> Toc) -> Fold Bni Toc -> Toc
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Fold Bni Toc
Ext.tocScanner (\x :: Int
x -> Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 5)