{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

-- | Parsing Markdown using the mmark parser.
module Rib.Parser.MMark
  ( -- * Parsing
    parse,
    parsePure,
    parseWith,
    parsePureWith,
    defaultExts,

    -- * Rendering
    render,

    -- * Extracting information
    getFirstImg,
    getFirstParagraphText,
    projectYaml,

    -- * Re-exports
    MMark,
  )
where

import Control.Foldl (Fold (..))
import Development.Shake (Action, readFile')
import Lucid.Base (HtmlT (..))
import Relude
import Rib.Shake (ribInputDir)
import System.FilePath
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 a MMark document as HTML
render :: Monad m => MMark -> HtmlT m ()
render = liftHtml . MMark.render
  where
    liftHtml :: Monad m => HtmlT Identity () -> HtmlT m ()
    liftHtml = HtmlT . pure . runIdentity . runHtmlT

-- | Like `parsePure` but takes a custom list of MMark extensions
parsePureWith ::
  [MMark.Extension] ->
  -- | Filepath corresponding to the text to be parsed (used only in parse errors)
  FilePath ->
  -- | Text to be parsed
  Text ->
  Either Text MMark
parsePureWith exts k s = case MMark.parse k s of
  Left e -> Left $ toText $ M.errorBundlePretty e
  Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc

-- | Pure version of `parse`
parsePure ::
  -- | Filepath corresponding to the text to be parsed (used only in parse errors)
  FilePath ->
  -- | Text to be parsed
  Text ->
  Either Text MMark
parsePure = parsePureWith defaultExts

-- | Parse Markdown using mmark
parse :: FilePath -> Action MMark
parse = parseWith defaultExts

-- | Like `parse` but takes a custom list of MMark extensions
parseWith :: [MMark.Extension] -> FilePath -> Action MMark
parseWith exts f =
  either (fail . toString) pure =<< do
    inputDir <- ribInputDir
    s <- toText <$> readFile' (inputDir </> f)
    pure $ parsePureWith exts f s

-- | Get the first image in the document if one exists
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
      _ -> []

-- | Get the first paragraph text of a MMark document.
--
-- Useful to determine "preview" of your notes.
getFirstParagraphText :: MMark -> Maybe Text
getFirstParagraphText =
  flip MMark.runScanner $ Fold f Nothing id
  where
    f acc blk = acc <|> (Ext.asPlainText <$> getPara blk)
    getPara = \case
      Ext.Paragraph xs -> Just xs
      _ -> Nothing

defaultExts :: [MMark.Extension]
defaultExts =
  [ Ext.fontAwesome,
    Ext.footnotes,
    Ext.kbd,
    Ext.linkTarget,
    Ext.mathJax (Just '$'),
    Ext.punctuationPrettifier,
    -- For list of parsers supported, see:
    -- https://github.com/jgm/skylighting/tree/master/skylighting-core/xml
    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)