Add endnotes support

Author: Alexander Krotov

data/docx/word/styles.xml

@@ -337,6 +337,14 @@
     <w:unhideWhenUsed />
     <w:qFormat />
   </w:style>
+  <w:style w:type="paragraph" w:styleId="EndnoteText">
+    <w:name w:val="Endnote Text" />
+    <w:basedOn w:val="Normal" />
+    <w:next w:val="EndnoteText" />
+    <w:uiPriority w:val="9" />
+    <w:unhideWhenUsed />
+    <w:qFormat />
+  </w:style>
   <w:style w:type="character" w:default="1" w:styleId="DefaultParagraphFont">
     <w:name w:val="Default Paragraph Font" />
     <w:semiHidden />
@@ -428,6 +436,13 @@
       <w:vertAlign w:val="superscript" />
     </w:rPr>
   </w:style>
+  <w:style w:type="character" w:styleId="EndnoteReference">
+    <w:name w:val="Endnote Reference" />
+    <w:basedOn w:val="BodyTextChar" />
+    <w:rPr>
+      <w:vertAlign w:val="superscript" />
+    </w:rPr>
+  </w:style>
   <w:style w:type="character" w:styleId="Hyperlink">
     <w:name w:val="Hyperlink" />
     <w:basedOn w:val="BodyTextChar" />

data/pandoc.lua

@@ -631,11 +631,14 @@ M.InlineMath = M.Inline:create_constructor(
 
 --- Creates a Note inline element
 -- @function Note
--- @tparam      {Block,...} content     footnote block content
+-- @tparam      "Footnote"|"Endnote"    note type
+-- @tparam      {Block,...} content     note block content
 M.Note = M.Inline:create_constructor(
   "Note",
-  function(content) return {c = ensureList(content)} end,
-  "content"
+  function(notetype, content)
+      return {c = {notetype, ensureList(content)}}
+  end,
+  {"notetype", "content"}
 )
 
 --- Creates a Quoted inline element given the quote type and quoted content.

src/Text/Pandoc/Lua/StackInstances.hs

@@ -135,6 +135,11 @@ instance Pushable QuoteType where
 instance Peekable QuoteType where
   peek = Lua.peekRead
 
+instance Pushable NoteType where
+  push = Lua.push . show
+instance Peekable NoteType where
+  peek = Lua.peekRead
+
 -- | Push an meta value element to the top of the lua stack.
 pushMetaValue :: MetaValue -> Lua ()
 pushMetaValue = \case
@@ -234,7 +239,7 @@ pushInline = \case
   Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)
   LineBreak                -> pushViaConstructor "LineBreak"
   Link attr lst (src,tit)  -> pushViaConstructor "Link" lst src tit (LuaAttr attr)
-  Note blcks               -> pushViaConstructor "Note" blcks
+  Note t blcks             -> pushViaConstructor "Note" t blcks
   Math mty str             -> pushViaConstructor "Math" mty str
   Quoted qt inlns          -> pushViaConstructor "Quoted" qt inlns
   RawInline f cs           -> pushViaConstructor "RawInline" f cs
@@ -261,7 +266,7 @@ peekInline idx = defineHowTo "get Inline value" $ do
     "Link"       -> (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
                     <$> elementContent
     "LineBreak"  -> return LineBreak
-    "Note"       -> Note <$> elementContent
+    "Note"       -> uncurry Note <$> elementContent
     "Math"       -> uncurry Math <$> elementContent
     "Quoted"     -> uncurry Quoted <$> elementContent
     "RawInline"  -> uncurry RawInline <$> elementContent

src/Text/Pandoc/Readers/Docx.hs

@@ -68,7 +68,7 @@ implemented, [-] means partially implemented):
   - [X] Link (links to an arbitrary bookmark create a span with the target as
         id and "anchor" class)
   - [X] Image
-  - [X] Note (Footnotes and Endnotes are silently combined.)
+  - [X] Note
 -}
 
 module Text.Pandoc.Readers.Docx
@@ -333,12 +333,12 @@ runToInlines (Run rs runElems)
       let ils = smushInlines (map runElemToInlines runElems)
       transform <- runStyleToTransform rPr
       return $ transform ils
