{-# 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 :: SyntaxSpec m il bl
mathSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
{ syntaxInlineParsers :: [InlineParser m il]
syntaxInlineParsers = [InlineParser m il -> InlineParser m il
forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
withAttributes InlineParser m il
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 = Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class", Text
"math inline") (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"span" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\\(" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Text -> Html a
forall a. Text -> Html a
htmlText Text
t Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\\)"
displayMath :: Text -> Html a
displayMath Text
t = Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class", Text
"math display") (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"span" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\\[" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Text -> Html a
forall a. Text -> Html a
htmlText Text
t Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\\]"
instance (HasMath i, Monoid i) => HasMath (WithSourceMap i) where
inlineMath :: Text -> WithSourceMap i
inlineMath Text
t = (Text -> i
forall a. HasMath a => Text -> a
inlineMath Text
t) i -> WithSourceMap () -> WithSourceMap i
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"inlineMath"
displayMath :: Text -> WithSourceMap i
displayMath Text
t = (Text -> i
forall a. HasMath a => Text -> a
displayMath Text
t) i -> WithSourceMap () -> WithSourceMap i
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 :: InlineParser m a
parseMath = InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'$'
Bool
display <- (Bool
True Bool
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'$') ParsecT [Tok] (IPState m) (StateT Enders m) Bool
-> ParsecT [Tok] (IPState m) (StateT Enders m) Bool
-> ParsecT [Tok] (IPState m) (StateT Enders m) Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool
False Bool
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
Text
contents <- ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
0
if Bool
display
then Text -> a
forall a. HasMath a => Text -> a
displayMath Text
contents a
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> InlineParser m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'$'
else if (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') (Int -> Text -> Text
T.takeEnd Int
1 Text
contents)
then InlineParser m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
else a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. HasMath a => Text -> a
inlineMath Text
contents
pDollarsMath :: Monad m => Int -> InlineParser m [Tok]
pDollarsMath :: Int -> InlineParser m [Tok]
pDollarsMath Int
n = do
tk :: Tok
tk@(Tok TokType
toktype SourcePos
_ Text
_) <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
case TokType
toktype of
Symbol Char
'$'
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> [Tok] -> InlineParser m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Symbol Char
'\\' -> do
Tok
tk' <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
(Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok
tk' Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> InlineParser m [Tok] -> InlineParser m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InlineParser m [Tok]
forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
n
Symbol Char
'{' -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> InlineParser m [Tok] -> InlineParser m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InlineParser m [Tok]
forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Symbol Char
'}' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> InlineParser m [Tok] -> InlineParser m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InlineParser m [Tok]
forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
| Bool
otherwise -> InlineParser m [Tok]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
TokType
_ -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> InlineParser m [Tok] -> InlineParser m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InlineParser m [Tok]
forall (m :: * -> *). Monad m => Int -> InlineParser m [Tok]
pDollarsMath Int
n