{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.LaTeX.Math
( dollarsMath
, inlineEnvironments
, inlineEnvironment
, mathInline
, mathDisplay
, theoremstyle
, theoremEnvironment
, newtheorem
, proof
)
where
import Data.Maybe (fromMaybe, mapMaybe, listToMaybe)
import Data.List (foldl')
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Builder as B
import qualified Data.Sequence as Seq
import Text.Pandoc.Readers.LaTeX.Parsing
import Text.Pandoc.TeX
import Text.Pandoc.Class
import Text.Pandoc.Shared (trimMath, stripTrailingNewlines)
import Text.Pandoc.Parsing hiding (blankline, mathDisplay, mathInline,
optional, space, spaces, withRaw, (<|>))
import Control.Applicative ((<|>), optional)
import Control.Monad (guard, mzero)
import qualified Data.Map as M
import Data.Text (Text)
dollarsMath :: PandocMonad m => LP m Inlines
dollarsMath :: forall (m :: * -> *). PandocMonad m => LP m Inlines
dollarsMath = do
Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$'
Bool
display <- Bool
-> ParsecT TokStream LaTeXState m Bool
-> ParsecT TokStream LaTeXState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> LP m Tok -> ParsecT TokStream LaTeXState m Bool
forall a b.
a
-> ParsecT TokStream LaTeXState m b
-> ParsecT TokStream LaTeXState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$')
(do Text
contents <- ParsecT TokStream LaTeXState m Text
-> ParsecT TokStream LaTeXState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT TokStream LaTeXState m Text
-> ParsecT TokStream LaTeXState m Text)
-> ParsecT TokStream LaTeXState m Text
-> ParsecT TokStream LaTeXState m Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT TokStream LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
0
if Bool
display
then Text -> Inlines
mathDisplay Text
contents Inlines -> LP m Tok -> LP m Inlines
forall a b.
a
-> ParsecT TokStream LaTeXState m b
-> ParsecT TokStream LaTeXState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$'
else Inlines -> LP m Inlines
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
mathInline Text
contents)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall a.
ParsecT TokStream LaTeXState m a
-> ParsecT TokStream LaTeXState m a
-> ParsecT TokStream LaTeXState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> ParsecT TokStream LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
display ParsecT TokStream LaTeXState m () -> LP m Inlines -> LP m Inlines
forall a b.
ParsecT TokStream LaTeXState m a
-> ParsecT TokStream LaTeXState m b
-> ParsecT TokStream LaTeXState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> LP m Inlines
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
mathInline Text
""))
pDollarsMath :: PandocMonad m => Int -> LP m [Tok]
pDollarsMath :: forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n = do
tk :: Tok
tk@(Tok SourcePos
_ TokType
toktype Text
t) <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
case TokType
toktype of
TokType
Symbol | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"$"
, Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> [Tok] -> LP m [Tok]
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\" -> do
Tok
tk' <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP 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]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"{" -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"}" ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
else LP m [Tok]
forall a. ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
TokType
_ -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n
mathDisplay :: Text -> Inlines
mathDisplay :: Text -> Inlines
mathDisplay = Text -> Inlines
displayMath (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimMath
mathInline :: Text -> Inlines
mathInline :: Text -> Inlines
mathInline = Text -> Inlines
math (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimMath
mathEnvWith :: PandocMonad m
=> (Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith :: forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> a
f Maybe Text
innerEnv Text
name = Inlines -> a
f (Inlines -> a) -> (Text -> Inlines) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
mathDisplay (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
inner (Text -> a)
-> ParsecT TokStream LaTeXState m Text
-> ParsecT TokStream LaTeXState m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT TokStream LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
mathEnv Text
name
where inner :: Text -> Text
inner Text
x = case Maybe Text
innerEnv of
Maybe Text
Nothing -> Text
x
Just Text
y -> Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\n\\end{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
mathEnv :: PandocMonad m => Text -> LP m Text
mathEnv :: forall (m :: * -> *). PandocMonad m => Text -> LP m Text
mathEnv Text
name = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
LP m () -> ParsecT TokStream LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
blankline
[Tok]
res <- ParsecT TokStream LaTeXState m Tok
-> LP m () -> ParsecT TokStream LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT TokStream LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Text -> LP m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
name)
Text -> LP m Text
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LP m Text) -> Text -> LP m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTrailingNewlines (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
res
inlineEnvironment :: PandocMonad m => LP m Inlines
inlineEnvironment :: forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineEnvironment = ParsecT TokStream LaTeXState m Inlines
-> ParsecT TokStream LaTeXState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT TokStream LaTeXState m Inlines
-> ParsecT TokStream LaTeXState m Inlines)
-> ParsecT TokStream LaTeXState m Inlines
-> ParsecT TokStream LaTeXState m Inlines
forall a b. (a -> b) -> a -> b
$ do
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"begin"
Text
name <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
ParsecT TokStream LaTeXState m Inlines
-> Text
-> Map Text (ParsecT TokStream LaTeXState m Inlines)
-> ParsecT TokStream LaTeXState m Inlines
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ParsecT TokStream LaTeXState m Inlines
forall a. ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero Text
name Map Text (ParsecT TokStream LaTeXState m Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineEnvironments
inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
inlineEnvironments :: forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineEnvironments = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
(Text
"displaymath", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"displaymath")
, (Text
"math", Text -> Inlines
math (Text -> Inlines)
-> ParsecT TokStream LaTeXState m Text -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT TokStream LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
mathEnv Text
"math")
, (Text
"equation", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"equation")
, (Text
"equation*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"equation*")
, (Text
"gather", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"gather")
, (Text
"gather*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"gather*")
, (Text
"multline", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"multline")
, (Text
"multline*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"multline*")
, (Text
"eqnarray", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"eqnarray")
, (Text
"eqnarray*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"eqnarray*")
, (Text
"align", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"align")
, (Text
"align*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"align*")
, (Text
"alignat", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"alignat")
, (Text
"alignat*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"alignat*")
, (Text
"dmath", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"dmath")
, (Text
"dmath*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"dmath*")
, (Text
"dgroup", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"dgroup")
, (Text
"dgroup*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"dgroup*")
, (Text
"darray", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"darray")
, (Text
"darray*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"darray*")
, (Text
"subequations", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"subequations")
]
theoremstyle :: PandocMonad m => LP m Blocks
theoremstyle :: forall (m :: * -> *). PandocMonad m => LP m Blocks
theoremstyle = do
Text
stylename <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let mbstyle :: Maybe TheoremStyle
mbstyle = case Text
stylename of
Text
"plain" -> TheoremStyle -> Maybe TheoremStyle
forall a. a -> Maybe a
Just TheoremStyle
PlainStyle
Text
"definition" -> TheoremStyle -> Maybe TheoremStyle
forall a. a -> Maybe a
Just TheoremStyle
DefinitionStyle
Text
"remark" -> TheoremStyle -> Maybe TheoremStyle
forall a. a -> Maybe a
Just TheoremStyle
RemarkStyle
Text
_ -> Maybe TheoremStyle
forall a. Maybe a
Nothing
case Maybe TheoremStyle
mbstyle of
Maybe TheoremStyle
Nothing -> () -> ParsecT TokStream LaTeXState m ()
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TheoremStyle
sty -> (LaTeXState -> LaTeXState) -> ParsecT TokStream LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT TokStream LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT TokStream LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sLastTheoremStyle = sty }
Blocks -> LP m Blocks
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
newtheorem :: PandocMonad m => LP m Inlines -> LP m Blocks
newtheorem :: forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Blocks
newtheorem LP m Inlines
inline = do
Bool
number <- Bool
-> ParsecT TokStream LaTeXState m Bool
-> ParsecT TokStream LaTeXState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
True (Bool
False Bool
-> ParsecT TokStream LaTeXState m Tok
-> ParsecT TokStream LaTeXState m Bool
forall a b.
a
-> ParsecT TokStream LaTeXState m b
-> ParsecT TokStream LaTeXState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT TokStream LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*' ParsecT TokStream LaTeXState m Bool
-> ParsecT TokStream LaTeXState m ()
-> ParsecT TokStream LaTeXState m Bool
forall a b.
ParsecT TokStream LaTeXState m a
-> ParsecT TokStream LaTeXState m b
-> ParsecT TokStream LaTeXState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT TokStream LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp)
Text
name <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
ParsecT TokStream LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Maybe Text
series <- Maybe Text
-> ParsecT TokStream LaTeXState m (Maybe Text)
-> ParsecT TokStream LaTeXState m (Maybe Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Text
forall a. Maybe a
Nothing (ParsecT TokStream LaTeXState m (Maybe Text)
-> ParsecT TokStream LaTeXState m (Maybe Text))
-> ParsecT TokStream LaTeXState m (Maybe Text)
-> ParsecT TokStream LaTeXState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Maybe Text)
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
ParsecT TokStream LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Inlines
showName <- LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
tokWith LP m Inlines
inline
ParsecT TokStream LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Maybe Text
syncTo <- Maybe Text
-> ParsecT TokStream LaTeXState m (Maybe Text)
-> ParsecT TokStream LaTeXState m (Maybe Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Text
forall a. Maybe a
Nothing (ParsecT TokStream LaTeXState m (Maybe Text)
-> ParsecT TokStream LaTeXState m (Maybe Text))
-> ParsecT TokStream LaTeXState m (Maybe Text)
-> ParsecT TokStream LaTeXState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Maybe Text)
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
TheoremStyle
sty <- LaTeXState -> TheoremStyle
sLastTheoremStyle (LaTeXState -> TheoremStyle)
-> ParsecT TokStream LaTeXState m LaTeXState
-> ParsecT TokStream LaTeXState m TheoremStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let spec :: TheoremSpec
spec = TheoremSpec { theoremName :: Inlines
theoremName = Inlines
showName
, theoremStyle :: TheoremStyle
theoremStyle = TheoremStyle
sty
, theoremSeries :: Maybe Text
theoremSeries = Maybe Text
series
, theoremSyncTo :: Maybe Text
theoremSyncTo = Maybe Text
syncTo
, theoremNumber :: Bool
theoremNumber = Bool
number
, theoremLastNum :: DottedNum
theoremLastNum = [Int] -> DottedNum
DottedNum [Int
0] }
Map Text TheoremSpec
tmap <- LaTeXState -> Map Text TheoremSpec
sTheoremMap (LaTeXState -> Map Text TheoremSpec)
-> ParsecT TokStream LaTeXState m LaTeXState
-> ParsecT TokStream LaTeXState m (Map Text TheoremSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(LaTeXState -> LaTeXState) -> ParsecT TokStream LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT TokStream LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT TokStream LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sTheoremMap =
M.insert name spec tmap }
Blocks -> LP m Blocks
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
extractLabelFromBlock :: Block -> Maybe Text
(Para [Inline]
inlines) = Maybe Text -> [Inline] -> Maybe Text
extractLabel Maybe Text
forall a. Maybe a
Nothing [Inline]
inlines
where
extractLabel :: Maybe Text -> [Inline] -> Maybe Text
extractLabel = (Maybe Text -> Inline -> Maybe Text)
-> Maybe Text -> [Inline] -> Maybe Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe Text -> Inline -> Maybe Text
go
go :: Maybe Text -> Inline -> Maybe Text
go :: Maybe Text -> Inline -> Maybe Text
go (Just Text
t) Inline
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
go Maybe Text
Nothing (Span (Text
_, [Text]
_, [(Text, Text)]
attrs) [Inline]
_) = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
attrs
go Maybe Text
Nothing Inline
_ = Maybe Text
forall a. Maybe a
Nothing
extractLabelFromBlock Block
_ = Maybe Text
forall a. Maybe a
Nothing
theoremEnvironment :: PandocMonad m
=> LP m Blocks -> LP m Inlines -> Text -> LP m Blocks
theoremEnvironment :: forall (m :: * -> *).
PandocMonad m =>
LP m Blocks -> LP m Inlines -> Text -> LP m Blocks
theoremEnvironment LP m Blocks
blocks LP m Inlines
opt Text
name = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
resetCaption
Map Text TheoremSpec
tmap <- LaTeXState -> Map Text TheoremSpec
sTheoremMap (LaTeXState -> Map Text TheoremSpec)
-> ParsecT TokStream LaTeXState m LaTeXState
-> ParsecT TokStream LaTeXState m (Map Text TheoremSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT TokStream LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Text -> Map Text TheoremSpec -> Maybe TheoremSpec
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text TheoremSpec
tmap of
Maybe TheoremSpec
Nothing -> LP m Blocks
forall a. ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just TheoremSpec
tspec -> do
Inlines
optTitle <- Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ (\Inlines
x -> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"(" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
")") (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
opt
Blocks
bs <- Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
name LP m Blocks
blocks
let mblabel :: Maybe Text
mblabel = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Block -> Maybe Text) -> [Block] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Block -> Maybe Text
extractLabelFromBlock (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs)
Inlines
number <-
if TheoremSpec -> Bool
theoremNumber TheoremSpec
tspec
then do
let name' :: Text
name' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ TheoremSpec -> Maybe Text
theoremSeries TheoremSpec
tspec
DottedNum
num <- (LaTeXState -> DottedNum) -> LP m DottedNum
forall (m :: * -> *).
Monad m =>
(LaTeXState -> DottedNum) -> LP m DottedNum
getNextNumber
(DottedNum
-> (TheoremSpec -> DottedNum) -> Maybe TheoremSpec -> DottedNum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Int] -> DottedNum
DottedNum [Int
0]) TheoremSpec -> DottedNum
theoremLastNum (Maybe TheoremSpec -> DottedNum)
-> (LaTeXState -> Maybe TheoremSpec) -> LaTeXState -> DottedNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Map Text TheoremSpec -> Maybe TheoremSpec
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name' (Map Text TheoremSpec -> Maybe TheoremSpec)
-> (LaTeXState -> Map Text TheoremSpec)
-> LaTeXState
-> Maybe TheoremSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaTeXState -> Map Text TheoremSpec
sTheoremMap)
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s ->
LaTeXState
s{ sTheoremMap =
M.adjust
(\TheoremSpec
spec -> TheoremSpec
spec{ theoremLastNum = num })
name'
(sTheoremMap s)
}
case Maybe Text
mblabel of
Just Text
ident ->
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s ->
LaTeXState
s{ sLabels = M.insert ident
(B.toList $ str (renderDottedNum num)) (sLabels s) }
Maybe Text
Nothing -> () -> LP m ()
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Inlines -> LP m Inlines
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.text (DottedNum -> Text
renderDottedNum DottedNum
num)
else Inlines -> LP m Inlines
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
let titleEmph :: Inlines -> Inlines
titleEmph = case TheoremSpec -> TheoremStyle
theoremStyle TheoremSpec
tspec of
TheoremStyle
PlainStyle -> Inlines -> Inlines
B.strong
TheoremStyle
DefinitionStyle -> Inlines -> Inlines
B.strong
TheoremStyle
RemarkStyle -> Inlines -> Inlines
B.emph
let title :: Inlines
title = Inlines -> Inlines
titleEmph (TheoremSpec -> Inlines
theoremName TheoremSpec
tspec Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
number)
Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
optTitle Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space
Blocks -> LP m Blocks
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Blocks -> Blocks
divWith (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mblabel, [Text
name], [])
(Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks -> Blocks
addTitle Inlines
title
(Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ (Blocks -> Blocks)
-> (Text -> Blocks -> Blocks) -> Maybe Text -> Blocks -> Blocks
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Blocks -> Blocks
forall a. a -> a
id Text -> Blocks -> Blocks
forall a. Walkable [Inline] a => Text -> a -> a
removeLabel Maybe Text
mblabel
(Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ case TheoremSpec -> TheoremStyle
theoremStyle TheoremSpec
tspec of
TheoremStyle
PlainStyle -> (Block -> Block) -> Blocks -> Blocks
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
italicize Blocks
bs
TheoremStyle
_ -> Blocks
bs
proof :: PandocMonad m => LP m Blocks -> LP m Inlines -> LP m Blocks
proof :: forall (m :: * -> *).
PandocMonad m =>
LP m Blocks -> LP m Inlines -> LP m Blocks
proof LP m Blocks
blocks LP m Inlines
opt = do
Inlines
title <- Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> Inlines
B.text Text
"Proof") LP m Inlines
opt
Blocks
bs <- Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"proof" LP m Blocks
blocks
Blocks -> LP m Blocks
forall a. a -> ParsecT TokStream LaTeXState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$
(Text, [Text], [(Text, Text)]) -> Blocks -> Blocks
B.divWith (Text
"", [Text
"proof"], []) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
Blocks -> Blocks
addQed (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks -> Blocks
addTitle (Inlines -> Inlines
B.emph (Inlines
title Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
".")) Blocks
bs
addTitle :: Inlines -> Blocks -> Blocks
addTitle :: Inlines -> Blocks -> Blocks
addTitle Inlines
ils Blocks
bs =
case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
(Para [Inline]
xs : [Block]
rest)
-> [Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Inline] -> Block
Para (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs)) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest)
[Block]
_ -> Inlines -> Blocks
B.para Inlines
ils Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs
addQed :: Blocks -> Blocks
addQed :: Blocks -> Blocks
addQed Blocks
bs =
case Seq Block -> ViewR Block
forall a. Seq a -> ViewR a
Seq.viewr (Blocks -> Seq Block
forall a. Many a -> Seq a
B.unMany Blocks
bs) of
Seq Block
s Seq.:> Para [Inline]
ils
-> Seq Block -> Blocks
forall a. Seq a -> Many a
B.Many (Seq Block
s Seq Block -> Block -> Seq Block
forall a. Seq a -> a -> Seq a
Seq.|> [Inline] -> Block
Para ([Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
qedSign))
ViewR Block
_ -> Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Inlines -> Blocks
B.para Inlines
qedSign
where
qedSign :: Inlines
qedSign = Text -> Inlines
B.str Text
"\xa0\x25FB"
italicize :: Block -> Block
italicize :: Block -> Block
italicize x :: Block
x@(Para [Image{}]) = Block
x
italicize x :: Block
x@(Plain [Image{}]) = Block
x
italicize (Para [Inline]
ils) = [Inline] -> Block
Para [[Inline] -> Inline
Emph [Inline]
ils]
italicize (Plain [Inline]
ils) = [Inline] -> Block
Plain [[Inline] -> Inline
Emph [Inline]
ils]
italicize Block
x = Block
x