{-# 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)
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
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