{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.LaTeX.Math
  ( dollarsMath
  , inlineEnvironments
  , inlineEnvironment
  , mathInline
  , mathDisplay
  , theoremstyle
  , theoremEnvironment
  , newtheorem
  , proof
  )
where
import Data.Maybe (fromMaybe)
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
  forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$'
  Bool
display <- 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$')
  (do Text
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
0
      if Bool
display
         then Text -> Inlines
mathDisplay Text
contents forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$'
         else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
mathInline Text
contents)
   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
display forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
mathInline Text
""))

-- Int is number of embedded groupings
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) <- forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
  case TokType
toktype of
       TokType
Symbol | Text
t forall a. Eq a => a -> a -> Bool
== Text
"$"
              , Int
n forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
              | Text
t forall a. Eq a => a -> a -> Bool
== Text
"\\" -> do
                  Tok
tk' <- forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
                  (Tok
tk forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok
tk' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n
              | Text
t forall a. Eq a => a -> a -> Bool
== Text
"{" -> (Tok
tk forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath (Int
nforall a. Num a => a -> a -> a
+Int
1)
              | Text
t forall a. Eq a => a -> a -> Bool
== Text
"}" ->
                if Int
n forall a. Ord a => a -> a -> Bool
> Int
0
                then (Tok
tk forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath (Int
nforall a. Num a => a -> a -> a
-Int
1)
                else forall (m :: * -> *) a. MonadPlus m => m a
mzero
       TokType
_ -> (Tok
tk forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n

mathDisplay :: Text -> Inlines
mathDisplay :: Text -> Inlines
mathDisplay = Text -> Inlines
displayMath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimMath

mathInline :: Text -> Inlines
mathInline :: Text -> Inlines
mathInline = Text -> Inlines
math 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
mathDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
inner forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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{" forall a. Semigroup a => a -> a -> a
<> Text
y forall a. Semigroup a => a -> a -> a
<> Text
"}\n" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<>
                                   Text
"\n\\end{" forall a. Semigroup a => a -> a -> a
<> Text
y 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
  forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (m :: * -> *). PandocMonad m => LP m ()
blankline
  [Tok]
res <- 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 forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
name)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTrailingNewlines 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"begin"
  Text
name <- [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall (m :: * -> *) a. MonadPlus m => m a
mzero Text
name 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 = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
    (Text
"displaymath", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id forall a. Maybe a
Nothing Text
"displaymath")
  , (Text
"math", Text -> Inlines
math forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Text -> LP m Text
mathEnv Text
"math")
  , (Text
"equation", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id forall a. Maybe a
Nothing Text
"equation")
  , (Text
"equation*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id forall a. Maybe a
Nothing Text
"equation*")
  , (Text
"gather", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"gathered") Text
"gather")
  , (Text
"gather*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"gathered") Text
"gather*")
  , (Text
"multline", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"gathered") Text
"multline")
  , (Text
"multline*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"gathered") Text
"multline*")
  , (Text
"eqnarray", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"eqnarray")
  , (Text
"eqnarray*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"eqnarray*")
  , (Text
"align", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"align")
  , (Text
"align*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"align*")
  , (Text
"alignat", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"alignat")
  , (Text
"alignat*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"alignat*")
  , (Text
"dmath", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id forall a. Maybe a
Nothing Text
"dmath")
  , (Text
"dmath*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id forall a. Maybe a
Nothing Text
"dmath*")
  , (Text
"dgroup", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"dgroup")
  , (Text
"dgroup*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"dgroup*")
  , (Text
"darray", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"darray")
  , (Text
"darray*", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"aligned") Text
"darray*")
  , (Text
"subequations", forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith forall a. a -> a
id 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  let mbstyle :: Maybe TheoremStyle
mbstyle = case Text
stylename of
                  Text
"plain"      -> forall a. a -> Maybe a
Just TheoremStyle
PlainStyle
                  Text
"definition" -> forall a. a -> Maybe a
Just TheoremStyle
DefinitionStyle
                  Text
"remark"     -> forall a. a -> Maybe a
Just TheoremStyle
RemarkStyle
                  Text
_            -> forall a. Maybe a
Nothing
  case Maybe TheoremStyle
mbstyle of
    Maybe TheoremStyle
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just TheoremStyle
sty -> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sLastTheoremStyle :: TheoremStyle
sLastTheoremStyle = TheoremStyle
sty }
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). PandocMonad m => LP m ()
sp)
  Text
name <- [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  forall (m :: * -> *). PandocMonad m => LP m ()
sp
  Maybe Text
series <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
  forall (m :: * -> *). PandocMonad m => LP m ()
sp
  Inlines
showName <- forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
tokWith LP m Inlines
inline
  forall (m :: * -> *). PandocMonad m => LP m ()
sp
  Maybe Text
syncTo <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
  TheoremStyle
sty <- LaTeXState -> TheoremStyle
sLastTheoremStyle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sTheoremMap :: Map Text TheoremSpec
sTheoremMap =
                            forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
name TheoremSpec
spec Map Text TheoremSpec
tmap }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

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
  forall (m :: * -> *). PandocMonad m => LP m ()
resetCaption
  Map Text TheoremSpec
tmap <- LaTeXState -> Map Text TheoremSpec
sTheoremMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text TheoremSpec
tmap of
    Maybe TheoremSpec
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Just TheoremSpec
tspec -> do
       Inlines
optTitle <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (\Inlines
x -> Inlines
space forall a. Semigroup a => a -> a -> a
<> Inlines
"(" forall a. Semigroup a => a -> a -> a
<> Inlines
x forall a. Semigroup a => a -> a -> a
<> Inlines
")") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
opt
       Blocks
bs <- forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
name LP m Blocks
blocks
       Maybe Text
mblabel <- LaTeXState -> Maybe Text
sLastLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

       Inlines
number <-
         if TheoremSpec -> Bool
theoremNumber TheoremSpec
tspec
            then do
               let name' :: Text
name' = forall a. a -> Maybe a -> a
fromMaybe Text
name forall a b. (a -> b) -> a -> b
$ TheoremSpec -> Maybe Text
theoremSeries TheoremSpec
tspec
               DottedNum
num <- forall (m :: * -> *).
Monad m =>
(LaTeXState -> DottedNum) -> LP m DottedNum
getNextNumber
                   (forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Int] -> DottedNum
DottedNum [Int
0]) TheoremSpec -> DottedNum
theoremLastNum forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name' forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaTeXState -> Map Text TheoremSpec
sTheoremMap)
               forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \LaTeXState
s ->
                 LaTeXState
s{ sTheoremMap :: Map Text TheoremSpec
sTheoremMap =
                       forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
                       (\TheoremSpec
spec -> TheoremSpec
spec{ theoremLastNum :: DottedNum
theoremLastNum = DottedNum
num })
                       Text
name'
                       (LaTeXState -> Map Text TheoremSpec
sTheoremMap LaTeXState
s)
                  }

               case Maybe Text
mblabel of
                 Just Text
ident ->
                   forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \LaTeXState
s ->
                     LaTeXState
s{ sLabels :: Map Text [Inline]
sLabels = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident
                         (forall a. Many a -> [a]
B.toList forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (DottedNum -> Text
renderDottedNum DottedNum
num)) (LaTeXState -> Map Text [Inline]
sLabels LaTeXState
s) }
                 Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines
space forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.text (DottedNum -> Text
renderDottedNum DottedNum
num)
            else forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Semigroup a => a -> a -> a
<> Inlines
number)
                      forall a. Semigroup a => a -> a -> a
<> Inlines
optTitle forall a. Semigroup a => a -> a -> a
<> Inlines
"." forall a. Semigroup a => a -> a -> a
<> Inlines
space
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mblabel, [Text
name], [])
              forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks -> Blocks
