-- |
-- Module      :  Text.MMark.Extension.Comment
-- Copyright   :  © 2018–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Turn paragraphs into comments by prefixing them with a certain sequence
-- of characters.
module Text.MMark.Extension.Comment
  ( commentParagraph,
  )
where

import Control.Monad
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as T
import Text.MMark.Extension (Block (..), Extension, Inline (..))
import qualified Text.MMark.Extension as Ext

-- | This extension removes top-level paragraphs starting with the given
-- sequence of non-markup characters.
commentParagraph ::
  -- | Sequence of characters that starts a comment
  Text ->
  Extension
commentParagraph :: Text -> Extension
commentParagraph Text
commentPrefix = ((Block (Ois, Html ()) -> Html ())
 -> Block (Ois, Html ()) -> Html ())
-> Extension
Ext.blockRender (((Block (Ois, Html ()) -> Html ())
  -> Block (Ois, Html ()) -> Html ())
 -> Extension)
-> ((Block (Ois, Html ()) -> Html ())
    -> Block (Ois, Html ()) -> Html ())
-> Extension
forall a b. (a -> b) -> a -> b
$ \Block (Ois, Html ()) -> Html ()
old Block (Ois, Html ())
block ->
  case Block (Ois, Html ())
block of
    p :: Block (Ois, Html ())
p@(Paragraph (Ois
ois, Html ()
_)) ->
      case Ois -> NonEmpty Inline
Ext.getOis Ois
ois of
        (Plain Text
txt :| [Inline]
_) ->
          Bool -> Html () -> Html ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
commentPrefix Text -> Text -> Bool
`T.isPrefixOf` Text
txt) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
            Block (Ois, Html ()) -> Html ()
old Block (Ois, Html ())
p
        NonEmpty Inline
_ -> Block (Ois, Html ()) -> Html ()
old Block (Ois, Html ())
p
    Block (Ois, Html ())
other -> Block (Ois, Html ()) -> Html ()
old Block (Ois, Html ())
other