LaTeX reader: support ams proof environment.

2 files changed, 37 insertions, 0 deletions

diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 9543f635d..ac9b8b43b 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -35,6 +35,7 @@ import Data.List (intercalate)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, maybeToList)
 import qualified Data.Set as Set
+import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as T
 import System.FilePath (addExtension, replaceExtension, takeExtension)
@@ -1845,6 +1846,8 @@ environments = M.fromList
    , ("tikzcd", rawVerbEnv "tikzcd")
    , ("lilypond", rawVerbEnv "lilypond")
    , ("ly", rawVerbEnv "ly")
+   -- amsthm
+   , ("proof", amsProof)
    -- etoolbox
    , ("ifstrequal", ifstrequal)
    , ("newtoggle", braced >>= newToggle)
@@ -1853,6 +1856,30 @@ environments = M.fromList
    , ("iftoggle", try $ ifToggle >> block)
    ]
 
+amsProof :: PandocMonad m => LP m Blocks
+amsProof = do
+  title <- option (B.text "Proof") opt
+  bs <- env "proof" blocks
+  return $
+    B.divWith ("", ["proof"], []) $
+      addQed $ addTitle (B.emph (title <> ".")) $ bs
+
+addTitle :: Inlines -> Blocks -> Blocks
+addTitle ils bs =
+  case B.toList bs of
+    (Para xs : rest)
+      -> B.fromList (Para (B.toList ils ++ (Space : xs)) : rest)
+    _ -> B.para ils <> bs
+
+addQed :: Blocks -> Blocks
+addQed bs =
+  case Seq.viewr (B.unMany bs) of
+    s Seq.:> Para ils
+      -> B.Many (s Seq.|> Para (ils ++ B.toList qedSign))
+    _ -> bs <> B.para qedSign
+ where
+  qedSign = B.spanWith ("",["qed"],[]) "\x220E"
+
 environment :: PandocMonad m => LP m Blocks
 environment = try $ do
   controlSeq "begin"
diff --git a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs
index 06df54116..26a88c13e 100644
--- a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs
+++ b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs
@@ -18,6 +18,7 @@ module Text.Pandoc.Readers.LaTeX.Parsing
   ( DottedNum(..)
   , renderDottedNum
   , incrementDottedNum
+  , TheoremSpec(..)
   , LaTeXState(..)
   , defaultLaTeXState
   , LP
@@ -114,6 +115,13 @@ incrementDottedNum level (DottedNum ns) = DottedNum $
        (x:xs) -> reverse (x+1 : xs)
        []     -> []  -- shouldn't happen
 
+data TheoremSpec =
+  TheoremSpec
+    { theoremName    :: Text
+    , theoremSeries  :: Maybe Text
+    , theoremLastNum :: DottedNum }
+    deriving (Show)
+
 data LaTeXState = LaTeXState{ sOptions       :: ReaderOptions
                             , sMeta          :: Meta
                             , sQuoteContext  :: QuoteContext
@@ -128,6 +136,7 @@ data LaTeXState = LaTeXState{ sOptions       :: ReaderOptions
                             , sLastHeaderNum :: DottedNum
                             , sLastFigureNum :: DottedNum
                             , sLastTableNum  :: DottedNum
+                            , sTheoremMap    :: M.Map Text TheoremSpec
                             , sLastLabel     :: Maybe Text
                             , sLabels        :: M.Map Text [Inline]
                             , sHasChapters   :: Bool
@@ -151,6 +160,7 @@ defaultLaTeXState = LaTeXState{ sOptions       = def
                               , sLastHeaderNum = DottedNum []
                               , sLastFigureNum = DottedNum []
                               , sLastTableNum  = DottedNum []
+                              , sTheoremMap    = M.empty
                               , sLastLabel     = Nothing
                               , sLabels        = M.empty
                               , sHasChapters   = False