addTitle Inlines
title
              forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Walkable [Inline] a => Text -> a -> a
removeLabel Maybe Text
mblabel
              forall a b. (a -> b) -> a -> b
$ case TheoremSpec -> TheoremStyle
theoremStyle TheoremSpec
tspec of
                  TheoremStyle
PlainStyle -> 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 <- 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 <- forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"proof" LP m Blocks
blocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    Attr -> Blocks -> Blocks
B.divWith (Text
"", [Text
"proof"], []) forall a b. (a -> b) -> a -> b
$
      Blocks -> Blocks
addQed forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks -> Blocks
addTitle (Inlines -> Inlines
B.emph (Inlines
title forall a. Semigroup a => a -> a -> a
<> Inlines
".")) Blocks
bs

addTitle :: Inlines -> Blocks -> Blocks
addTitle :: Inlines -> Blocks -> Blocks
addTitle Inlines
ils Blocks
bs =
  case forall a. Many a -> [a]
B.toList Blocks
bs of
    (Para [Inline]
xs : [Block]
rest)
      -> forall a. [a] -> Many a
B.fromList ([Inline] -> Block
Para (forall a. Many a -> [a]
B.toList Inlines
ils forall a. [a] -> [a] -> [a]
++ (Inline
Space forall a. a -> [a] -> [a]
: [Inline]
xs)) forall a. a -> [a] -> [a]
: [Block]
rest)
    [Block]
_ -> Inlines -> Blocks
B.para Inlines
ils forall a. Semigroup a => a -> a -> a
<> Blocks
bs

addQed :: Blocks -> Blocks
addQed :: Blocks -> Blocks
addQed Blocks
bs =
  case forall a. Seq a -> ViewR a
Seq.viewr (forall a. Many a -> Seq a
B.unMany Blocks
bs) of
    Seq Block
s Seq.:> Para [Inline]
ils
      -> forall a. Seq a -> Many a
B.Many (Seq Block
s forall a. Seq a -> a -> Seq a
Seq.|> [Inline] -> Block
Para ([Inline]
ils forall a. [a] -> [a] -> [a]
++ forall a. Many a -> [a]
B.toList Inlines
qedSign))
    ViewR Block
_ -> Blocks
bs 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 -- see #6925
italicize x :: Block
x@(Plain [Image{}]) = Block
x -- ditto
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