aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs169
-rw-r--r--src/Text/Pandoc/Shared.hs56
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs46
3 files changed, 147 insertions, 124 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index e50180a63..05a46c511 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Readers.Markdown
Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
+ License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
@@ -27,8 +27,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of markdown-formatted plain text to 'Pandoc' document.
-}
-module Text.Pandoc.Readers.Markdown (
- readMarkdown
+module Text.Pandoc.Readers.Markdown (
+ readMarkdown
) where
import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy )
@@ -36,9 +36,9 @@ import Data.Ord ( comparing )
import Data.Char ( isAlphaNum )
import Network.URI ( isURI )
import Text.Pandoc.Definition
-import Text.Pandoc.Shared
+import Text.Pandoc.Shared
import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )
-import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,
+import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,
anyHtmlInlineTag, anyHtmlTag,
anyHtmlEndTag, htmlEndTag, extractTagType,
htmlBlockElement )
@@ -68,14 +68,14 @@ specialChars = "\\[]*_~`<>$!^-.&'\"\8216\8217\8220\8221"
indentSpaces = try $ do
state <- getState
let tabStop = stateTabStop state
- try (count tabStop (char ' ')) <|>
+ try (count tabStop (char ' ')) <|>
(many (char ' ') >> string "\t") <?> "indentation"
nonindentSpaces = do
state <- getState
let tabStop = stateTabStop state
sps <- many (char ' ')
- if length sps < tabStop
+ if length sps < tabStop
then return sps
else unexpected "indented line"
@@ -90,8 +90,8 @@ failUnlessSmart = do
if stateSmart state then return () else fail "Smart typography feature"
-- | Parse an inline Str element with a given content.
-inlineString str = try $ do
- (Str res) <- inline
+inlineString str = try $ do
+ (Str res) <- inline
if res == str then return res else fail $ "unexpected Str content"
-- | Parse a sequence of inline elements between a string
@@ -102,9 +102,9 @@ inlinesInBalanced opener closer = try $ do
string opener
result <- manyTill ( (do lookAhead (inlineString opener)
-- because it might be a link...
- bal <- inlinesInBalanced opener closer
+ bal <- inlinesInBalanced opener closer
return $ [Str opener] ++ bal ++ [Str closer])
- <|> (count 1 inline))
+ <|> (count 1 inline))
(try (string closer))
return $ concat result
@@ -114,7 +114,7 @@ inlinesInBalanced opener closer = try $ do
titleLine = try $ char '%' >> skipSpaces >> manyTill inline newline
-authorsLine = try $ do
+authorsLine = try $ do
char '%'
skipSpaces
authors <- sepEndBy (many1 (noneOf ",;\n")) (oneOf ",;")
@@ -142,15 +142,24 @@ parseMarkdown = do
startPos <- getPosition
-- go through once just to get list of reference keys
-- docMinusKeys is the raw document with blanks where the keys were...
- docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>=
- return . concat
+ docMinusKeys <- manyTill (referenceKey <|> headerReference <|>
+ lineClump) eof >>= return . concat
setInput docMinusKeys
setPosition startPos
st <- getState
+ -- get headers and construct implicit references unless strict
+ if stateStrict st
+ then return ()
+ else do let oldkeys = stateKeys st
+ let headers = reverse $ stateHeaders st
+ let idents = uniqueIdentifiers headers
+ let implicitRefs = zipWith (\hd ident -> (hd, ("#" ++ ident, "")))
+ headers idents
+ updateState $ \st -> st { stateKeys = oldkeys ++ implicitRefs }
-- go through again for notes unless strict...
if stateStrict st
then return ()
- else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=
+ else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=
return . concat
st <- getState
let reversedNotes = stateNotes st
@@ -159,10 +168,10 @@ parseMarkdown = do
setPosition startPos
-- now parse it for real...
(title, author, date) <- option ([],[],"") titleBlock
- blocks <- parseBlocks
+ blocks <- parseBlocks
return $ Pandoc (Meta title author date) $ filter (/= Null) blocks
---
+--
-- initial pass for references and notes
--
@@ -185,7 +194,17 @@ referenceKey = try $ do
-- return blanks so line count isn't affected
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
-referenceTitle = try $ do
+headerReference = try $ do
+ failIfStrict
+ startPos <- getPosition
+ (Header level text) <- lookAhead $ atxHeader <|> setextHeader
+ st <- getState
+ let headers = stateHeaders st
+ updateState $ \st -> st { stateHeaders = text:headers }
+ endPos <- getPosition
+ lineClump -- return the raw header, because we need to parse it later
+
+referenceTitle = try $ do
(many1 spaceChar >> option '\n' newline) <|> newline
skipSpaces
tit <- (charsInBalanced '(' ')' >>= return . unwords . words)
@@ -200,7 +219,7 @@ rawLine = do
notFollowedBy blankline
notFollowedBy' noteMarker
contents <- many1 nonEndline
- end <- option "" (newline >> optional indentSpaces >> return "\n")
+ end <- option "" (newline >> optional indentSpaces >> return "\n")
return $ contents ++ end
rawLines = many1 rawLine >>= return . concat
@@ -229,7 +248,7 @@ noteBlock = try $ do
parseBlocks = manyTill block eof
-block = choice [ header
+block = choice [ header
, table
, codeBlock
, hrule
@@ -260,7 +279,7 @@ setextHeader = try $ do
-- first, see if this block has any chance of being a setextHeader:
lookAhead (anyLine >> oneOf setextHChars)
text <- many1Till inline newline >>= return . normalizeSpaces
- level <- choice $ zipWith
+ level <- choice $ zipWith
(\ch lev -> try (many1 $ char ch) >> blanklines >> return lev)
setextHChars [1..(length setextHChars)]
return $ Header level text
@@ -285,7 +304,7 @@ hrule = try $ do
indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")
codeBlock = do
- contents <- many1 (indentedLine <|>
+ contents <- many1 (indentedLine <|>
try (do b <- blanklines
l <- indentedLine
return $ b ++ l))
@@ -300,7 +319,7 @@ emacsBoxQuote = try $ do
failIfStrict
string ",----"
manyTill anyChar newline
- raw <- manyTill
+ raw <- manyTill
(try (char '|' >> optional (char ' ') >> manyTill anyChar newline))
(try (string "`----"))
blanklines
@@ -310,7 +329,7 @@ emailBlockQuoteStart = try $ nonindentSpaces >> char '>' >>~ optional (char ' ')
emailBlockQuote = try $ do
emailBlockQuoteStart
- raw <- sepBy (many (nonEndline <|>
+ raw <- sepBy (many (nonEndline <|>
(try (endline >> notFollowedBy emailBlockQuoteStart >>
return '\n'))))
(try (newline >> emailBlockQuoteStart))
@@ -318,12 +337,12 @@ emailBlockQuote = try $ do
optional blanklines
return raw
-blockQuote = do
+blockQuote = do
raw <- emailBlockQuote <|> emacsBoxQuote
-- parse the extracted block, which may contain various block elements:
contents <- parseFromString parseBlocks $ (joinWithSep "\n" raw) ++ "\n\n"
return $ BlockQuote contents
-
+
--
-- list blocks
--
@@ -358,7 +377,7 @@ orderedListStart style delim = try $ do
then do many1 digit
char '.'
return 1
- else orderedListMarker style delim
+ else orderedListMarker style delim
if delim == Period && (style == UpperAlpha || (style == UpperRoman &&
num `elem` [1, 5, 10, 50, 100, 500, 1000]))
then char '\t' <|> (spaceChar >> spaceChar)
@@ -382,7 +401,7 @@ rawListItem start = try $ do
blanks <- many blankline
return $ concat result ++ blanks
--- continuation of a list item - indented and separated by blankline
+-- continuation of a list item - indented and separated by blankline
-- or (in compact lists) endline.
-- note: nested lists are parsed as continuations
listContinuation start = try $ do
@@ -398,7 +417,7 @@ listContinuationLine start = try $ do
result <- manyTill anyChar newline
return $ result ++ "\n"
-listItem start = try $ do
+listItem start = try $ do
first <- rawListItem start
continuations <- many (listContinuation start)
-- parsing with ListItemState forces markers at beginning of lines to
@@ -418,7 +437,7 @@ orderedList = try $ do
items <- many1 (listItem (orderedListStart style delim))
return $ OrderedList (start, style, delim) $ compactify items
-bulletList = many1 (listItem bulletListStart) >>=
+bulletList = many1 (listItem bulletListStart) >>=
return . BulletList . compactify
-- definition lists
@@ -459,7 +478,7 @@ definitionList = do
-- paragraph block
--
-para = try $ do
+para = try $ do
result <- many1 inline
newline
blanklines <|> do st <- getState
@@ -468,9 +487,9 @@ para = try $ do
else lookAhead emacsBoxQuote >> return ""
return $ Para $ normalizeSpaces result
-plain = many1 inline >>= return . Plain . normalizeSpaces
+plain = many1 inline >>= return . Plain . normalizeSpaces
---
+--
-- raw html
--
@@ -487,25 +506,25 @@ htmlBlock = do
else rawHtmlBlocks
-- True if tag is self-closing
-isSelfClosing tag =
+isSelfClosing tag =
isSuffixOf "/>" $ filter (not . (`elem` " \n\t")) tag
strictHtmlBlock = try $ do
- tag <- anyHtmlBlockTag
+ tag <- anyHtmlBlockTag
let tag' = extractTagType tag
- if isSelfClosing tag || tag' == "hr"
+ if isSelfClosing tag || tag' == "hr"
then return tag
- else do contents <- many (notFollowedBy' (htmlEndTag tag') >>
+ else do contents <- many (notFollowedBy' (htmlEndTag tag') >>
(htmlElement <|> (count 1 anyChar)))
end <- htmlEndTag tag'
return $ tag ++ concat contents ++ end
rawHtmlBlocks = do
- htmlBlocks <- many1 rawHtmlBlock
+ htmlBlocks <- many1 rawHtmlBlock
let combined = concatMap (\(RawHtml str) -> str) htmlBlocks
let combined' = if not (null combined) && last combined == '\n'
- then init combined -- strip extra newline
- else combined
+ then init combined -- strip extra newline
+ else combined
return $ RawHtml combined'
--
@@ -516,7 +535,7 @@ rawLaTeXEnvironment' = failIfStrict >> rawLaTeXEnvironment
--
-- Tables
---
+--
-- Parse a dashed line with optional trailing spaces; return its length
-- and the length including trailing space.
@@ -525,7 +544,7 @@ dashedLine ch = do
sp <- many spaceChar
return $ (length dashes, length $ dashes ++ sp)
--- Parse a table header with dashed lines of '-' preceded by
+-- Parse a table header with dashed lines of '-' preceded by
-- one line of text.
simpleTableHeader = try $ do
rawContent <- anyLine
@@ -548,7 +567,7 @@ tableSep = try $ nonindentSpaces >> many1 (dashedLine '-') >> string "\n"
rawTableLine indices = do
notFollowedBy' (blanklines <|> tableFooter)
line <- many1Till anyChar newline
- return $ map removeLeadingTrailingSpace $ tail $
+ return $ map removeLeadingTrailingSpace $ tail $
splitByIndices (init indices) line
-- Parse a table line and return a list of lists of blocks (columns).
@@ -565,8 +584,8 @@ multilineRow indices = do
widthsFromIndices :: Int -- Number of columns on terminal
-> [Int] -- Indices
-> [Float] -- Fractional relative sizes of columns
-widthsFromIndices _ [] = []
-widthsFromIndices numColumns indices =
+widthsFromIndices _ [] = []
+widthsFromIndices numColumns indices =
let lengths = zipWith (-) indices (0:indices)
totLength = sum lengths
quotient = if totLength > numColumns
@@ -605,14 +624,14 @@ simpleTable = tableWith simpleTableHeader tableLine blanklines
multilineTable = tableWith multilineTableHeader multilineRow tableFooter
multilineTableHeader = try $ do
- tableSep
+ tableSep
rawContent <- many1 (notFollowedBy' tableSep >> many1Till anyChar newline)
initSp <- nonindentSpaces
dashes <- many1 (dashedLine '-')
newline
let (lengths, lines) = unzip dashes
let indices = scanl (+) (length initSp) lines
- let rawHeadsList = transpose $ map
+ let rawHeadsList = transpose $ map
(\ln -> tail $ splitByIndices (init indices) ln)
rawContent
let rawHeads = map (joinWithSep " ") rawHeadsList
@@ -625,7 +644,7 @@ multilineTableHeader = try $ do
alignType :: [String] -> Int -> Alignment
alignType [] len = AlignDefault
alignType strLst len =
- let str = head $ sortBy (comparing length) $
+ let str = head $ sortBy (comparing length) $
map removeTrailingSpace strLst
leftSpace = if null str then False else (str !! 0) `elem` " \t"
rightSpace = length str < len || (str !! (len - 1)) `elem` " \t"
@@ -637,7 +656,7 @@ alignType strLst len =
table = failIfStrict >> (simpleTable <|> multilineTable) <?> "table"
---
+--
-- inline
--
@@ -667,7 +686,7 @@ inline = choice [ str
escapedChar = do
char '\\'
state <- getState
- result <- option '\\' $ if stateStrict state
+ result <- option '\\' $ if stateStrict state
then oneOf "\\`*_{}[]()>#+-.!~"
else satisfy (not . isAlphaNum)
return $ Str [result]
@@ -681,17 +700,17 @@ ltSign = do
specialCharsMinusLt = filter (/= '<') specialChars
-symbol = do
+symbol = do
result <- oneOf specialCharsMinusLt
return $ Str [result]
-- parses inline code, between n `s and n `s
-code = try $ do
+code = try $ do
starts <- many1 (char '`')
skipSpaces
result <- many1Till (many1 (noneOf "`\n") <|> many1 (char '`') <|>
- (char '\n' >> return " "))
- (try (skipSpaces >> count (length starts) (char '`') >>
+ (char '\n' >> return " "))
+ (try (skipSpaces >> count (length starts) (char '`') >>
notFollowedBy (char '`')))
return $ Code $ removeLeadingTrailingSpace $ concat result
@@ -707,30 +726,30 @@ math = try $ do
return $ TeX ("$" ++ (joinWithSep " " words) ++ "$")
emph = ((enclosed (char '*') (char '*') inline) <|>
- (enclosed (char '_') (char '_' >> notFollowedBy alphaNum) inline)) >>=
+ (enclosed (char '_') (char '_' >> notFollowedBy alphaNum) inline)) >>=
return . Emph . normalizeSpaces
-strong = ((enclosed (string "**") (try $ string "**") inline) <|>
+strong = ((enclosed (string "**") (try $ string "**") inline) <|>
(enclosed (string "__") (try $ string "__") inline)) >>=
return . Strong . normalizeSpaces
strikeout = failIfStrict >> enclosed (string "~~") (try $ string "~~") inline >>=
return . Strikeout . normalizeSpaces
-superscript = failIfStrict >> enclosed (char '^') (char '^')
+superscript = failIfStrict >> enclosed (char '^') (char '^')
(notFollowedBy' whitespace >> inline) >>= -- may not contain Space
return . Superscript
subscript = failIfStrict >> enclosed (char '~') (char '~')
(notFollowedBy' whitespace >> inline) >>= -- may not contain Space
- return . Subscript
+ return . Subscript
-smartPunctuation = failUnlessSmart >>
+smartPunctuation = failUnlessSmart >>
choice [ quoted, apostrophe, dash, ellipses ]
apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe
-quoted = doubleQuoted <|> singleQuoted
+quoted = doubleQuoted <|> singleQuoted
withQuoteContext context parser = do
oldState <- getState
@@ -746,7 +765,7 @@ singleQuoted = try $ do
withQuoteContext InSingleQuote $ many1Till inline singleQuoteEnd >>=
return . Quoted SingleQuote . normalizeSpaces
-doubleQuoted = try $ do
+doubleQuoted = try $ do
doubleQuoteStart
withQuoteContext InDoubleQuote $ many1Till inline doubleQuoteEnd >>=
return . Quoted DoubleQuote . normalizeSpaces
@@ -757,13 +776,13 @@ failIfInQuoteContext context = do
then fail "already inside quotes"
else return ()
-singleQuoteStart = do
+singleQuoteStart = do
failIfInQuoteContext InSingleQuote
- char '\8216' <|>
- (try $ do char '\''
+ char '\8216' <|>
+ (try $ do char '\''
notFollowedBy (oneOf ")!],.;:-? \t\n")
notFollowedBy (try (oneOfStrings ["s","t","m","ve","ll","re"] >>
- satisfy (not . isAlphaNum)))
+ satisfy (not . isAlphaNum)))
-- possess/contraction
return '\'')
@@ -807,13 +826,13 @@ endline = try $ do
newline
notFollowedBy blankline
st <- getState
- if stateStrict st
+ if stateStrict st
then do notFollowedBy emailBlockQuoteStart
notFollowedBy (char '#') -- atx header
- else return ()
+ else return ()
-- parse potential list-starts differently if in a list:
if stateParserContext st == ListItemState
- then notFollowedBy' (bulletListStart <|>
+ then notFollowedBy' (bulletListStart <|>
(anyOrderedListStart >> return ()))
else return ()
return Space
@@ -827,7 +846,7 @@ reference = notFollowedBy' (string "[^") >> -- footnote reference
inlinesInBalanced "[" "]" >>= (return . normalizeSpaces)
-- source for a link, with optional title
-source = try $ do
+source = try $ do
char '('
optional (char '<')
src <- many (noneOf ")> \t\n")
@@ -837,7 +856,7 @@ source = try $ do
char ')'
return (removeTrailingSpace src, tit)
-linkTitle = try $ do
+linkTitle = try $ do
(many1 spaceChar >> option '\n' newline) <|> newline
skipSpaces
delim <- char '\'' <|> char '"'
@@ -852,13 +871,13 @@ link = try $ do
-- a link like [this][ref] or [this][] or [this]
referenceLink label = do
- ref <- option [] (try (optional (char ' ') >>
+ ref <- option [] (try (optional (char ' ') >>
optional (newline >> skipSpaces) >> reference))
let ref' = if null ref then label else ref
state <- getState
case lookupKeySrc (stateKeys state) ref' of
- Nothing -> fail "no corresponding key"
- Just target -> return target
+ Nothing -> fail "no corresponding key"
+ Just target -> return target
emailAddress = try $ do
name <- many1 (alphaNum <|> char '+')
@@ -879,7 +898,7 @@ autoLink = try $ do
char '>'
let src' = if "mailto:" `isPrefixOf` src
then drop 7 src
- else src
+ else src
st <- getState
return $ if stateStrict st
then Link [Str src'] (src, "")
@@ -910,7 +929,7 @@ rawLaTeXInline' = failIfStrict >> rawLaTeXInline
rawHtmlInline' = do
st <- getState
result <- choice $ if stateStrict st
- then [htmlBlockElement, anyHtmlTag, anyHtmlEndTag]
+ then [htmlBlockElement, anyHtmlTag, anyHtmlEndTag]
else [htmlBlockElement, anyHtmlInlineTag]
return $ HtmlInline result
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index ce07ccd24..e0e93c189 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -34,6 +34,7 @@ module Text.Pandoc.Shared (
substitute,
joinWithSep,
-- * Text processing
+ isPunctuation,
backslashEscapes,
escapeStringUsing,
stripTrailingNewlines,
@@ -91,6 +92,7 @@ module Text.Pandoc.Shared (
Element (..),
hierarchicalize,
isHeaderBlock,
+ uniqueIdentifiers,
-- * Writer options
WriterOptions (..),
defaultWriterOptions
@@ -102,7 +104,7 @@ import Text.PrettyPrint.HughesPJ ( Doc, fsep, ($$), (<>), empty )
import qualified Text.PrettyPrint.HughesPJ as PP
import Text.Pandoc.CharacterReferences ( characterReference )
import Data.Char ( toLower, toUpper, ord, isLower, isUpper )
-import Data.List ( find, isPrefixOf )
+import Data.List ( find, isPrefixOf, intersperse )
import Control.Monad ( join )
--
@@ -144,6 +146,15 @@ joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
-- Text processing
--
+-- | True if character is a punctuation character (unicode).
+isPunctuation :: Char -> Bool
+isPunctuation c =
+ let c' = ord c
+ in if c `elem` "!\"'()*,-./:;<>?[\\]`{|}~" || c' >= 0x2000 && c' <= 0x206F ||
+ c' >= 0xE000 && c' <= 0xE0FF
+ then True
+ else False
+
-- | Returns an association list of backslash escapes for the
-- designated characters.
backslashEscapes :: [Char] -- ^ list of special characters to escape
@@ -566,7 +577,8 @@ data ParserState = ParserState
stateStrict :: Bool, -- ^ Use strict markdown syntax?
stateSmart :: Bool, -- ^ Use smart typography?
stateColumns :: Int, -- ^ Number of columns in terminal
- stateHeaderTable :: [HeaderType] -- ^ Ordered list of header types used
+ stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
+ stateHeaders :: [[Inline]] -- ^ List of header texts used
}
deriving Show
@@ -585,7 +597,8 @@ defaultParserState =
stateStrict = False,
stateSmart = False,
stateColumns = 80,
- stateHeaderTable = [] }
+ stateHeaderTable = [],
+ stateHeaders = [] }
data HeaderType
= SingleHeader Char -- ^ Single line of characters underneath
@@ -787,6 +800,43 @@ isHeaderBlock :: Block -> Bool
isHeaderBlock (Header _ _) = True
isHeaderBlock _ = False
+-- | Convert Pandoc inline list to plain text identifier.
+inlineListToIdentifier :: [Inline] -> String
+inlineListToIdentifier [] = ""
+inlineListToIdentifier (x:xs) =
+ xAsText ++ inlineListToIdentifier xs
+ where xAsText = case x of
+ Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $
+ concat $ intersperse "-" $ words $ map toLower s
+ Emph lst -> inlineListToIdentifier lst
+ Strikeout lst -> inlineListToIdentifier lst
+ Superscript lst -> inlineListToIdentifier lst
+ Subscript lst -> inlineListToIdentifier lst
+ Strong lst -> inlineListToIdentifier lst
+ Quoted _ lst -> inlineListToIdentifier lst
+ Code s -> s
+ Space -> "-"
+ EmDash -> "-"
+ EnDash -> "-"
+ Apostrophe -> ""
+ Ellipses -> ""
+ LineBreak -> "-"
+ TeX _ -> ""
+ HtmlInline _ -> ""
+ Link lst _ -> inlineListToIdentifier lst
+ Image lst _ -> inlineListToIdentifier lst
+ Note _ -> ""
+
+-- | Return unique identifiers for list of inline lists.
+uniqueIdentifiers :: [[Inline]] -> [String]
+uniqueIdentifiers ls =
+ let addIdentifier (nonuniqueIds, uniqueIds) l =
+ let new = inlineListToIdentifier l
+ matches = length $ filter (== new) nonuniqueIds
+ new' = new ++ if matches > 0 then ("-" ++ show matches) else ""
+ in (new:nonuniqueIds, new':uniqueIds)
+ in reverse $ snd $ foldl addIdentifier ([],[]) ls
+
--
-- Writer options
--
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 7ec95d8ef..56ca5ca48 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -193,15 +193,6 @@ obfuscateChar char =
obfuscateString :: String -> String
obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
--- | True if character is a punctuation character (unicode).
-isPunctuation :: Char -> Bool
-isPunctuation c =
- let c' = ord c
- in if c `elem` "!\"'()*,-./:;<>?[\\]`{|}~" || c' >= 0x2000 && c' <= 0x206F ||
- c' >= 0xE000 && c' <= 0xE0FF
- then True
- else False
-
-- | Add CSS for document header.
addToCSS :: String -> State WriterState ()
addToCSS item = do
@@ -209,43 +200,6 @@ addToCSS item = do
let current = stCSS st
put $ st {stCSS = S.insert item current}
--- | Convert Pandoc inline list to plain text identifier.
-inlineListToIdentifier :: [Inline] -> String
-inlineListToIdentifier [] = ""
-inlineListToIdentifier (x:xs) =
- xAsText ++ inlineListToIdentifier xs
- where xAsText = case x of
- Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $
- concat $ intersperse "-" $ words $ map toLower s
- Emph lst -> inlineListToIdentifier lst
- Strikeout lst -> inlineListToIdentifier lst
- Superscript lst -> inlineListToIdentifier lst
- Subscript lst -> inlineListToIdentifier lst
- Strong lst -> inlineListToIdentifier lst
- Quoted _ lst -> inlineListToIdentifier lst
- Code s -> s
- Space -> "-"
- EmDash -> "-"
- EnDash -> "-"
- Apostrophe -> ""
- Ellipses -> ""
- LineBreak -> "-"
- TeX _ -> ""
- HtmlInline _ -> ""
- Link lst _ -> inlineListToIdentifier lst
- Image lst _ -> inlineListToIdentifier lst
- Note _ -> ""
-
--- | Return unique identifiers for list of inline lists.
-uniqueIdentifiers :: [[Inline]] -> [String]
-uniqueIdentifiers ls =
- let addIdentifier (nonuniqueIds, uniqueIds) l =
- let new = inlineListToIdentifier l
- matches = length $ filter (== new) nonuniqueIds
- new' = new ++ if matches > 0 then ("-" ++ show matches) else ""
- in (new:nonuniqueIds, new':uniqueIds)
- in reverse $ snd $ foldl addIdentifier ([],[]) ls
-
-- | Convert Pandoc block element to HTML.
blockToHtml :: WriterOptions -> Block -> State WriterState Html
blockToHtml opts Null = return $ noHtml