-runToInlines (Footnote bps) = do
+runToInlines (RunFootnote bps) = do
   blksList <- smushBlocks <$> mapM bodyPartToBlocks bps
   return $ note blksList
-runToInlines (Endnote bps) = do
+runToInlines (RunEndnote bps) = do
   blksList <- smushBlocks <$> mapM bodyPartToBlocks bps
-  return $ note blksList
+  return $ endNote blksList
 runToInlines (InlineDrawing fp title alt bs ext) = do
   (lift . lift) $ P.insertMedia fp Nothing bs
   return $ imageWith (extentToAttr ext) fp title $ text alt

src/Text/Pandoc/Readers/Docx/Parse.hs

@@ -285,8 +285,8 @@ data ParPart = PlainRun Run
              deriving Show
 
 data Run = Run RunStyle [RunElem]
-         | Footnote [BodyPart]
-         | Endnote [BodyPart]
+         | RunFootnote [BodyPart]
+         | RunEndnote [BodyPart]
          | InlineDrawing FilePath String String B.ByteString Extent -- title, alt
          | InlineChart          -- placeholder
            deriving Show
@@ -918,16 +918,16 @@ childElemToRun ns element
     notes <- asks envNotes
     case lookupFootnote fnId notes of
       Just e -> do bps <- local (\r -> r {envLocation=InFootnote}) $ mapD (elemToBodyPart ns) (elChildren e)
-                   return $ Footnote bps
-      Nothing  -> return $ Footnote []
+                   return $ RunFootnote bps
+      Nothing  -> return $ RunFootnote []
 childElemToRun ns element
   | isElem ns "w" "endnoteReference" element
   , Just enId <- findAttrByName ns "w" "id" element = do
     notes <- asks envNotes
     case lookupEndnote enId notes of
       Just e -> do bps <- local (\r -> r {envLocation=InEndnote}) $ mapD (elemToBodyPart ns) (elChildren e)
-                   return $ Endnote bps
-      Nothing  -> return $ Endnote []
+                   return $ RunEndnote bps
+      Nothing  -> return $ RunEndnote []
 childElemToRun _ _ = throwError WrongElem
 
 elemToRun :: NameSpaces -> Element -> D Run

src/Text/Pandoc/Readers/HTML.hs

@@ -115,7 +115,7 @@ replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]
 replaceNotes = walkM replaceNotes'
 
 replaceNotes' :: PandocMonad m => Inline -> TagParser m Inline
-replaceNotes' (RawInline (Format "noteref") ref) = maybe (Str "") (Note . B.toList) . lookup ref <$> getNotes
+replaceNotes' (RawInline (Format "noteref") ref) = maybe (Str "") (Note Footnote . B.toList) . lookup ref <$> getNotes
   where
     getNotes = noteTable <$> getState
 replaceNotes' x = return x

src/Text/Pandoc/Readers/Muse.hs

@@ -468,11 +468,21 @@ paraUntil end = do
   guard $ not inPara
   first (fmap B.para) <$> paraContentsUntil end
 
-noteMarker :: PandocMonad m => MuseParser m String
-noteMarker = try $ (:)
-  <$  char '['
-  <*> oneOf "123456789"
-  <*> manyTill digit (char ']')
+noteBrackets :: NoteType -> (Char, Char)
+noteBrackets nt =
+  case nt of
+    Endnote -> ('{', '}')
+    _       -> ('[', ']')
+
+noteMarker :: PandocMonad m => NoteType -> MuseParser m (NoteType, String)
+noteMarker nt = try $ do
+  char l
+  m <- (:) <$> oneOf "123456789" <*> manyTill digit (char r)
+  return (nt, [l] ++ m ++ [r])
+  where (l, r) = noteBrackets nt
+
+anyNoteMarker :: PandocMonad m => MuseParser m (NoteType, String)
+anyNoteMarker = noteMarker Footnote <|> noteMarker Endnote
 
 addNote :: PandocMonad m
         => String
@@ -492,7 +502,7 @@ amuseNoteBlockUntil :: PandocMonad m
                     -> MuseParser m (F Blocks, a)
 amuseNoteBlockUntil end = try $ do
   guardEnabled Ext_amuse
