{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Commonmark.Extensions.Math ( HasMath(..) , mathSpec ) where 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) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup(..)) #endif 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 forall (m :: * -> *) a. (Monad m, HasMath a) => InlineParser m a pDisplayMath InlineParser m a -> InlineParser m a -> InlineParser m a forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a <|> InlineParser m a forall (m :: * -> *) a. (Monad m, HasMath a) => InlineParser m a pInlineMath pInlineMath :: (Monad m, HasMath a) => InlineParser m a pInlineMath :: InlineParser m a pInlineMath = 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 '$' 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 ([Tok] _, [Tok] toks) <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) ([Tok], [Tok]) forall (m :: * -> *) s a. Monad m => ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok]) withRaw (ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) ([Tok], [Tok])) -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) ([Tok], [Tok]) forall a b. (a -> b) -> a -> b $ ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m [a] many1 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall a b. (a -> b) -> a -> b $ [ParsecT [Tok] (IPState m) (StateT Enders m) Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall s (m :: * -> *) t u a. Stream s m t => [ParsecT s u m a] -> ParsecT s u m a choice [ () () -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) () 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) () -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok anyTok , ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok] whitespace ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m a lookAhead ([TokType] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => [TokType] -> ParsecT [Tok] s m Tok noneOfToks [Char -> TokType Symbol Char '$']) , [TokType] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => [TokType] -> ParsecT [Tok] s m Tok noneOfToks [Char -> TokType Symbol Char '$'] ] Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok symbol Char '$' 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 ([Tok] -> Text untokenize [Tok] toks) pDisplayMath :: (Monad m, HasMath a) => InlineParser m a pDisplayMath :: InlineParser m a pDisplayMath = 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 Int -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall s (m :: * -> *) t u a. Stream s m t => Int -> ParsecT s u m a -> ParsecT s u m [a] count Int 2 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall a b. (a -> b) -> a -> b $ Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok symbol Char '$' ([Tok] _, [Tok] toks) <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) ([Tok], [Tok]) forall (m :: * -> *) s a. Monad m => ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok]) withRaw (ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) ([Tok], [Tok])) -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) ([Tok], [Tok]) forall a b. (a -> b) -> a -> b $ ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m [a] many1 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall a b. (a -> b) -> a -> b $ [ParsecT [Tok] (IPState m) (StateT Enders m) Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall s (m :: * -> *) t u a. Stream s m t => [ParsecT s u m a] -> ParsecT s u m a choice [ () () -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) () 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) () -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok anyTok , [TokType] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => [TokType] -> ParsecT [Tok] s m Tok noneOfToks [Char -> TokType Symbol Char '$'] ] Int -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall s (m :: * -> *) t u a. Stream s m t => Int -> ParsecT s u m a -> ParsecT s u m [a] count Int 2 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok] forall a b. (a -> b) -> a -> b $ Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok symbol Char '$' 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 displayMath ([Tok] -> Text untokenize [Tok] toks)