b5959b2 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1297 from tarleb/citations

b5959b2John MacFarlane12 years ago

src/Text/Pandoc.hs+1−1

compare with master

unifiedsplit

@@ -275,6 +275,7 @@ getDefaultExtensions "markdown_mmd" = multimarkdownExtensions

275getDefaultExtensions "markdown_github" = githubMarkdownExtensions

276getDefaultExtensions "markdown" = pandocExtensions

277getDefaultExtensions "plain" = pandocExtensions

278+getDefaultExtensions "org" = Set.fromList [Ext_citations]

278getDefaultExtensions "textile" = Set.fromList [Ext_auto_identifiers, Ext_raw_tex]

279getDefaultExtensions "textile" = Set.fromList [Ext_auto_identifiers, Ext_raw_tex]

279getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers]

280getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers]

280

281

@@ -319,4 +320,3 @@ readJSON _ = either error id . eitherDecode' . UTF8.fromStringLazy

319

320

320writeJSON :: WriterOptions -> Pandoc -> String

321writeJSON :: WriterOptions -> Pandoc -> String

321writeJSON _ = UTF8.toStringLazy . encode

322writeJSON _ = UTF8.toStringLazy . encode

322−

src/Text/Pandoc/Parsing.hs+36−9

@@ -54,7 +54,6 @@ module Text.Pandoc.Parsing ( (>>~),

54 withRaw,

55 escaped,

56 characterReference,

57− updateLastStrPos,

58 anyOrderedListMarker,

57 anyOrderedListMarker,

59 orderedListMarker,

58 orderedListMarker,

60 charRef,

59 charRef,

@@ -66,11 +65,14 @@ module Text.Pandoc.Parsing ( (>>~),

66 testStringWith,

65 testStringWith,

67 guardEnabled,

66 guardEnabled,

68 guardDisabled,

67 guardDisabled,

68+ updateLastStrPos,

69+ notAfterString,

69 ParserState (..),

70 ParserState (..),

70 HasReaderOptions (..),

71 HasReaderOptions (..),

71 HasHeaderMap (..),

72 HasHeaderMap (..),

72 HasIdentifierList (..),

73 HasIdentifierList (..),

73 HasMacros (..),

74 HasMacros (..),

75+ HasLastStrPosition (..),

74 defaultParserState,

76 defaultParserState,

75 HeaderType (..),

77 HeaderType (..),

76 ParserContext (..),

78 ParserContext (..),

@@ -92,6 +94,7 @@ module Text.Pandoc.Parsing ( (>>~),

92 apostrophe,

94 apostrophe,

93 dash,

95 dash,

94 nested,

96 nested,

97+ citeKey,

95 macro,

98 macro,

96 applyMacros',

99 applyMacros',

97 Parser,

100 Parser,

@@ -904,6 +907,14 @@ instance HasMacros ParserState where

904 extractMacros = stateMacros

907 extractMacros = stateMacros

905 updateMacros f st = st{ stateMacros = f $ stateMacros st }

908 updateMacros f st = st{ stateMacros = f $ stateMacros st }

906

909

910+class HasLastStrPosition st where

911+ setLastStrPos :: SourcePos -> st -> st

912+ getLastStrPos :: st -> Maybe SourcePos

913+

914+instance HasLastStrPosition ParserState where

915+ setLastStrPos pos st = st{ stateLastStrPos = Just pos }

916+ getLastStrPos st = stateLastStrPos st

917+

907defaultParserState :: ParserState

918defaultParserState :: ParserState

908defaultParserState =

919defaultParserState =

909 ParserState { stateOptions = def,

920 ParserState { stateOptions = def,

@@ -938,6 +949,17 @@ guardEnabled ext = getOption readerExtensions >>= guard . Set.member ext

938guardDisabled :: HasReaderOptions st => Extension -> Parser s st ()

949guardDisabled :: HasReaderOptions st => Extension -> Parser s st ()

939guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext

950guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext

940

951

952+-- | Update the position on which the last string ended.

953+updateLastStrPos :: HasLastStrPosition st => Parser s st ()

954+updateLastStrPos = getPosition >>= updateState . setLastStrPos

955+

956+-- | Whether we are right after the end of a string.

957+notAfterString :: HasLastStrPosition st => Parser s st Bool

958+notAfterString = do

959+ pos <- getPosition

960+ st <- getState

961+ return $ getLastStrPos st /= Just pos

962+

941data HeaderType

963data HeaderType

942 = SingleHeader Char -- ^ Single line of characters underneath

964 = SingleHeader Char -- ^ Single line of characters underneath

943 | DoubleHeader Char -- ^ Lines of characters above and below

965 | DoubleHeader Char -- ^ Lines of characters above and below

@@ -1049,17 +1071,11 @@ charOrRef cs =

1049 guard (c `elem` cs)

1071 guard (c `elem` cs)

1050 return c)

1072 return c)

1051

1073

1052−updateLastStrPos :: Parser [Char] ParserState ()

1053−updateLastStrPos = getPosition >>= \p ->

1054− updateState $ \s -> s{ stateLastStrPos = Just p }

1055−

1056singleQuoteStart :: Parser [Char] ParserState ()

1074singleQuoteStart :: Parser [Char] ParserState ()

1057singleQuoteStart = do

1075singleQuoteStart = do

1058 failIfInQuoteContext InSingleQuote

1076 failIfInQuoteContext InSingleQuote

1059− pos <- getPosition

1060− st <- getState

1061 -- single quote start can't be right after str

1077 -- single quote start can't be right after str

1062− guard $ stateLastStrPos st /= Just pos

1078+ guard =<< notAfterString

1063 () <$ charOrRef "'\8216\145"

1079 () <$ charOrRef "'\8216\145"

1064

1080

1065singleQuoteEnd :: Parser [Char] st ()

1081singleQuoteEnd :: Parser [Char] st ()

@@ -1129,6 +1145,18 @@ nested p = do

1129 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }

1145 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }

1130 return res

1146 return res

1131

1147

1148+citeKey :: HasLastStrPosition st => Parser [Char] st (Bool, String)

1149+citeKey = try $ do

1150+ guard =<< notAfterString

1151+ suppress_author <- option False (char '-' *> return True)

1152+ char '@'

1153+ firstChar <- letter <|> char '_'

1154+ let regchar = satisfy (\c -> isAlphaNum c || c == '_')

1155+ let internal p = try $ p <* lookAhead regchar

1156+ rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/")

1157+ let key = firstChar:rest

1158+ return (suppress_author, key)

1159+

1132--

1160--

1133-- Macros

1161-- Macros

1134--

1162--

@@ -1156,4 +1184,3 @@ applyMacros' target = do

1156 then do macros <- extractMacros `fmap` getState

1184 then do macros <- extractMacros `fmap` getState

1157 return $ applyMacros macros target

1185 return $ applyMacros macros target

1158 else return target

1186 else return target

1159−

src/Text/Pandoc/Readers/Markdown.hs+2−21

@@ -1474,9 +1474,7 @@ strongOrEmph = enclosure '*' <|> (checkIntraword >> enclosure '_')

1474 where checkIntraword = do

1475 exts <- getOption readerExtensions

1476 when (Ext_intraword_underscores `Set.member` exts) $ do

1477− pos <- getPosition

1477+ guard =<< notAfterString

1478− lastStrPos <- stateLastStrPos <$> getState

1479− guard $ lastStrPos /= Just pos

1480

1478

1481-- | Parses a list of inlines between start and end delimiters.

1479-- | Parses a list of inlines between start and end delimiters.

1482inlinesBetween :: (Show b)

1480inlinesBetween :: (Show b)

@@ -1518,8 +1516,7 @@ nonEndline = satisfy (/='\n')

1518str :: MarkdownParser (F Inlines)

1516str :: MarkdownParser (F Inlines)

1519str = do

1517str = do

1520 result <- many1 alphaNum

1518 result <- many1 alphaNum

1521− pos <- getPosition

1519+ updateLastStrPos

1522− updateState $ \s -> s{ stateLastStrPos = Just pos }

1523 let spacesToNbr = map (\c -> if c == ' ' then '\160' else c)

1520 let spacesToNbr = map (\c -> if c == ' ' then '\160' else c)

1524 isSmart <- getOption readerSmart

1521 isSmart <- getOption readerSmart

1525 if isSmart

1522 if isSmart

@@ -1817,22 +1814,6 @@ normalCite = try $ do

1817 char ']'

1814 char ']'

1818 return citations

1815 return citations

1819

1816

1820−citeKey :: MarkdownParser (Bool, String)

1821−citeKey = try $ do

1822− -- make sure we're not right after an alphanumeric,

1823− -- since foo@bar.baz is probably an email address

1824− lastStrPos <- stateLastStrPos <$> getState

1825− pos <- getPosition

1826− guard $ lastStrPos /= Just pos

1827− suppress_author <- option False (char '-' >> return True)

1828− char '@'

1829− first <- letter <|> char '_'

1830− let regchar = satisfy (\c -> isAlphaNum c || c == '_')

1831− let internal p = try $ p >>~ lookAhead regchar

1832− rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/")

1833− let key = first:rest

1834− return (suppress_author, key)

1835−

1836suffix :: MarkdownParser (F Inlines)

1817suffix :: MarkdownParser (F Inlines)

1837suffix = try $ do

1818suffix = try $ do

1838 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1819 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

src/Text/Pandoc/Readers/Org.hs+57−9

@@ -105,6 +105,10 @@ instance HasMeta OrgParserState where

105 deleteMeta field st =

106 st{ orgStateMeta = deleteMeta field $ orgStateMeta st }

107

108+instance HasLastStrPosition OrgParserState where

109+ getLastStrPos = orgStateLastStrPos

110+ setLastStrPos pos st = st{ orgStateLastStrPos = Just pos }

111+

108instance Default OrgParserState where

112instance Default OrgParserState where

109 def = defaultOrgParserState

113 def = defaultOrgParserState

110

114

@@ -865,6 +869,7 @@ inline :: OrgParser (F Inlines)

865inline =

869inline =

866 choice [ whitespace

870 choice [ whitespace

867 , linebreak

871 , linebreak

872+ , cite

868 , footnote

873 , footnote

869 , linkOrImage

874 , linkOrImage

870 , anchor

875 , anchor

@@ -929,6 +934,51 @@ endline = try $ do

929 updateLastPreCharPos

934 updateLastPreCharPos

930 return . return $ B.space

935 return . return $ B.space

931

936

937+cite :: OrgParser (F Inlines)

938+cite = try $ do

939+ guardEnabled Ext_citations

940+ (cs, raw) <- withRaw normalCite

941+ return $ (flip B.cite (B.text raw)) <$> cs

942+

943+normalCite :: OrgParser (F [Citation])

944+normalCite = try $ char '['

945+ *> skipSpaces

946+ *> citeList

947+ <* skipSpaces

948+ <* char ']'

949+

950+citeList :: OrgParser (F [Citation])

951+citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces)

952+

953+citation :: OrgParser (F Citation)

954+citation = try $ do

955+ pref <- prefix

956+ (suppress_author, key) <- citeKey

957+ suff <- suffix

958+ return $ do

959+ x <- pref

960+ y <- suff

961+ return $ Citation{ citationId = key

962+ , citationPrefix = B.toList x

963+ , citationSuffix = B.toList y

964+ , citationMode = if suppress_author

965+ then SuppressAuthor

966+ else NormalCitation

967+ , citationNoteNum = 0

968+ , citationHash = 0

969+ }

970+ where

971+ prefix = trimInlinesF . mconcat <$>

972+ manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))

973+ suffix = try $ do

974+ hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

975+ skipSpaces

976+ rest <- trimInlinesF . mconcat <$>

977+ many (notFollowedBy (oneOf ";]") *> inline)

978+ return $ if hasSpace

979+ then (B.space <>) <$> rest

980+ else rest

981+

932footnote :: OrgParser (F Inlines)

982footnote :: OrgParser (F Inlines)

933footnote = try $ inlineNote <|> referencedNote

983footnote = try $ inlineNote <|> referencedNote

934

984

@@ -1003,7 +1053,7 @@ selfTarget :: OrgParser String

1003selfTarget = try $ char '[' *> linkTarget <* char ']'

1053selfTarget = try $ char '[' *> linkTarget <* char ']'

1004

1054

1005linkTarget :: OrgParser String

1055linkTarget :: OrgParser String

1006−linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")

1056+linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")

1007

1057

1008applyCustomLinkFormat :: String -> OrgParser (F String)

1058applyCustomLinkFormat :: String -> OrgParser (F String)

1009applyCustomLinkFormat link = do

1059applyCustomLinkFormat link = do

@@ -1079,7 +1129,12 @@ inlineCodeBlock = try $ do

1079 let attrClasses = [translateLang lang, rundocBlockClass]

1129 let attrClasses = [translateLang lang, rundocBlockClass]

1080 let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

1130 let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

1081 returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

1131 returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

1132+

1133+enclosedByPair :: Char -- ^ opening char

1134+ -> Char -- ^ closing char

1135+ -> OrgParser a -- ^ parser

1136+ -> OrgParser [a]

1082− where enclosedByPair s e p = char s *> many1Till p (char e)

1137+enclosedByPair s e p = char s *> many1Till p (char e)

1083

1138

1084emph :: OrgParser (F Inlines)

1139emph :: OrgParser (F Inlines)

1085emph = fmap B.emph <$> emphasisBetween '/'

1140emph = fmap B.emph <$> emphasisBetween '/'

@@ -1274,13 +1329,6 @@ afterEmphasisPreChar = do

1274 lastPrePos <- orgStateLastPreCharPos <$> getState

1329 lastPrePos <- orgStateLastPreCharPos <$> getState

1275 return . fromMaybe True $ (== pos) <$> lastPrePos

1330 return . fromMaybe True $ (== pos) <$> lastPrePos

1276

1331

1277−-- | Whether we are right after the end of a string

1278−notAfterString :: OrgParser Bool

1279−notAfterString = do

1280− pos <- getPosition

1281− lastStrPos <- orgStateLastStrPos <$> getState

1282− return $ lastStrPos /= Just pos

1283−

1284-- | Whether the parser is right after a forbidden border char

1332-- | Whether the parser is right after a forbidden border char

1285notAfterForbiddenBorderChar :: OrgParser Bool

1333notAfterForbiddenBorderChar :: OrgParser Bool

1286notAfterForbiddenBorderChar = do

1334notAfterForbiddenBorderChar = do

tests/Tests/Readers/Org.hs+22

@@ -225,6 +225,28 @@ tests =

225 ]

226 )

227 "echo 'Hello, World'")

228+

229+ , "Citation" =:

230+ "[@nonexistent]" =?>

231+ let citation = Citation

232+ { citationId = "nonexistent"

233+ , citationPrefix = []

234+ , citationSuffix = []

235+ , citationMode = NormalCitation

236+ , citationNoteNum = 0

237+ , citationHash = 0}

238+ in (para $ cite [citation] "[@nonexistent]")

239+

240+ , "Citation containing text" =:

241+ "[see @item1 p. 34-35]" =?>

242+ let citation = Citation

243+ { citationId = "item1"

244+ , citationPrefix = [Str "see"]

245+ , citationSuffix = [Space ,Str "p.",Space,Str "34-35"]

246+ , citationMode = NormalCitation

247+ , citationNoteNum = 0

248+ , citationHash = 0}

249+ in (para $ cite [citation] "[see @item1 p. 34-35]")

228 ]

250 ]

229

251

230 , testGroup "Meta Information" $

252 , testGroup "Meta Information" $