{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Extensions.Math
  ( HasMath(..)
  , mathSpec )
where
import Control.Monad (mzero)
import Commonmark.Types
import Commonmark.Tokens
import Commonmark.Syntax
import Commonmark.Inlines
import Commonmark.SourceMap
import Commonmark.TokParsers
import Commonmark.Html
import Text.Parsec
import Data.Text (Text)
import qualified Data.Text as T

mathSpec :: (Monad m, IsBlock il bl, IsInline il, HasMath il)
         => SyntaxSpec m il bl
mathSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasMath il) =>
SyntaxSpec m il bl
mathSpec = forall a. Monoid a => a
mempty
  { syntaxInlineParsers :: [InlineParser m il]
syntaxInlineParsers = [forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
withAttributes forall (m :: * -> *) a. (Monad m, HasMath a) => InlineParser m a
parseMath]
  }

class HasMath a where
  inlineMath :: Text -> a
  displayMath :: Text -> a

instance HasMath (Html a) where
  inlineMath :: Text -> Html a
inlineMath Text
t = forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class", Text
"math inline") forall a b. (a -> b) -> a -> b
$
    forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"span" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\\(" forall a. Semigroup a => a -> a -> a
<> forall a. Text -> Html a
htmlText Text
t forall a. Semigroup a => a -> a -> a
<> forall a. Text -> Html a
htmlRaw Text
"\\)"
  displayMath :: Text -> Html a
displayMath Text
t = forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class", Text
"math display") forall a b. (a -> b) -> a -> b
$
    forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"span" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\\[" forall a. Semigroup a => a -> a -> a
<> forall a. Text -> Html a
htmlText Text
t forall a. Semigroup a => a -> a -> a
<> forall a. Text -> Html a
htmlRaw Text
"\\]"

instance (HasMath i, Monoid i) => HasMath (WithSourceMap i) where
  inlineMath :: Text -> WithSourceMap i
inlineMath Text
t = (forall a. HasMath a => Text -> a
inlineMath Text
t) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"inlineMath"
  displayMath :: Text -> WithSourceMap i
displayMath Text
t = (forall a. HasMath a => Text -> a
displayMath Text
t) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"displayMath"

parseMath :: (Monad m, HasMath a) => InlineParser m a
parseMath :: forall (m :: * -> *) a. (Monad m, HasMath a) => InlineParser m a
parseMath = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'$'
  Bool
display <- (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'$') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
  Text
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
0
  let isWs :: Char -> Bool
isWs Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'
  if Bool
display
     then forall a. HasMath a => Text -> a
displayMath Text
contents forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'$'
     else if Text -> Bool
T.null Text
contents Bool -> Bool -> Bool
|| Char -> Bool
isWs (Text -> Char
T.last Text
contents)
             -- don't allow math to end with SPACE + $
             then forall (m :: * -> *) a. MonadPlus m => m a
mzero
             else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasMath a => Text -> a
inlineMath Text
contents

-- Int is number of embedded groupings
pDollarsMath :: Monad m => Int -> InlineParser m [Tok]
pDollarsMath :: forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
n = do
  tk :: Tok
tk@(Tok TokType
toktype SourcePos
_ Text
_) <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
  case TokType
toktype of
       Symbol Char
'$'
              | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
       Symbol Char
'\\' -> do
              Tok
tk' <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
              (Tok
tk forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok
tk' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
n
       Symbol Char
'{' -> (Tok
tk forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath (Int
nforall a. Num a => a -> a -> a
+Int
1)
       Symbol Char
'}' | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> (Tok
tk forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath (Int
nforall a. Num a => a -> a -> a
-Int
1)
                  | Bool
otherwise -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
       TokType
_ -> (Tok
tk forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
n