{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
Module      : Text.Pandoc.Parsing.Math
Copyright   : © 2006-2023 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, skipMany, 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

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
  [Text]
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 ([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]
string [Char]
"text" 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
>>
                                 ((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 -> [Char] -> 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
<|> do (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 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 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 s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar 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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany 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 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
'$')
                          Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
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)
  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
digit  -- to prevent capture of $5
  Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT s st m Text) -> Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimMath (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
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 = ([Char] -> Text) -> ParsecT s st m [Char] -> 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 [Char] -> Text
T.pack (ParsecT s st m [Char] -> ParsecT s st m Text)
-> (Text -> ParsecT s st m [Char]) -> Text -> ParsecT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> ParsecT s st m [Char]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' Int
n ([Char] -> ParsecT s st m [Char])
-> (Text -> [Char]) -> Text -> ParsecT s st m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

  inBalancedBraces' :: (Stream s m Char, UpdateSourcePos s Char) => Int -> String -> ParsecT s st m String
  inBalancedBraces' :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' Int
0 [Char]
"" = do
    Char
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 Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
       then Int -> [Char] -> ParsecT s st m [Char]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' Int
1 [Char]
"{"
       else ParsecT s st m [Char]
forall a. ParsecT s st m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  inBalancedBraces' Int
0 [Char]
s = [Char] -> ParsecT s st m [Char]
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT s st m [Char])
-> [Char] -> ParsecT s st m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
s
  inBalancedBraces' Int
numOpen (Char
'\\':[Char]
xs) = do
    Char
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
    Int -> [Char] -> ParsecT s st m [Char]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' Int
numOpen (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)
  inBalancedBraces' Int
numOpen [Char]
xs = do
    Char
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
    case Char
c of
         Char
'}' -> Int -> [Char] -> ParsecT s st m [Char]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' (Int
numOpen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)
         Char
'{' -> Int -> [Char] -> ParsecT s st m [Char]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' (Int
numOpen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)
         Char
_   -> Int -> [Char] -> ParsecT s st m [Char]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Int -> [Char] -> ParsecT s st m [Char]
inBalancedBraces' Int
numOpen (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)

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
$ ([Char] -> Text) -> ParsecT s st m [Char] -> 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 [Char] -> Text
T.pack (ParsecT s st m [Char] -> ParsecT s st m Text)
-> ParsecT s st m [Char] -> 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 [Char]
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
"\\\\)")