@@ -34,12 +34,12 @@ Conversion of 'Pandoc' documents to markdown-formatted plain text.
3434Markdown: <http://daringfireball.net/projects/markdown/>
3535-}
3636module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
37−import Control.Monad.Except (throwError)
3837import Control.Monad.Reader
3938import Control.Monad.State
4039import Data.Char (chr, isPunctuation, isSpace, ord)
4140import Data.Default
4241import qualified Data.HashMap.Strict as H
42+import qualified Data.Map as M
4343import Data.List (find, group, intersperse, sortBy, stripPrefix, transpose)
4444import Data.Maybe (fromMaybe)
4545import Data.Monoid (Any (..))
@@ -52,7 +52,6 @@ import Network.HTTP (urlEncode)
5252import Text.HTML.TagSoup (Tag (..), isTagText, parseTags)
5353import Text.Pandoc.Class (PandocMonad, report)
5454import Text.Pandoc.Definition
55−import Text.Pandoc.Error
5655import Text.Pandoc.Logging
5756import Text.Pandoc.Options
5857import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)
@@ -90,7 +89,9 @@ instance Default WriterEnv
9089
9190data WriterState = WriterState { stNotes :: Notes
9291 , stRefs :: Refs
93− , stKeys :: Set.Set Key
92+ , stKeys :: M.Map Key
93+ (M.Map (Target, Attr) Int)
94+ , stLastIdx :: Int
9495 , stIds :: Set.Set String
9596 , stNoteNum :: Int
9697 }
@@ -98,7 +99,8 @@ data WriterState = WriterState { stNotes :: Notes
9899instance Default WriterState
99100 where def = WriterState{ stNotes = []
100101 , stRefs = []
101− , stKeys = Set.empty
102+ , stKeys = M.empty
103+ , stLastIdx = 0
102104 , stIds = Set.empty
103105 , stNoteNum = 1
104106 }
@@ -804,17 +806,44 @@ getReference attr label target = do
804806 Just (ref, _, _) -> return ref
805807 Nothing -> do
806808 keys <- gets stKeys
807− label' <- if isEmpty label || getKey label `Set.member` keys
808− then case find (\n -> not (Key n `Set.member` keys)) $
809− map show [1..(10000 :: Integer)] of
810− Just x -> return $ text x
811− Nothing ->
812− throwError $ PandocSomeError "no unique label"
813− else return label
814− modify (\s -> s{ stRefs = (label', target, attr) : stRefs s,
815− stKeys = Set.insert (getKey label') (stKeys s)
816− })
817− return label'
809+ case M.lookup (getKey label) keys of
810+ Nothing -> do -- no other refs with this label
811+ (lab', idx) <- if isEmpty label
812+ then do
813+ i <- (+ 1) <$> gets stLastIdx
814+ modify $ \s -> s{ stLastIdx = i }
815+ return (text (show i), i)
816+ else return (label, 0)
817+ modify (\s -> s{
818+ stRefs = (lab', target, attr) : refs,
819+ stKeys = M.insert (getKey label)
820+ (M.insert (target, attr) idx mempty)
821+ (stKeys s) })
822+ return lab'
823+
824+ Just km -> do -- we have refs with this label
825+ case M.lookup (target, attr) km of
826+ Just i -> do
827+ let lab' = label <> if i == 0
828+ then mempty
829+ else text (show i)
830+ -- make sure it's in stRefs; it may be
831+ -- a duplicate that was printed in a previous
832+ -- block:
833+ when ((lab', target, attr) `notElem` refs) $
834+ modify (\s -> s{
835+ stRefs = (lab', target, attr) : refs })
836+ return lab'
837+ Nothing -> do -- but this one is to a new target
838+ i <- (+ 1) <$> gets stLastIdx
839+ modify $ \s -> s{ stLastIdx = i }
840+ let lab' = text (show i)
841+ modify (\s -> s{
842+ stRefs = (lab', target, attr) : refs,
843+ stKeys = M.insert (getKey label)
844+ (M.insert (target, attr) i km)
845+ (stKeys s) })
846+ return lab'
818847
819848-- | Convert list of Pandoc inline elements to markdown.
820849inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m Doc