-  ref <- noteMarker
+  (_, ref) <- anyNoteMarker
   pos <- getPosition
   void spaceChar <|> lookAhead eol
   (content, e) <- allowPara $ listItemContentsUntil (sourceColumn pos) (fail "x") end
@@ -504,14 +514,14 @@ amuseNoteBlockUntil end = try $ do
 emacsNoteBlock :: PandocMonad m => MuseParser m (F Blocks)
 emacsNoteBlock = try $ do
   guardDisabled Ext_amuse
-  ref <- noteMarker
+  (_, ref) <- anyNoteMarker
   pos <- getPosition
   content <- fmap mconcat blocksTillNote
   addNote ref pos content
   return mempty
   where
     blocksTillNote =
-      many1Till parseBlock (eof <|> () <$ lookAhead noteMarker)
+      many1Till parseBlock (eof <|> () <$ lookAhead anyNoteMarker)
 
 --
 -- Verse markup
@@ -750,15 +760,15 @@ footnote :: PandocMonad m => MuseParser m (F Inlines)
 footnote = try $ do
   inLink <- asks museInLink
   guard $ not inLink
-  ref <- noteMarker
+  (notetype, ref) <- anyNoteMarker
   return $ do
     notes <- asksF museNotes
     case M.lookup ref notes of
-      Nothing -> return $ B.str $ "[" ++ ref ++ "]"
+      Nothing -> return $ B.str ref
       Just (_pos, contents) -> do
         st <- askF
         let contents' = runF contents st { museNotes = M.delete ref (museNotes st) }
-        return $ B.note contents'
+        return $ B.singleton $ Note notetype $ B.toList contents'
 
 whitespace :: PandocMonad m => MuseParser m (F Inlines)
 whitespace = try $ pure B.space <$ skipMany1 spaceChar

src/Text/Pandoc/Readers/Odt/ContentReader.hs

@@ -696,8 +696,12 @@ read_link         = matchingElement NsText "a"
 
 read_note        :: InlineMatcher
 read_note         = matchingElement NsText "note"
-                    $ liftA note
-                    $ matchChildContent' [ read_note_body ]
+                    $ liftA2 (\nt -> singleton . Note nt . toList)
+                      (liftA makeNoteType (findAttrWithDefault NsText "note-class" "footnote"))
+                      (matchChildContent' [ read_note_body ])
+  where
+    makeNoteType :: String -> NoteType
+    makeNoteType x = if x == "endnote" then Endnote else Footnote
 
 read_note_body   :: BlockMatcher
 read_note_body    = matchingElement NsText "note-body"

src/Text/Pandoc/Shared.hs

@@ -352,8 +352,8 @@ removeFormatting = query go . walk (deNote . deQuote)
         go _          = []
 
 deNote :: Inline -> Inline
-deNote (Note _) = Str ""
-deNote x        = x
+deNote (Note _ _) = Str ""
+deNote x          = x
 
 deQuote :: Inline -> Inline
 deQuote (Quoted SingleQuote xs) =

src/Text/Pandoc/Writers/AsciiDoc.hs

@@ -484,13 +484,13 @@ inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do
                 then empty
                 else "," <> cat (intersperse "," dimList)
   return $ "image:" <> text src <> "[" <> linktext <> linktitle <> dims <> "]"
-inlineToAsciiDoc opts (Note [Para inlines]) =
-  inlineToAsciiDoc opts (Note [Plain inlines])
-inlineToAsciiDoc opts (Note [Plain inlines]) = do
+inlineToAsciiDoc opts (Note t [Para inlines]) =
+  inlineToAsciiDoc opts (Note t [Plain inlines])
+inlineToAsciiDoc opts (Note _ [Plain inlines]) = do
   contents  <- inlineListToAsciiDoc opts inlines
   return $ text "footnote:[" <> contents <> "]"
 -- asciidoc can't handle blank lines in notes
-inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]"
+inlineToAsciiDoc _ (Note _ _) = return "[multiblock footnote omitted]"
 inlineToAsciiDoc opts (Span (ident,_,_) ils) = do
   let identifier = if null ident then empty else "[[" <> text ident <> "]]"
   contents <- inlineListToAsciiDoc opts ils