Support Unicode superscripts for HTML note markers

src/Text/Pandoc/App/CommandLineOptions.hs

@@ -785,6 +785,18 @@ options =
                   "true|false")
                  "" -- "Use <q> tags for quotes in HTML"
 
+    , Option "" ["note-style"]
+                 (ReqArg
+                  (\arg opt -> do
+                     style <- case arg of
+                                "sup-tag"             -> return SupTag
+                                "unicode-superscript" -> return UnicodeSuperscript
+                                _                     -> optError $ PandocOptionError $ T.pack
+                                    "Argument of --note-style must be sup-tag or unicode-superscript"
+                     return opt {optNoteStyle = style })
+                  "sup-tag|unicode-superscript")
+                 "" -- "How to print note marks in HTML"
+
     , Option "" ["email-obfuscation"]
                  (ReqArg
                   (\arg opt -> do

src/Text/Pandoc/App/Opt.hs

@@ -42,7 +42,7 @@ import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault),
                             WrapOption (WrapAuto), HTMLMathMethod (PlainMath),
                             ReferenceLocation (EndOfDocument),
                             ObfuscationMethod (NoObfuscation),
-                            CiteMethod (Citeproc))
+                            CiteMethod (Citeproc), NoteStyle (SupTag))
 import Text.Pandoc.Class (readFileStrict, fileExists, setVerbosity, report,
                           PandocMonad(lookupEnv), getUserDataDir)
 import Text.Pandoc.Error (PandocError (PandocParseError, PandocSomeError))
@@ -120,6 +120,7 @@ data Opt = Opt
     , optSelfContained         :: Bool    -- ^ Make HTML accessible offline (deprecated)
     , optEmbedResources        :: Bool    -- ^ Make HTML accessible offline
     , optHtmlQTags             :: Bool    -- ^ Use <q> tags in HTML
+    , optNoteStyle             :: NoteStyle -- ^ How to print note marks in HTML
     , optHighlightStyle        :: Maybe Text -- ^ Style to use for highlighted code
     , optSyntaxDefinitions     :: [FilePath]  -- ^ xml syntax defs to load
     , optTopLevelDivision      :: TopLevelDivision -- ^ Type of the top-level divisions
@@ -202,6 +203,7 @@ instance FromJSON Opt where
        <*> o .:? "self-contained" .!= optSelfContained defaultOpts
        <*> o .:? "embed-resources" .!= optEmbedResources defaultOpts
        <*> o .:? "html-q-tags" .!= optHtmlQTags defaultOpts
+       <*> o .:? "note-style" .!= optNoteStyle defaultOpts
        <*> o .:? "highlight-style"
        <*> o .:? "syntax-definitions" .!= optSyntaxDefinitions defaultOpts
        <*> o .:? "top-level-division" .!= optTopLevelDivision defaultOpts
@@ -528,6 +530,8 @@ doOpt (k,v) = do
       parseJSON v >>= \x -> return (\o -> o{ optEmbedResources = x })
     "html-q-tags" ->
       parseJSON v >>= \x -> return (\o -> o{ optHtmlQTags = x })
+    "note-style" ->
+      parseJSON v >>= \x -> return (\o -> o{ optNoteStyle = x })
     "highlight-style" ->
       parseJSON v >>= \x -> return (\o -> o{ optHighlightStyle = x })
     "syntax-definition" ->
@@ -739,6 +743,7 @@ defaultOpts = Opt
     , optSelfContained         = False
     , optEmbedResources        = False
     , optHtmlQTags             = False
+    , optNoteStyle             = SupTag
     , optHighlightStyle        = Just "pygments"
     , optSyntaxDefinitions     = []
     , optTopLevelDivision      = TopLevelDefault

src/Text/Pandoc/App/OutputSettings.hs

@@ -262,6 +262,7 @@ optToOutputSettings scriptingEngine opts = do
         , writerReferenceDoc     = optReferenceDoc opts
         , writerSyntaxMap        = syntaxMap
         , writerPreferAscii      = optAscii opts
