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:
John MacFarlane 2012-08-01 22:40:07 -07:00
parent fadc7b0d87
commit a1677b612b
3 changed files with 28 additions and 56 deletions

View file

@ -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

View file

@ -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

View file

@ -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