{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Text.MMark.Extension.MathJax
-- Copyright   :  © 2018–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Turn code spans and fenced code blocks into MathJax formulas.
--
-- @since 0.1.1.0
module Text.MMark.Extension.MathJax
  ( mathJax,
  )
where

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

-- | The extension allows us to transform inline code spans into MathJax
-- inline spans and code blocks with the info string @\"mathjax\"@
-- (case-sensitive) into MathJax display spans. Every line in such a code
-- block will produce a separate display span, i.e. a separate line with a
-- formula (which is probably what you want anyway).
--
-- The first argument is the character that must be the first and the last
-- character in code spans for them to be recognized as MathJax markup. If
-- 'Nothing' is passed instead of a char, we apply the transformation to all
-- code spans (useful for more academic articles that do not contain code).
mathJax ::
  -- | Starting\/ending character in MathJax inline spans
  Maybe Char ->
  Extension
mathJax :: Maybe Char -> Extension
mathJax Maybe Char
mch = Maybe Char -> Extension
mathJaxSpan Maybe Char
mch Extension -> Extension -> Extension
forall a. Semigroup a => a -> a -> a
<> Extension
mathJaxBlock

-- | Turn code spans that start and end with a given character into MathJax
-- inline spans. If 'Nothing' is provided instead of a char, apply the
-- transformation to all code spans.
mathJaxSpan :: Maybe Char -> Extension
mathJaxSpan :: Maybe Char -> Extension
mathJaxSpan Maybe Char
mch = ((Inline -> Html ()) -> Inline -> Html ()) -> Extension
Ext.inlineRender (((Inline -> Html ()) -> Inline -> Html ()) -> Extension)
-> ((Inline -> Html ()) -> Inline -> Html ()) -> Extension
forall a b. (a -> b) -> a -> b
$ \Inline -> Html ()
old Inline
inline ->
  case Inline
inline of
    s :: Inline
s@(CodeSpan Text
txt) ->
      case Maybe Char
mch of
        Maybe Char
Nothing -> Text -> Html ()
spn Text
txt
        Just Char
ch ->
          if Text -> Int
T.length Text
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Text -> Char
T.head Text
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
ch Bool -> Bool -> Bool
&& Text -> Char
T.last Text
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
ch
            then (Text -> Html ()
spn (Text -> Html ()) -> (Text -> Text) -> Text -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1) Text
txt
            else Inline -> Html ()
old Inline
s
    Inline
other -> Inline -> Html ()
old Inline
other
  where
    spn :: Text -> Html ()
    spn :: Text -> Html ()
spn Text
x =
      [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"math inline"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
        Html ()
"\\(" Html () -> Html () -> Html ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
x Html () -> Html () -> Html ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html ()
"\\)"

-- | Turn code blocks with info string @\"mathjax\"@ into MathJax display
-- spans.
mathJaxBlock :: Extension
mathJaxBlock :: Extension
mathJaxBlock = ((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
    b :: Block (Ois, Html ())
b@(CodeBlock Maybe Text
mlabel Text
txt) ->
      if Maybe Text
mlabel Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"mathjax"
        then do
          Html () -> Html ()
forall arg result. Term arg result => arg -> result
p_ (Html () -> Html ())
-> ((Text -> Html ()) -> Html ()) -> (Text -> Html ()) -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> (Text -> Html ()) -> Html ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Text -> [Text]
T.lines Text
txt) ((Text -> Html ()) -> Html ()) -> (Text -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \Text
x ->
            [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"math display"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
              Html ()
"\\[" Html () -> Html () -> Html ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
x Html () -> Html () -> Html ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html ()
"\\]"
          Html ()
"\n"
        else Block (Ois, Html ()) -> Html ()
old Block (Ois, Html ())
b
    Block (Ois, Html ())
other -> Block (Ois, Html ()) -> Html ()
old Block (Ois, Html ())
other