diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/Parsing.hs | 43 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 33 |
3 files changed, 28 insertions, 56 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index eb52aab02..7099ea3c5 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -71,13 +71,8 @@ module Text.Pandoc.Parsing ( (>>~), NoteTable, NoteTable', KeyTable, - Key, + Key (..), toKey, - fromKey, - lookupKeySrc, - KeyTable', - Key', - toKey', smartPunctuation, withQuoteContext, singleQuoteStart, @@ -145,7 +140,6 @@ where import Text.Pandoc.Definition import Text.Pandoc.Options -import Text.Pandoc.Generic import Text.Pandoc.Builder (Blocks) import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn) import Text.Parsec @@ -706,8 +700,7 @@ data ParserState = ParserState stateAllowLinks :: Bool, -- ^ Allow parsing of links stateMaxNestingLevel :: Int, -- ^ Max # of nested Strong/Emph stateLastStrPos :: Maybe SourcePos, -- ^ Position after last str parsed - stateKeys :: KeyTable, -- ^ List of reference keys - stateKeys' :: KeyTable', -- ^ List of reference keys (with fallbacks) + stateKeys :: KeyTable, -- ^ List of reference keys (with fallbacks) stateNotes :: NoteTable, -- ^ List of notes (raw bodies) stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) stateTitle :: [Inline], -- ^ Title of document @@ -733,7 +726,6 @@ defaultParserState = stateMaxNestingLevel = 6, stateLastStrPos = Nothing, stateKeys = M.empty, - stateKeys' = M.empty, stateNotes = [], stateNotes' = [], stateTitle = [], @@ -777,38 +769,13 @@ type NoteTable = [(String, String)] type NoteTable' = [(String, Reader ParserState Blocks)] -- used in markdown reader -newtype Key = Key [Inline] deriving (Show, Read, Eq, Ord) +newtype Key = Key String deriving (Show, Read, Eq, Ord) -toKey :: [Inline] -> Key -toKey = Key . bottomUp lowercase - where lowercase :: Inline -> Inline - lowercase (Str xs) = Str (map toLower xs) - lowercase (Math t xs) = Math t (map toLower xs) - lowercase (Code attr xs) = Code attr (map toLower xs) - lowercase (RawInline f xs) = RawInline f (map toLower xs) - lowercase LineBreak = Space - lowercase x = x - -fromKey :: Key -> [Inline] -fromKey (Key xs) = xs +toKey :: String -> Key +toKey = Key . map toLower . unwords . words type KeyTable = M.Map Key Target -newtype Key' = Key' String deriving (Show, Read, Eq, Ord) - -toKey' :: String -> Key' -toKey' = Key' . map toLower . unwords . words - -type KeyTable' = M.Map Key' Target - --- | Look up key in key table and return target object. -lookupKeySrc :: KeyTable -- ^ Key table - -> Key -- ^ Key - -> Maybe Target -lookupKeySrc table key = case M.lookup key table of - Nothing -> Nothing - Just src -> Just src - -- | Fail unless we're in "smart typography" mode. failUnlessSmart :: Parser [tok] ParserState () failUnlessSmart = getOption readerSmart >>= guard diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 79bd21cab..93edbff30 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -227,8 +227,8 @@ referenceKey = try $ do blanklines let target = (escapeURI $ removeTrailingSpace src, tit) st <- getState - let oldkeys = stateKeys' st - updateState $ \s -> s { stateKeys' = M.insert (toKey' raw) target oldkeys } + let oldkeys = stateKeys st + updateState $ \s -> s { stateKeys = M.insert (toKey raw) target oldkeys } return $ return mempty referenceTitle :: Parser [Char] ParserState String @@ -1405,7 +1405,7 @@ referenceLink constructor (lab, raw) = do raw' <- try (optional (char ' ') >> optional (newline >> skipSpaces) >> (snd <$> reference)) <|> return "" - let key = toKey' $ if raw' == "[]" || raw' == "" then raw else raw' + let key = toKey $ if raw' == "[]" || raw' == "" then raw else raw' let dropRB (']':xs) = xs dropRB xs = xs let dropLB ('[':xs) = xs @@ -1413,7 +1413,7 @@ referenceLink constructor (lab, raw) = do let dropBrackets = reverse . dropRB . reverse . dropLB fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw return $ do - keys <- asks stateKeys' + keys <- asks stateKeys case M.lookup key keys of Nothing -> (\x -> B.str "[" <> x <> B.str "]" <> B.str raw') <$> fallback Just (src,tit) -> constructor src tit <$> lab diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 39a04d286..6bbb2fbd2 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -670,26 +670,31 @@ targetURI = do imageKey :: Parser [Char] ParserState (Key, Target) imageKey = try $ do string ".. |" - ref <- manyTill inline (char '|') + (_,ref) <- withRaw (manyTill inline (char '|')) skipSpaces string "image::" src <- targetURI - return (toKey (normalizeSpaces ref), (src, "")) + return (toKey $ init ref, (src, "")) anonymousKey :: Parser [Char] st (Key, Target) anonymousKey = try $ do oneOfStrings [".. __:", "__"] src <- targetURI pos <- getPosition - return (toKey [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, "")) + return (toKey $ "_" ++ printf "%09d" (sourceLine pos), (src, "")) + +stripTicks :: String -> String +stripTicks = reverse . stripTick . reverse . stripTick + where stripTick ('`':xs) = xs + stripTick xs = xs regularKey :: Parser [Char] ParserState (Key, Target) regularKey = try $ do string ".. _" - ref <- referenceName + (_,ref) <- withRaw referenceName char ':' src <- targetURI - return (toKey (normalizeSpaces ref), (src, "")) + return (toKey $ stripTicks ref, (src, "")) -- -- tables @@ -921,19 +926,19 @@ explicitLink = try $ do referenceLink :: Parser [Char] ParserState Inline referenceLink = try $ do - label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_' + (label',ref) <- withRaw (quotedReferenceName <|> simpleReferenceName) >>~ + char '_' state <- getState let keyTable = stateKeys state - let isAnonKey x = case fromKey x of - [Str ('_':_)] -> True - _ -> False - key <- option (toKey label') $ + let isAnonKey (Key ('_':_)) = True + isAnonKey _ = False + key <- option (toKey $ stripTicks ref) $ do char '_' let anonKeys = sort $ filter isAnonKey $ M.keys keyTable if null anonKeys then mzero else return (head anonKeys) - (src,tit) <- case lookupKeySrc keyTable key of + (src,tit) <- case M.lookup key keyTable of Nothing -> fail "no corresponding key" Just target -> return target -- if anonymous link, remove key so it won't be used again @@ -957,13 +962,13 @@ autoLink = autoURI <|> autoEmail image :: Parser [Char] ParserState Inline image = try $ do char '|' - ref <- manyTill inline (char '|') + (alt,ref) <- withRaw (manyTill inline (char '|')) state <- getState let keyTable = stateKeys state - (src,tit) <- case lookupKeySrc keyTable (toKey ref) of + (src,tit) <- case M.lookup (toKey $ init ref) keyTable of Nothing -> fail "no corresponding key" Just target -> return target - return $ Image (normalizeSpaces ref) (src, tit) + return $ Image (normalizeSpaces alt) (src, tit) note :: Parser [Char] ParserState Inline note = try $ do |