    {-# 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 = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxInlineParsers = [withAttributes 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 a b. a -> WithSourceMap b -> WithSourceMap a
    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 a b. a -> WithSourceMap b -> WithSourceMap a
    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 = ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] (IPState m) (StateT Enders m) a
     -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders 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
    '$'
      display <- (Bool
    True Bool
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Bool
    forall a b.
    a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) b
    -> ParsecT [Tok] (IPState m) (StateT Enders 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
    '$') 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 a b.
    a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) b
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    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)
      contents <- try $ untokenize <$> pDollarsMath 0
      let isWs Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\t' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\r' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n'
      if display
         then displayMath contents <$ symbol '$'
         else if T.null contents || isWs (T.last contents)
                 -- don't allow math to end with SPACE + $
                 then mzero
                 else return $ inlineMath 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 toktype _ _) <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
    anyTok
      case toktype of
           Symbol Char
    '$'
                  | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 -> [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
           Symbol Char
    '\\' -> do
                  tk' <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
    anyTok
                  (tk :) . (tk' :) <$> pDollarsMath n
           Symbol Char
    '{' -> (Tok
    tk Tok -> [Tok] -> [Tok]
    forall a. a -> [a] -> [a]
    :) ([Tok] -> [Tok])
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    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
    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])
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    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
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                      | Bool
    otherwise -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    forall a. ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
           TokType
    _ -> (Tok
    tk Tok -> [Tok] -> [Tok]
    forall a. a -> [a] -> [a]
    :) ([Tok] -> [Tok])
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    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
    n