{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
Module      : Text.Pandoc.Parsing.Math
Copyright   : © 2006-2024 John MacFarlane
License     : GPL-2.0-or-later
Maintainer  : John MacFarlane <jgm@berkeley.edu>

Parsing of LaTeX math.
-}

module Text.Pandoc.Parsing.Math
  ( mathDisplay
  , mathInline
  )
where

import Control.Monad (mzero, when)
import Data.Text (Text)
import Text.Parsec ((<|>), ParsecT, Stream(..), notFollowedBy, many1, try)
import Text.Pandoc.Options
  ( Extension(Ext_tex_math_dollars, Ext_tex_math_single_backslash,
              Ext_tex_math_double_backslash) )
import Text.Pandoc.Parsing.Capabilities (HasReaderOptions, guardEnabled)
import Text.Pandoc.Parsing.General
import Text.Pandoc.Shared (trimMath)
import Text.Pandoc.Sources
  (UpdateSourcePos, anyChar, char, digit, newline, satisfy, space, string)

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB

mathInlineWith :: (Stream s m Char, UpdateSourcePos s Char)  => Text -> Text -> ParsecT s st m Text
mathInlineWith :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathInlineWith Text
op Text
cl = ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Text -> ParsecT s st m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
op
  Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"$") (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space
  words' <- ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m [Text]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till (
                       (Char -> Text
T.singleton (Char -> Text) -> ParsecT s st m Char -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpaceChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')))
                   ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s st m Char -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           -- This next clause is needed because \text{..} can
                           -- contain $, \(\), etc.
                           (ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s st m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"text" ParsecT s st m String -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                 ((Text
"\\text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ParsecT s st m Text -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Text -> ParsecT s st m Text
inBalancedBraces Int
0 Text
""))
                            ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>  (\Char
c -> String -> Text
T.pack [Char
'\\',Char
c]) (Char -> Text) -> ParsecT s st m Char -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar))
                   ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"\n" Text -> ParsecT s st m Char -> ParsecT s st m Text
forall a b. a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline ParsecT s st m Text -> ParsecT s st m () -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParsecT s st m b -> ParsecT s st m ()
notFollowedBy' ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline ParsecT s st m Text -> ParsecT s st m () -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'$'))
                   ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Text
T.pack (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT s st m Text -> ParsecT s st m () -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'$'))
                    ) (ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT s st m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
cl)
  notFollowedBy digit  -- to prevent capture of $5
  return $ trimMath $ T.concat words'
 where
  inBalancedBraces :: (Stream s m Char, UpdateSourcePos s Char)
                   => Int -> Text -> ParsecT s st m Text
  inBalancedBraces :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Text -> ParsecT s st m Text
inBalancedBraces Int
n Text
t =
    LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TB.toLazyText (Builder -> Text) -> ParsecT s st m Builder -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
go Int
n Bool
False (Text -> Builder
TB.fromText Text
t) (Bool -> Bool
not (Text -> Bool
T.null Text
t))

  -- go depth lastWasBackslash accumulator started
  go :: (Stream s m Char, UpdateSourcePos s Char)
     => Int -> Bool -> TB.Builder -> Bool -> ParsecT s st m TB.Builder
  go :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
go Int
0 Bool
_ Builder
acc Bool
False = do
    c <- ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
    if c == '{'
       then go 1 False (acc <> TB.singleton '{') True
       else mzero
  go Int
0 Bool
_ Builder
acc Bool
True = Builder -> ParsecT s st m Builder
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
acc
  go Int
depth Bool
True Builder
acc Bool
_ = do
    c <- ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
    go depth False (acc <> TB.singleton c) True
  go Int
depth Bool
False Builder
acc Bool
_ = do
    c <- ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
    let acc' = Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
c
    case c of
         Char
'\\' -> Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
go Int
depth Bool
True Builder
acc' Bool
True
         Char
'}'  -> Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
False Builder
acc' Bool
True
         Char
'{'  -> Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool
False Builder
acc' Bool
True
         Char
_    -> Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> Bool -> Builder -> Bool -> ParsecT s st m Builder
go Int
depth Bool
False Builder
acc' Bool
True

mathDisplayWith :: (Stream s m Char, UpdateSourcePos s Char) => Text -> Text -> ParsecT s st m Text
mathDisplayWith :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathDisplayWith Text
op Text
cl = ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall a b. (a -> b) -> ParsecT s st m a -> ParsecT s st m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParsecT s st m Text)
-> ParsecT s st m String -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Text -> ParsecT s st m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
op
  ParsecT s st m Char -> ParsecT s st m Text -> ParsecT s st m String
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ((Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT s st m Char -> ParsecT s st m () -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParsecT s st m b -> ParsecT s st m ()
notFollowedBy' ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline))
            (ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT s st m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
cl)

mathDisplay :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
            => ParsecT s st m Text
mathDisplay :: forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
mathDisplay =
      (Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_tex_math_dollars ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathDisplayWith Text
"$$" Text
"$$")
  ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_tex_math_single_backslash ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathDisplayWith Text
"\\[" Text
"\\]")
  ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_tex_math_double_backslash ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathDisplayWith Text
"\\\\[" Text
"\\\\]")

mathInline :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
           => ParsecT s st m Text
mathInline :: forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
mathInline =
      (Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_tex_math_dollars ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathInlineWith Text
"$" Text
"$")
  ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_tex_math_single_backslash ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathInlineWith Text
"\\(" Text
"\\)")
  ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_tex_math_double_backslash ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> Text -> ParsecT s st m Text
mathInlineWith Text
"\\\\(" Text
"\\\\)")