+        , writerNoteStyle        = optNoteStyle opts
         }
   return $ OutputSettings
     { outputFormat = format

src/Text/Pandoc/Options.hs

@@ -28,6 +28,7 @@ module Text.Pandoc.Options ( module Text.Pandoc.Extensions
                            , WriterOptions (..)
                            , TrackChanges (..)
                            , ReferenceLocation (..)
+                           , NoteStyle (..)
                            , def
                            , isEnabled
                            , defaultMathJaxURL
@@ -286,6 +287,23 @@ instance ToJSON ReferenceLocation where
    toJSON EndOfSection = "end-of-section"
    toJSON EndOfDocument = "end-of-document"
 
+-- | Style for printing note indicators in HTML output
+data NoteStyle = SupTag             -- Numbers in @<sup>@ tag
+               | UnicodeSuperscript -- Unicode superscript number characters
+               deriving (Show, Read, Eq, Data, Typeable, Generic)
+
+instance FromJSON NoteStyle where
+  parseJSON v =
+    case v of
+      String "sup-tag" -> return SupTag
+      String "unicode-superscript" -> return UnicodeSuperscript
+      _ -> fail $ "Unknown note style " <> toStringLazy (encode v)
+
+instance ToJSON NoteStyle where
+  toJSON SupTag = "sup-tag"
+  toJSON UnicodeSuperscript = "unicode-superscript"
+
+
 -- | Options for writers
 data WriterOptions = WriterOptions
   { writerTemplate          :: Maybe (Template Text) -- ^ Template to use
@@ -325,6 +343,7 @@ data WriterOptions = WriterOptions
   , writerReferenceLocation :: ReferenceLocation    -- ^ Location of footnotes and references for writing markdown
   , writerSyntaxMap         :: SyntaxMap
   , writerPreferAscii       :: Bool           -- ^ Prefer ASCII representations of characters when possible
+  , writerNoteStyle         :: NoteStyle -- ^ How to print note marks in HTML
   } deriving (Show, Data, Typeable, Generic)
 
 instance Default WriterOptions where
@@ -363,6 +382,7 @@ instance Default WriterOptions where
                       , writerReferenceLocation = EndOfDocument
                       , writerSyntaxMap        = defaultSyntaxMap
                       , writerPreferAscii      = False
+                      , writerNoteStyle        = SupTag
                       }
 
 instance HasSyntaxExtensions WriterOptions where

src/Text/Pandoc/Writers/HTML.hs

@@ -34,7 +34,7 @@ import Control.Monad.State.Strict
     ( StateT, MonadState(get), gets, modify, evalStateT )
 import Control.Monad ( liftM, when, foldM, unless )
 import Control.Monad.Trans ( MonadTrans(lift) )
-import Data.Char (ord)
+import Data.Char (ord, isDigit, digitToInt)
 import Data.List (intercalate, intersperse, partition, delete, (\\), foldl')
 import Data.List.NonEmpty (NonEmpty((:|)))
 import Data.Containers.ListUtils (nubOrd)
@@ -133,6 +133,15 @@ strToHtml t
            = h <> preEscapedString (T.unpack txt <> "\xFE0E")
     go h txt = h <> toHtml txt
 
+digitsToUnicodeSuperscript :: Text -> Text
+digitsToUnicodeSuperscript =
+  let superscripts = "⁰¹²³⁴⁵⁶⁷⁸⁹"
+      go x
+        -- By construction, digitToInt and the list index cannot fail
+        | isDigit x = superscripts !! (digitToInt x)
+        | otherwise = x
+  in T.map go
+
 -- See #5469: this prevents iOS from substituting emojis.
 needsVariationSelector :: Char -> Bool
 needsVariationSelector '↩' = True
@@ -1596,6 +1605,11 @@ inlineToHtml opts inline = do
                         let ref = tshow number
                         htmlContents <- blockListToNote opts ref contents
                         epubVersion <- gets stEPUBVersion
+                        let style = writerNoteStyle opts
+                        let (noteMark, noteTag) = case style of
+                                         _ | isJust epubVersion -> (ref, id)
+                                         SupTag                 -> (ref, H.sup)
+                                         UnicodeSuperscript     -> (digitsToUnicodeSuperscript ref, id)
                         -- push contents onto front of notes
                         modify $ \st -> st {stNotes = htmlContents:notes}
                         slideVariant <- gets stSlideVariant
@@ -1605,10 +1619,8 @@ inlineToHtml opts inline = do
                                          writerIdentifierPrefix opts <> "fn" <> ref)
                                        ! A.class_ "footnote-ref"
                                        ! prefixedId opts ("fnref" <> ref)
-                                       $ (if isJust epubVersion
-                                             then id
-                                             else H.sup)
-                                       $ toHtml ref
+                                       $ noteTag
+                                       $ toHtml noteMark
                         return $ case epubVersion of
                                       Just EPUB3 -> link ! customAttribute "epub:type" "noteref" ! customAttribute "role" "doc-noteref"
                                       _ | html5  -> link ! A5.role "doc-noteref"

test/Tests/Writers/HTML.hs

@@ -207,6 +207,27 @@ tests =
           , "</div>"
           , "</div>"
           ]
+      , test (htmlWithOpts def{writerNoteStyle=UnicodeSuperscript})
+        "using Unicode superscript marks" $
+        noteTestDoc =?>
+        T.unlines
+          [ "<h1>Page title</h1>"
+          , "<h2>First section</h2>"
+          , "<p>This is a footnote.<a href=\"#fn1\" class=\"footnote-ref\" id=\"fnref1\">¹</a> And this is a <a href=\"https://www.google.com\">link</a>.</p>"
+          , "<blockquote>"
+          , "<p>A note inside a block quote.<a href=\"#fn2\" class=\"footnote-ref\" id=\"fnref2\">²</a></p>"
+          , "<p>A second paragraph.</p>"
+          , "</blockquote>"
+          , "<h2>Second section</h2>"
+          , "<p>Some more text.</p>"
+          , "<div class=\"footnotes footnotes-end-of-document\">"
+          , "<hr />"
+          , "<ol>"
+          , "<li id=\"fn1\"><p>Down here.<a href=\"#fnref1\" class=\"footnote-back\">↩︎</a></p></li>"
+          , "<li id=\"fn2\"><p>The second note.<a href=\"#fnref2\" class=\"footnote-back\">↩︎</a></p></li>"
+          , "</ol>"
+          , "</div>"
+          ]
       ]
   ]
   where