{-# 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
'$'
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 contents <- try $ untokenize <$> pDollarsMath 0
if display
then mathDisplay contents <$ symbol '$'
else return $ mathInline contents)
<|> (guard display >> return (mathInline ""))
pDollarsMath :: PandocMonad m => Int -> LP m [Tok]
pDollarsMath :: forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n = do
tk@(Tok _ toktype t) <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
case 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] -> ParsecT TokStream LaTeXState 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
tk' <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
(tk :) . (tk' :) <$> pDollarsMath 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])
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m [Tok]
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
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])
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m [Tok]
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
else ParsecT TokStream LaTeXState 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])
-> ParsecT TokStream LaTeXState m [Tok]
-> ParsecT TokStream LaTeXState m [Tok]
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
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
ParsecT TokStream LaTeXState m ()
-> ParsecT TokStream LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT TokStream LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
blankline
res <- ParsecT TokStream LaTeXState m Tok
-> ParsecT TokStream LaTeXState 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 -> ParsecT TokStream LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
name)
return $ stripTrailingNewlines $ untokenize 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"
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
M.findWithDefault mzero name 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
"flalign", (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
"flalign")
, (Text
"flalign*", (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
"flalign*")
, (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
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 = 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 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 }
return 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
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)
name <- untokenize <$> braced
sp
series <- option Nothing $ Just . untokenize <$> bracketedToks
sp
showName <- tokWith inline
sp
syncTo <- option Nothing $ Just . untokenize <$> bracketedToks
sty <- sLastTheoremStyle <$> getState
let 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] }
tmap <- sTheoremMap <$> getState
updateState $ \LaTeXState
s -> LaTeXState
s{ sTheoremMap =
M.insert name spec tmap }
return 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
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 M.lookup name 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
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
bs <- env name blocks
let 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)
number <-
if theoremNumber tspec
then do
let 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
num <- getNextNumber
(maybe (DottedNum [0]) theoremLastNum .
M.lookup name' . sTheoremMap)
updateState $ \LaTeXState
s ->
LaTeXState
s{ sTheoremMap =
M.adjust
(\TheoremSpec
spec -> TheoremSpec
spec{ theoremLastNum = num })
name'
(sTheoremMap s)
}
case 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 ()
return $ space <> B.text (renderDottedNum num)
else return mempty
let 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 -> 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
return $ divWith (fromMaybe "" mblabel, [name], [])
$ addTitle title
$ maybe id removeLabel mblabel
$ case theoremStyle 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
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
bs <- env "proof" blocks
return $
B.divWith ("", ["proof"], []) $
addQed $ addTitle (B.emph (title <> ".")) 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