Parsing: removed duplication of Key and Key'.
Now we just use the former Key' (string contents), renamed Key. lookupKeySrc and fromKey are no longer eport. Key', toKey' and KeyTable' have become Key, toKey, and KeyTable.
This commit is contained in:
parent
fadc7b0d87
commit
a1677b612b
3 changed files with 28 additions and 56 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue