b5959b2 · typeable/pandoc

git.iko.soy/typeable/pandoc

Merge pull request #1297 from tarleb/citations

Org reader: support Pandocs citation extension

commitb5959b20073f04b7b5ecb19e2ab0ce56a5ecadb0 authorJohn MacFarlane <jgm@berkeley.edu> dateWed 14 May 2014, 06:37 (12 years ago) parent222a51b ceeb701

5 files changed+118−40

compare with master

unifiedsplit

src/Text/Pandoc.hs+1−1 src/Text/Pandoc/Parsing.hs+36−9 src/Text/Pandoc/Readers/Markdown.hs+2−21 src/Text/Pandoc/Readers/Org.hs+57−9 tests/Tests/Readers/Org.hs+22

src/Text/Pandoc.hs+1−1

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

275275getDefaultExtensions "markdown_github" = githubMarkdownExtensions

276276getDefaultExtensions "markdown" = pandocExtensions

277277getDefaultExtensions "plain" = pandocExtensions

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

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

279280getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers]

280281

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

319320

320321writeJSON :: WriterOptions -> Pandoc -> String

321322writeJSON _ = UTF8.toStringLazy . encode

322−

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

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

5454 withRaw,

5555 escaped,

5656 characterReference,

57− updateLastStrPos,

5857 anyOrderedListMarker,

5958 orderedListMarker,

6059 charRef,

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

6665 testStringWith,

6766 guardEnabled,

6867 guardDisabled,

68+ updateLastStrPos,

69+ notAfterString,

6970 ParserState (..),

7071 HasReaderOptions (..),

7172 HasHeaderMap (..),

7273 HasIdentifierList (..),

7374 HasMacros (..),

75+ HasLastStrPosition (..),

7476 defaultParserState,

7577 HeaderType (..),

7678 ParserContext (..),

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

9294 apostrophe,

9395 dash,

9496 nested,

97+ citeKey,

9598 macro,

9699 applyMacros',

97100 Parser,

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

904907 extractMacros = stateMacros

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

906909

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+

907918defaultParserState :: ParserState

908919defaultParserState =

909920 ParserState { stateOptions = def,

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

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

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

940951

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+

941963data HeaderType

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

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

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

10491071 guard (c `elem` cs)

10501072 return c)

10511073

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

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

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

1055−

10561074singleQuoteStart :: Parser [Char] ParserState ()

10571075singleQuoteStart = do

10581076 failIfInQuoteContext InSingleQuote

1059− pos <- getPosition

1060− st <- getState

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

1062− guard $ stateLastStrPos st /= Just pos

1078+ guard =<< notAfterString

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

10641080

10651081singleQuoteEnd :: Parser [Char] st ()

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

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

11301146 return res

11311147

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+

11321160--

11331161-- Macros

11341162--

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

11561184 then do macros <- extractMacros `fmap` getState

11571185 return $ applyMacros macros target

11581186 else return target

1159−

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

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

14741474 where checkIntraword = do

14751475 exts <- getOption readerExtensions

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

1477− pos <- getPosition

1478− lastStrPos <- stateLastStrPos <$> getState

1479− guard $ lastStrPos /= Just pos

1477+ guard =<< notAfterString

14801478

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

14821480inlinesBetween :: (Show b)

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

15181516str :: MarkdownParser (F Inlines)

15191517str = do

15201518 result <- many1 alphaNum

1521− pos <- getPosition

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

1519+ updateLastStrPos

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

15241521 isSmart <- getOption readerSmart

15251522 if isSmart

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

18171814 char ']'

18181815 return citations

18191816

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−

18361817suffix :: MarkdownParser (F Inlines)

18371818suffix = try $ do

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

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

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

105105 deleteMeta field st =

106106 st{ orgStateMeta = deleteMeta field $ orgStateMeta st }

107107

108+instance HasLastStrPosition OrgParserState where

109+ getLastStrPos = orgStateLastStrPos

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

111+

108112instance Default OrgParserState where

109113 def = defaultOrgParserState

110114

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

865869inline =

866870 choice [ whitespace

867871 , linebreak

872+ , cite

868873 , footnote

869874 , linkOrImage

870875 , anchor

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

929934 updateLastPreCharPos

930935 return . return $ B.space

931936

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+

932982footnote :: OrgParser (F Inlines)

933983footnote = try $ inlineNote <|> referencedNote

934984

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

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

10041054

10051055linkTarget :: OrgParser String

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

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

10071057

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

10091059applyCustomLinkFormat link = do

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

10791129 let attrClasses = [translateLang lang, rundocBlockClass]

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

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

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

1132+

1133+enclosedByPair :: Char -- ^ opening char

1134+ -> Char -- ^ closing char

1135+ -> OrgParser a -- ^ parser

1136+ -> OrgParser [a]

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

10831138

10841139emph :: OrgParser (F Inlines)

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

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

12741329 lastPrePos <- orgStateLastPreCharPos <$> getState

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

12761331

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−

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

12851333notAfterForbiddenBorderChar :: OrgParser Bool

12861334notAfterForbiddenBorderChar = do

tests/Tests/Readers/Org.hs+22

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

225225 ]

226226 )

227227 "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]")

228250 ]

229251

230252 , testGroup "Meta Information" $