From 346bcea713f933a6cf48829d948e14b9c28b4798 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Wed, 16 Apr 2014 13:22:48 +0200
Subject: [PATCH 01/13] Org reader: Better module description, minor style
changes
Use module description analogous to the markdown reader's.
Use (<$) where it makes sense.
---
src/Text/Pandoc/Readers/Org.hs | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index bda0b0262..c4ea64ba7 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -24,7 +24,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Maintainer : Albert Krewinkel <tarleb@moltkeplatz.de>
-Conversion of Org-Mode to 'Pandoc' document.
+Conversion of org-mode formatted plain text to 'Pandoc' document.
-}
module Text.Pandoc.Readers.Org ( readOrg ) where
@@ -711,7 +711,7 @@ math1CharBetween c = try $ do
char c
res <- noneOf $ c:mathForbiddenBorderChars
char c
- eof <|> lookAhead (oneOf mathPostChars) *> return ()
+ eof <|> () <$ lookAhead (oneOf mathPostChars)
return [res]
rawMathBetween :: String
@@ -734,12 +734,12 @@ emphasisEnd :: Char -> OrgParser Char
emphasisEnd c = try $ do
guard =<< notAfterForbiddenBorderChar
char c
- eof <|> lookAhead (surroundingEmphasisChar >>= \x ->
- oneOf (x ++ emphasisPostChars))
- *> return ()
+ eof <|> () <$ lookAhead acceptablePostChars
updateLastStrPos
popInlineCharStack
return c
+ where acceptablePostChars =
+ surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)
mathStart :: Char -> OrgParser Char
mathStart c = try $
@@ -749,7 +749,7 @@ mathEnd :: Char -> OrgParser Char
mathEnd c = try $ do
res <- noneOf (c:mathForbiddenBorderChars)
char c
- eof <|> lookAhead (oneOf mathPostChars *> pure ())
+ eof <|> () <$ lookAhead (oneOf mathPostChars)
return res
From 5fc252270c8332908e3ad9ec12d16c08c49de4a2 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Mon, 14 Apr 2014 15:04:32 +0200
Subject: [PATCH 02/13] Org reader: Fix code for subexpression parsing
---
src/Text/Pandoc/Readers/Org.hs | 25 ++++---------------------
1 file changed, 4 insertions(+), 21 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index c4ea64ba7..ec0436f4c 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -844,24 +844,12 @@ notAfterForbiddenBorderChar = do
-- | Read a sub- or superscript expression
subOrSuperExpr :: OrgParser Inlines
-subOrSuperExpr = try $ do
- choice [ balancedSexp '{' '}'
- , balancedSexp '(' ')' >>= return . enclosing ('(', ')')
+subOrSuperExpr = try $
+ choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")
+ , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
, simpleSubOrSuperString
] >>= parseFromString (mconcat <$> many inline)
-
--- | Read a balanced sexp
-balancedSexp :: Char
- -> Char
- -> OrgParser String
-balancedSexp l r = try $ do
- char l
- res <- concat <$> many ( many1 (noneOf ([l, r] ++ "\n\r"))
- <|> try (string [l, r])
- <|> enclosing (l, r) <$> balancedSexp l r
- )
- char r
- return res
+ where enclosing (left, right) s = left : s ++ [right]
simpleSubOrSuperString :: OrgParser String
simpleSubOrSuperString = try $
@@ -869,8 +857,3 @@ simpleSubOrSuperString = try $
, mappend <$> option [] ((:[]) <$> oneOf "+-")
<*> many1 alphaNum
]
-
-enclosing :: (a, a)
- -> [a]
- -> [a]
-enclosing (left, right) s = left : s ++ [right]
From 92582c6272a3a171c406699e46e88afc4835d85c Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Wed, 16 Apr 2014 11:58:16 +0200
Subject: [PATCH 03/13] Org reader: introduce Reader environment around
Blocks/Inlines
This introduces a Reader environment in the style of
Text.Pandoc.Parsing.F, but adapted to the Org reader parser.
---
src/Text/Pandoc/Readers/Org.hs | 306 +++++++++++++++++++--------------
1 file changed, 176 insertions(+), 130 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index ec0436f4c..bdff4869c 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-
Copyright (C) 2014 Albert Krewinkel <tarleb@moltkeplatz.de>
@@ -29,21 +30,26 @@ Conversion of org-mode formatted plain text to 'Pandoc' document.
module Text.Pandoc.Readers.Org ( readOrg ) where
import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>), HasMeta(..))
+import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), (<>)
+ , trimInlines )
import Text.Pandoc.Definition
import Text.Pandoc.Options
import qualified Text.Pandoc.Parsing as P
-import Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateLastStrPos)
+import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
+ , newline, orderedListMarker
+ , updateLastStrPos )
import Text.Pandoc.Shared (compactify')
-import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
+import Control.Applicative ( Applicative, pure
+ , (<$>), (<$), (<*>), (<*), (*>), (<**>) )
import Control.Arrow ((***))
-import Control.Monad (guard, when)
+import Control.Monad (foldM, guard, liftM, liftM2, when)
+import Control.Monad.Reader (Reader, runReader)
import Data.Char (toLower)
import Data.Default
-import Data.List (foldl', isPrefixOf, isSuffixOf)
+import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (listToMaybe, fromMaybe)
-import Data.Monoid (mconcat, mempty, mappend)
+import Data.Monoid (Monoid, mconcat, mempty, mappend)
-- | Parse org-mode string and return a Pandoc document.
readOrg :: ReaderOptions -- ^ Reader options
@@ -55,10 +61,10 @@ type OrgParser = Parser [Char] OrgParserState
parseOrg:: OrgParser Pandoc
parseOrg = do
- blocks' <- B.toList <$> parseBlocks
+ blocks' <- parseBlocks
st <- getState
- let meta = orgStateMeta st
- return $ Pandoc meta $ filter (/= Null) blocks'
+ let meta = runF (orgStateMeta' st) st
+ return $ Pandoc meta $ filter (/= Null) (B.toList $ runF blocks' st)
--
-- Parser State for Org
@@ -73,7 +79,8 @@ data OrgParserState = OrgParserState
, orgStateLastPreCharPos :: Maybe SourcePos
, orgStateLastStrPos :: Maybe SourcePos
, orgStateMeta :: Meta
- } deriving (Show)
+ , orgStateMeta' :: F Meta
+ }
instance HasReaderOptions OrgParserState where
extractReaderOptions = orgStateOptions
@@ -96,6 +103,7 @@ defaultOrgParserState = OrgParserState
, orgStateLastPreCharPos = Nothing
, orgStateLastStrPos = Nothing
, orgStateMeta = nullMeta
+ , orgStateMeta' = return nullMeta
}
updateLastStrPos :: OrgParser ()
@@ -138,6 +146,27 @@ resetEmphasisNewlines :: OrgParser ()
resetEmphasisNewlines = updateState $ \s ->
s{ orgStateEmphasisNewlines = Nothing }
+
+--
+-- Adaptions and specializations of parsing utilities
+--
+
+newtype F a = F { unF :: Reader OrgParserState a
+ } deriving (Monad, Applicative, Functor)
+
+runF :: F a -> OrgParserState -> a
+runF = runReader . unF
+
+instance Monoid a => Monoid (F a) where
+ mempty = return mempty
+ mappend = liftM2 mappend
+ mconcat = fmap mconcat . sequence
+
+trimInlinesF :: F Inlines -> F Inlines
+trimInlinesF = liftM trimInlines
+
+
+-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
newline :: OrgParser Char
newline =
P.newline
@@ -148,10 +177,10 @@ newline =
-- parsing blocks
--
-parseBlocks :: OrgParser Blocks
+parseBlocks :: OrgParser (F Blocks)
parseBlocks = mconcat <$> manyTill block eof
-block :: OrgParser Blocks
+block :: OrgParser (F Blocks)
block = choice [ mempty <$ blanklines
, orgBlock
, example
@@ -159,7 +188,7 @@ block = choice [ mempty <$ blanklines
, figure
, specialLine
, header
- , hline
+ , return <$> hline
, list
, table
, paraOrPlain
@@ -169,15 +198,15 @@ block = choice [ mempty <$ blanklines
-- Org Blocks (#+BEGIN_... / #+END_...)
--
-orgBlock :: OrgParser Blocks
+orgBlock :: OrgParser (F Blocks)
orgBlock = try $ do
(indent, blockType, args) <- blockHeader
blockStr <- rawBlockContent indent blockType
let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
case blockType of
"comment" -> return mempty
- "src" -> return $ B.codeBlockWith ("", classArgs, []) blockStr
- _ -> B.divWith ("", [blockType], [])
+ "src" -> return . return $ B.codeBlockWith ("", classArgs, []) blockStr
+ _ -> fmap (B.divWith ("", [blockType], []))
<$> parseFromString parseBlocks blockStr
blockHeader :: OrgParser (Int, String, [String])
@@ -222,15 +251,16 @@ commaEscaped (',':cs@('*':_)) = cs
commaEscaped (',':cs@('#':'+':_)) = cs
commaEscaped cs = cs
-example :: OrgParser Blocks
-example = try $
- B.codeBlockWith ("", ["example"], []) . unlines <$> many1 exampleLine
+example :: OrgParser (F Blocks)
+example = try $ do
+ body <- unlines <$> many1 exampleLine
+ return . return $ B.codeBlockWith ("", ["example"], []) body
exampleLine :: OrgParser String
exampleLine = try $ string ": " *> anyLine
-- Drawers for properties or a logbook
-drawer :: OrgParser Blocks
+drawer :: OrgParser (F Blocks)
drawer = try $ do
drawerStart
manyTill drawerLine (try drawerEnd)
@@ -256,18 +286,20 @@ drawerEnd = try $
--
-- Figures (Image on a line by itself, preceded by name and/or caption)
-figure :: OrgParser Blocks
+figure :: OrgParser (F Blocks)
figure = try $ do
(tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)
<$> nameAndOrCaption
src <- skipSpaces *> selfTarget <* skipSpaces <* newline
guard (isImageFilename src)
- return . B.para $ B.image src tit cap
+ return $ do
+ cap' <- cap
+ return $ B.para $ B.image src tit cap'
where withFigPrefix cs = if "fig:" `isPrefixOf` cs
then cs
else "fig:" ++ cs
-nameAndOrCaption :: OrgParser (Maybe String, Maybe Inlines)
+nameAndOrCaption :: OrgParser (Maybe String, Maybe (F Inlines))
nameAndOrCaption = try $ nameFirst <|> captionFirst
where
nameFirst = try $ do
@@ -279,7 +311,7 @@ nameAndOrCaption = try $ nameFirst <|> captionFirst
n <- optionMaybe name
return (n, Just c)
-caption :: OrgParser Inlines
+caption :: OrgParser (F Inlines)
caption = try $ annotation "CAPTION" *> inlinesTillNewline
name :: OrgParser String
@@ -289,8 +321,8 @@ annotation :: String -> OrgParser String
annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'
-- Comments, Options and Metadata
-specialLine :: OrgParser Blocks
-specialLine = try $ metaLine <|> commentLine
+specialLine :: OrgParser (F Blocks)
+specialLine = fmap return . try $ metaLine <|> commentLine
metaLine :: OrgParser Blocks
metaLine = try $ metaLineStart *> declarationLine
@@ -308,12 +340,15 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
declarationLine :: OrgParser Blocks
declarationLine = try $ do
- meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta
- updateState $ \st -> st { orgStateMeta = orgStateMeta st <> meta' }
+ key <- metaKey
+ inlinesF <- metaInlines
+ updateState $ \st ->
+ let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta
+ in st { orgStateMeta' = orgStateMeta' st <> meta' }
return mempty
-metaValue :: OrgParser MetaValue
-metaValue = MetaInlines . B.toList <$> inlinesTillNewline
+metaInlines :: OrgParser (F MetaValue)
+metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
metaKey :: OrgParser String
metaKey = map toLower <$> many1 (noneOf ": \n\r")
@@ -321,16 +356,20 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")
<* skipSpaces
-- | Headers
-header :: OrgParser Blocks
-header = try $
- B.header <$> headerStart
- <*> inlinesTillNewline
+header :: OrgParser (F Blocks)
+header = try $ do
+ level <- headerStart
+ title <- inlinesTillNewline
+ return $ B.header level <$> title
headerStart :: OrgParser Int
headerStart = try $
(length <$> many1 (char '*')) <* many1 (char ' ')
--- Horizontal Line (five dashes or more)
+-- Don't use (or need) the reader wrapper here, we want hline to be
+-- @show@able. Otherwise we can't use it with @notFollowedBy'@.
+
+-- | Horizontal Line (five -- dashes or more)
hline :: OrgParser Blocks
hline = try $ do
skipSpaces
@@ -344,22 +383,23 @@ hline = try $ do
-- Tables
--
-data OrgTableRow = OrgContentRow [Blocks]
+data OrgTableRow = OrgContentRow (F [Blocks])
| OrgAlignRow [Alignment]
| OrgHlineRow
- deriving (Eq, Show)
data OrgTable = OrgTable
{ orgTableColumns :: Int
, orgTableAlignments :: [Alignment]
, orgTableHeader :: [Blocks]
, orgTableRows :: [[Blocks]]
- } deriving (Eq, Show)
+ }
-table :: OrgParser Blocks
+table :: OrgParser (F Blocks)
table = try $ do
lookAhead tableStart
- orgToPandocTable . normalizeTable . rowsToTable <$> tableRows
+ do
+ rows <- tableRows
+ return $ return . orgToPandocTable . normalizeTable =<< rowsToTable rows
orgToPandocTable :: OrgTable
-> Blocks
@@ -374,11 +414,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
tableContentRow :: OrgParser OrgTableRow
tableContentRow = try $
- OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)
+ OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)
-tableContentCell :: OrgParser Blocks
+tableContentCell :: OrgParser (F Blocks)
tableContentCell = try $
- B.plain . trimInlines . mconcat <$> many1Till inline endOfCell
+ fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell
endOfCell :: OrgParser Char
endOfCell = try $ char '|' <|> lookAhead newline
@@ -410,8 +450,8 @@ tableHline = try $
OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
rowsToTable :: [OrgTableRow]
- -> OrgTable
-rowsToTable = foldl' (flip rowToContent) zeroTable
+ -> F OrgTable
+rowsToTable = foldM (flip rowToContent) zeroTable
where zeroTable = OrgTable 0 mempty mempty mempty
normalizeTable :: OrgTable
@@ -430,57 +470,64 @@ normalizeTable (OrgTable cols aligns heads lns) =
-- line as a header. All other horizontal lines are discarded.
rowToContent :: OrgTableRow
-> OrgTable
- -> OrgTable
-rowToContent OrgHlineRow = maybeBodyToHeader
-rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs
-rowToContent (OrgAlignRow as) = setLongestRow as . setAligns as
+ -> F OrgTable
+rowToContent OrgHlineRow t = maybeBodyToHeader t
+rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t
+rowToContent (OrgContentRow rf) t = do
+ rs <- rf
+ setLongestRow rs =<< appendToBody rs t
setLongestRow :: [a]
-> OrgTable
- -> OrgTable
-setLongestRow rs t = t{ orgTableColumns = max (length rs) (orgTableColumns t) }
+ -> F OrgTable
+setLongestRow rs t =
+ return t{ orgTableColumns = max (length rs) (orgTableColumns t) }
maybeBodyToHeader :: OrgTable
- -> OrgTable
+ -> F OrgTable
maybeBodyToHeader t = case t of
OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
- t{ orgTableHeader = b , orgTableRows = [] }
- _ -> t
+ return t{ orgTableHeader = b , orgTableRows = [] }
+ _ -> return t
appendToBody :: [Blocks]
-> OrgTable
- -> OrgTable
-appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }
+ -> F OrgTable
+appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }
setAligns :: [Alignment]
-> OrgTable
- -> OrgTable
-setAligns aligns t = t{ orgTableAlignments = aligns }
+ -> F OrgTable
+setAligns aligns t = return $ t{ orgTableAlignments = aligns }
-- Paragraphs or Plain text
-paraOrPlain :: OrgParser Blocks
+paraOrPlain :: OrgParser (F Blocks)
paraOrPlain = try $
- parseInlines <**> option B.plain (try $ newline *> pure B.para)
+ parseInlines <**> (fmap <$> option B.plain (try $ newline *> pure B.para))
-inlinesTillNewline :: OrgParser Inlines
-inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline
+inlinesTillNewline :: OrgParser (F Inlines)
+inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
--
-- list blocks
--
-list :: OrgParser Blocks
+list :: OrgParser (F Blocks)
list = choice [ definitionList, bulletList, orderedList ] <?> "list"
-definitionList :: OrgParser Blocks
-definitionList = B.definitionList <$> many1 (definitionListItem bulletListStart)
+definitionList :: OrgParser (F Blocks)
+definitionList = fmap B.definitionList . sequence
+ <$> many1 (definitionListItem bulletListStart)
-bulletList :: OrgParser Blocks
-bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)
+bulletList :: OrgParser (F Blocks)
+bulletList = fmap B.bulletList . fmap compactify' . sequence
+ <$> many1 (listItem bulletListStart)
-orderedList :: OrgParser Blocks
-orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
+orderedList :: OrgParser (F Blocks)
+-- orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
+orderedList = fmap B.orderedList . fmap compactify' . sequence
+ <$> many1 (listItem orderedListStart)
genericListStart :: OrgParser String
-> OrgParser Int
@@ -499,7 +546,7 @@ orderedListStart = genericListStart orderedListMarker
where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
definitionListItem :: OrgParser Int
- -> OrgParser (Inlines, [Blocks])
+ -> OrgParser (F (Inlines, [Blocks]))
definitionListItem parseMarkerGetLength = try $ do
markerLength <- parseMarkerGetLength
term <- manyTill (noneOf "\n\r") (try $ string "::")
@@ -507,12 +554,12 @@ definitionListItem parseMarkerGetLength = try $ do
cont <- concat <$> many (listContinuation markerLength)
term' <- parseFromString inline term
contents' <- parseFromString parseBlocks $ first ++ cont
- return (term', [contents'])
+ return $ (,) <$> term' <*> fmap (:[]) contents'
-- parse raw text for one list item, excluding start marker and continuations
listItem :: OrgParser Int
- -> OrgParser Blocks
+ -> OrgParser (F Blocks)
listItem start = try $ do
markerLength <- try start
firstLine <- anyLineNewline
@@ -536,11 +583,11 @@ anyLineNewline = (++ "\n") <$> anyLine
-- inline
--
-inline :: OrgParser Inlines
+inline :: OrgParser (F Inlines)
inline =
choice [ whitespace
, linebreak
- , link
+ , linkOrImage
, str
, endline
, emph
@@ -557,29 +604,29 @@ inline =
] <* (guard =<< newlinesCountWithinLimits)
<?> "inline"
-parseInlines :: OrgParser Inlines
-parseInlines = trimInlines . mconcat <$> many1 inline
+parseInlines :: OrgParser (F Inlines)
+parseInlines = trimInlinesF . mconcat <$> many1 inline
-- treat these as potentially non-text when parsing inline:
specialChars :: [Char]
specialChars = "\"$'()*+-./:<=>[\\]^_{|}~"
-whitespace :: OrgParser Inlines
-whitespace = B.space <$ skipMany1 spaceChar
- <* updateLastPreCharPos
- <* updateLastForbiddenCharPos
+whitespace :: OrgParser (F Inlines)
+whitespace = pure B.space <$ skipMany1 spaceChar
+ <* updateLastPreCharPos
+ <* updateLastForbiddenCharPos
<?> "whitespace"
-linebreak :: OrgParser Inlines
-linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline
+linebreak :: OrgParser (F Inlines)
+linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline
-str :: OrgParser Inlines
-str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
- <* updateLastStrPos
+str :: OrgParser (F Inlines)
+str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
+ <* updateLastStrPos
-- an endline character that can be treated as a space, not a structural break
-endline :: OrgParser Inlines
+endline :: OrgParser (F Inlines)
endline = try $ do
newline
notFollowedBy blankline
@@ -595,29 +642,29 @@ endline = try $ do
decEmphasisNewlinesCount
guard =<< newlinesCountWithinLimits
updateLastPreCharPos
- return B.space
+ return . return $ B.space
-link :: OrgParser Inlines
-link = explicitOrImageLink <|> selflinkOrImage <?> "link"
+linkOrImage :: OrgParser (F Inlines)
+linkOrImage = explicitOrImageLink <|> selflinkOrImage <?> "link or image"
-explicitOrImageLink :: OrgParser Inlines
+explicitOrImageLink :: OrgParser (F Inlines)
explicitOrImageLink = try $ do
char '['
src <- linkTarget
title <- enclosedRaw (char '[') (char ']')
title' <- parseFromString (mconcat <$> many inline) title
char ']'
- return . B.link src ""
- $ if isImageFilename src && isImageFilename title
- then B.image title "" ""
- else title'
+ return $ B.link src "" <$>
+ if isImageFilename src && isImageFilename title
+ then return $ B.image title mempty mempty
+ else title'
-selflinkOrImage :: OrgParser Inlines
+selflinkOrImage :: OrgParser (F Inlines)
selflinkOrImage = try $ do
src <- char '[' *> linkTarget <* char ']'
- return $ if isImageFilename src
- then B.image src "" ""
- else B.link src "" (B.str src)
+ return . return $ if isImageFilename src
+ then B.image src "" ""
+ else B.link src "" (B.str src)
selfTarget :: OrgParser String
selfTarget = try $ char '[' *> linkTarget <* char ']'
@@ -634,51 +681,50 @@ isImageFilename filename =
imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
protocols = [ "file", "http", "https" ]
-emph :: OrgParser Inlines
-emph = B.emph <$> emphasisBetween '/'
+emph :: OrgParser (F Inlines)
+emph = fmap B.emph <$> emphasisBetween '/'
-strong :: OrgParser Inlines
-strong = B.strong <$> emphasisBetween '*'
+strong :: OrgParser (F Inlines)
+strong = fmap B.strong <$> emphasisBetween '*'
-strikeout :: OrgParser Inlines
-strikeout = B.strikeout <$> emphasisBetween '+'
+strikeout :: OrgParser (F Inlines)
+strikeout = fmap B.strikeout <$> emphasisBetween '+'
-- There is no underline, so we use strong instead.
-underline :: OrgParser Inlines
-underline = B.strong <$> emphasisBetween '_'
+underline :: OrgParser (F Inlines)
+underline = fmap B.strong <$> emphasisBetween '_'
-code :: OrgParser Inlines
-code = B.code <$> verbatimBetween '='
+code :: OrgParser (F Inlines)
+code = return . B.code <$> verbatimBetween '='
-verbatim :: OrgParser Inlines
-verbatim = B.rawInline "" <$> verbatimBetween '~'
+verbatim :: OrgParser (F Inlines)
+verbatim = return . B.rawInline "" <$> verbatimBetween '~'
-math :: OrgParser Inlines
-math = B.math <$> choice [ math1CharBetween '$'
- , mathStringBetween '$'
- , rawMathBetween "\\(" "\\)"
- ]
+subscript :: OrgParser (F Inlines)
+subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)
-displayMath :: OrgParser Inlines
-displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
- , rawMathBetween "$$" "$$"
- ]
+superscript :: OrgParser (F Inlines)
+superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)
-subscript :: OrgParser Inlines
-subscript = B.subscript <$> try (char '_' *> subOrSuperExpr)
+math :: OrgParser (F Inlines)
+math = return . B.math <$> choice [ math1CharBetween '$'
+ , mathStringBetween '$'
+ , rawMathBetween "\\(" "\\)"
+ ]
-superscript :: OrgParser Inlines
-superscript = B.superscript <$> try (char '^' *> subOrSuperExpr)
-
-symbol :: OrgParser Inlines
-symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
+displayMath :: OrgParser (F Inlines)
+displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
+ , rawMathBetween "$$" "$$"
+ ]
+symbol :: OrgParser (F Inlines)
+symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
where updatePositions c
| c `elem` emphasisPreChars = c <$ updateLastPreCharPos
| c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos
| otherwise = return c
emphasisBetween :: Char
- -> OrgParser Inlines
+ -> OrgParser (F Inlines)
emphasisBetween c = try $ do
startEmphasisNewlinesCounting emphasisAllowedNewlines
res <- enclosedInlines (emphasisStart c) (emphasisEnd c)
@@ -755,9 +801,9 @@ mathEnd c = try $ do
enclosedInlines :: OrgParser a
-> OrgParser b
- -> OrgParser Inlines
+ -> OrgParser (F Inlines)
enclosedInlines start end = try $
- trimInlines . mconcat <$> enclosed start end inline
+ trimInlinesF . mconcat <$> enclosed start end inline
enclosedRaw :: OrgParser a
-> OrgParser b
@@ -843,7 +889,7 @@ notAfterForbiddenBorderChar = do
return $ lastFBCPos /= Just pos
-- | Read a sub- or superscript expression
-subOrSuperExpr :: OrgParser Inlines
+subOrSuperExpr :: OrgParser (F Inlines)
subOrSuperExpr = try $
choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")
, enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
From 0672f58a445c289c58e42cffbbf32a273e801e39 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Sun, 6 Apr 2014 18:43:49 +0200
Subject: [PATCH 04/13] Org reader: Support footnotes
---
src/Text/Pandoc/Readers/Org.hs | 66 ++++++++++++++++++++++++++++++++--
tests/Tests/Readers/Org.hs | 4 +++
2 files changed, 68 insertions(+), 2 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index bdff4869c..17f8a1c9e 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -44,7 +44,7 @@ import Control.Applicative ( Applicative, pure
, (<$>), (<$), (<*>), (<*), (*>), (<**>) )
import Control.Arrow ((***))
import Control.Monad (foldM, guard, liftM, liftM2, when)
-import Control.Monad.Reader (Reader, runReader)
+import Control.Monad.Reader (Reader, runReader, ask, asks)
import Data.Char (toLower)
import Data.Default
import Data.List (isPrefixOf, isSuffixOf)
@@ -59,7 +59,7 @@ readOrg opts s = readWith parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
type OrgParser = Parser [Char] OrgParserState
-parseOrg:: OrgParser Pandoc
+parseOrg :: OrgParser Pandoc
parseOrg = do
blocks' <- parseBlocks
st <- getState
@@ -70,6 +70,9 @@ parseOrg = do
-- Parser State for Org
--
+type OrgNoteRecord = (String, F Blocks)
+type OrgNoteTable = [OrgNoteRecord]
+
-- | Org-mode parser state
data OrgParserState = OrgParserState
{ orgStateOptions :: ReaderOptions
@@ -80,6 +83,7 @@ data OrgParserState = OrgParserState
, orgStateLastStrPos :: Maybe SourcePos
, orgStateMeta :: Meta
, orgStateMeta' :: F Meta
+ , orgStateNotes' :: OrgNoteTable
}
instance HasReaderOptions OrgParserState where
@@ -104,6 +108,7 @@ defaultOrgParserState = OrgParserState
, orgStateLastStrPos = Nothing
, orgStateMeta = nullMeta
, orgStateMeta' = return nullMeta
+ , orgStateNotes' = []
}
updateLastStrPos :: OrgParser ()
@@ -146,6 +151,11 @@ resetEmphasisNewlines :: OrgParser ()
resetEmphasisNewlines = updateState $ \s ->
s{ orgStateEmphasisNewlines = Nothing }
+addToNotesTable :: OrgNoteRecord -> OrgParser ()
+addToNotesTable note = do
+ oldnotes <- orgStateNotes' <$> getState
+ updateState $ \s -> s{ orgStateNotes' = note:oldnotes }
+
--
-- Adaptions and specializations of parsing utilities
@@ -157,6 +167,12 @@ newtype F a = F { unF :: Reader OrgParserState a
runF :: F a -> OrgParserState -> a
runF = runReader . unF
+askF :: F OrgParserState
+askF = F ask
+
+asksF :: (OrgParserState -> a) -> F a
+asksF f = F $ asks f
+
instance Monoid a => Monoid (F a) where
mempty = return mempty
mappend = liftM2 mappend
@@ -191,6 +207,7 @@ block = choice [ mempty <$ blanklines
, return <$> hline
, list
, table
+ , noteBlock
, paraOrPlain
] <?> "block"
@@ -500,6 +517,16 @@ setAligns :: [Alignment]
-> F OrgTable
setAligns aligns t = return $ t{ orgTableAlignments = aligns }
+--
+-- Footnote defintions
+--
+noteBlock :: OrgParser (F Blocks)
+noteBlock = try $ do
+ ref <- noteMarker
+ content <- skipSpaces *> paraOrPlain
+ addToNotesTable (ref, content)
+ return mempty
+
-- Paragraphs or Plain text
paraOrPlain :: OrgParser (F Blocks)
paraOrPlain = try $
@@ -587,6 +614,7 @@ inline :: OrgParser (F Inlines)
inline =
choice [ whitespace
, linebreak
+ , footnote
, linkOrImage
, str
, endline
@@ -632,6 +660,7 @@ endline = try $ do
notFollowedBy blankline
notFollowedBy' exampleLine
notFollowedBy' hline
+ notFollowedBy' noteMarker
notFollowedBy' tableStart
notFollowedBy' drawerStart
notFollowedBy' headerStart
@@ -644,6 +673,39 @@ endline = try $ do
updateLastPreCharPos
return . return $ B.space
+footnote :: OrgParser (F Inlines)
+footnote = try $ inlineNote <|> referencedNote
+
+inlineNote :: OrgParser (F Inlines)
+inlineNote = try $ do
+ string "[fn:"
+ ref <- many alphaNum
+ char ':'
+ note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')
+ when (not $ null ref) $
+ addToNotesTable ("fn:" ++ ref, note)
+ return $ B.note <$> note
+
+referencedNote :: OrgParser (F Inlines)
+referencedNote = try $ do
+ ref <- noteMarker
+ return $ do
+ notes <- asksF orgStateNotes'
+ case lookup ref notes of
+ Nothing -> return $ B.str $ "[" ++ ref ++ "]"
+ Just contents -> do
+ st <- askF
+ let contents' = runF contents st{ orgStateNotes' = [] }
+ return $ B.note contents'
+
+noteMarker :: OrgParser String
+noteMarker = try $ do
+ char '['
+ choice [ many1Till digit (char ']')
+ , (++) <$> string "fn:"
+ <*> many1Till (noneOf "\n\r\t ") (char ']')
+ ]
+
linkOrImage :: OrgParser (F Inlines)
linkOrImage = explicitOrImageLink <|> selflinkOrImage <?> "link or image"
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index f39bd7992..7f9c5f1d5 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -98,6 +98,10 @@ tests =
"line \\\\ \nbreak" =?>
para ("line" <> linebreak <> "break")
+ , "Inline note" =:
+ "[fn::Schreib mir eine E-Mail]" =?>
+ para (note $ para "Schreib mir eine E-Mail")
+
, "Markup-chars not occuring on word break are symbols" =:
unlines [ "this+that+ +so+on"
, "seven*eight* nine*"
From 6d6724cf2c6ae6bcc0df312c476e45644c972a85 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Thu, 17 Apr 2014 18:09:27 +0200
Subject: [PATCH 05/13] Org reader: Support more types of '#+BEGIN_<type>'
blocks
Support for standard org-blocks is improved. The parser now handles
"HTML", "LATEX", "ASCII", "EXAMPLE", "QUOTE" and "VERSE" blocks in a
sensible fashion.
---
src/Text/Pandoc/Readers/Org.hs | 41 +++++++++++---
tests/Tests/Readers/Org.hs | 97 ++++++++++++++++++++++++++--------
2 files changed, 108 insertions(+), 30 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 17f8a1c9e..88e81f5fc 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -37,6 +37,7 @@ import Text.Pandoc.Options
import qualified Text.Pandoc.Parsing as P
import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
, newline, orderedListMarker
+ , parseFromString
, updateLastStrPos )
import Text.Pandoc.Shared (compactify')
@@ -47,7 +48,7 @@ import Control.Monad (foldM, guard, liftM, liftM2, when)
import Control.Monad.Reader (Reader, runReader, ask, asks)
import Data.Char (toLower)
import Data.Default
-import Data.List (isPrefixOf, isSuffixOf)
+import Data.List (intersperse, isPrefixOf, isSuffixOf)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Monoid (Monoid, mconcat, mempty, mappend)
@@ -156,6 +157,16 @@ addToNotesTable note = do
oldnotes <- orgStateNotes' <$> getState
updateState $ \s -> s{ orgStateNotes' = note:oldnotes }
+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts
+-- of the state saved and restored.
+parseFromString :: OrgParser a -> String -> OrgParser a
+parseFromString parser str' = do
+ oldLastPreCharPos <- orgStateLastPreCharPos <$> getState
+ updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }
+ result <- P.parseFromString parser str'
+ updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }
+ return result
+
--
-- Adaptions and specializations of parsing utilities
@@ -218,13 +229,27 @@ block = choice [ mempty <$ blanklines
orgBlock :: OrgParser (F Blocks)
orgBlock = try $ do
(indent, blockType, args) <- blockHeader
- blockStr <- rawBlockContent indent blockType
+ content <- rawBlockContent indent blockType
+ contentBlocks <- parseFromString parseBlocks (content ++ "\n")
let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
case blockType of
"comment" -> return mempty
- "src" -> return . return $ B.codeBlockWith ("", classArgs, []) blockStr
- _ -> fmap (B.divWith ("", [blockType], []))
- <$> parseFromString parseBlocks blockStr
+ "src" -> returnF $ B.codeBlockWith ("", classArgs, []) content
+ "html" -> returnF $ B.rawBlock "html" content
+ "latex" -> returnF $ B.rawBlock "latex" content
+ "ascii" -> returnF $ B.rawBlock "ascii" content
+ "example" -> returnF $ exampleCode content
+ "quote" -> return $ B.blockQuote <$> contentBlocks
+ "verse" -> parseVerse content
+ _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks
+ where
+ returnF :: a -> OrgParser (F a)
+ returnF = return . return
+
+ parseVerse :: String -> OrgParser (F Blocks)
+ parseVerse cs =
+ fmap B.para . mconcat . intersperse (pure B.linebreak)
+ <$> mapM (parseFromString parseInlines) (lines cs)
blockHeader :: OrgParser (Int, String, [String])
blockHeader = (,,) <$> blockIndent
@@ -270,8 +295,10 @@ commaEscaped cs = cs
example :: OrgParser (F Blocks)
example = try $ do
- body <- unlines <$> many1 exampleLine
- return . return $ B.codeBlockWith ("", ["example"], []) body
+ return . return . exampleCode =<< unlines <$> many1 exampleLine
+
+exampleCode :: String -> Blocks
+exampleCode = B.codeBlockWith ("", ["example"], [])
exampleLine :: OrgParser String
exampleLine = try $ string ": " *> anyLine
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 7f9c5f1d5..7d5bfe650 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -363,29 +363,6 @@ tests =
, "#+END_COMMENT"] =?>
(mempty::Blocks)
- , "Source Block in Text" =:
- unlines [ "Low German greeting"
- , " #+BEGIN_SRC haskell"
- , " main = putStrLn greeting"
- , " where greeting = \"moin\""
- , " #+END_SRC" ] =?>
- let attr' = ("", ["haskell"], [])
- code' = "main = putStrLn greeting\n" ++
- " where greeting = \"moin\"\n"
- in mconcat [ para $ spcSep [ "Low", "German", "greeting" ]
- , codeBlockWith attr' code'
- ]
-
- , "Source Block" =:
- unlines [ " #+BEGIN_SRC haskell"
- , " main = putStrLn greeting"
- , " where greeting = \"moin\""
- , " #+END_SRC" ] =?>
- let attr' = ("", ["haskell"], [])
- code' = "main = putStrLn greeting\n" ++
- " where greeting = \"moin\"\n"
- in codeBlockWith attr' code'
-
, "Figure" =:
unlines [ "#+caption: A very courageous man."
, "#+name: goodguy"
@@ -661,4 +638,78 @@ tests =
, [ plain "2" , plain mempty , plain mempty ]
]
]
+
+ , testGroup "Blocks"
+ [ "Source block" =:
+ unlines [ " #+BEGIN_SRC haskell"
+ , " main = putStrLn greeting"
+ , " where greeting = \"moin\""
+ , " #+END_SRC" ] =?>
+ let attr' = ("", ["haskell"], [])
+ code' = "main = putStrLn greeting\n" ++
+ " where greeting = \"moin\"\n"
+ in codeBlockWith attr' code'
+
+ , "Source block between paragraphs" =:
+ unlines [ "Low German greeting"
+ , " #+BEGIN_SRC haskell"
+ , " main = putStrLn greeting"
+ , " where greeting = \"Moin!\""
+ , " #+END_SRC" ] =?>
+ let attr' = ("", ["haskell"], [])
+ code' = "main = putStrLn greeting\n" ++
+ " where greeting = \"Moin!\"\n"
+ in mconcat [ para $ spcSep [ "Low", "German", "greeting" ]
+ , codeBlockWith attr' code'
+ ]
+
+ , "Example block" =:
+ unlines [ "#+begin_example"
+ , "A chosen representation of"
+ , "a rule."
+ , "#+eND_exAMPle"
+ ] =?>
+ codeBlockWith ("", ["example"], [])
+ "A chosen representation of\na rule.\n"
+
+ , "HTML block" =:
+ unlines [ "#+BEGIN_HTML"
+ , "<aside>HTML5 is pretty nice.</aside>"
+ , "#+END_HTML"
+ ] =?>
+ rawBlock "html" "<aside>HTML5 is pretty nice.</aside>\n"
+
+ , "Quote block" =:
+ unlines [ "#+BEGIN_QUOTE"
+ , "/Niemand/ hat die Absicht, eine Mauer zu errichten!"
+ , "#+END_QUOTE"
+ ] =?>
+ blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht,"
+ , "eine", "Mauer", "zu", "errichten!"
+ ]))
+
+ , "Verse block" =:
+ unlines [ "The first lines of Goethe's /Faust/:"
+ , "#+begin_verse"
+ , "Habe nun, ach! Philosophie,"
+ , "Juristerei und Medizin,"
+ , "Und leider auch Theologie!"
+ , "Durchaus studiert, mit heißem Bemühn."
+ , "#+end_verse"
+ ] =?>
+ mconcat
+ [ para $ spcSep [ "The", "first", "lines", "of"
+ , "Goethe's", emph "Faust" <> ":"]
+ , para $ mconcat
+ [ spcSep [ "Habe", "nun,", "ach!", "Philosophie," ]
+ , linebreak
+ , spcSep [ "Juristerei", "und", "Medizin," ]
+ , linebreak
+ , spcSep [ "Und", "leider", "auch", "Theologie!" ]
+ , linebreak
+ , spcSep [ "Durchaus", "studiert,", "mit", "heißem", "Bemühn." ]
+ ]
+ ]
+
+ ]
]
From f19d7233d8d3e47912b760fc62a253e5baf8275a Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Fri, 18 Apr 2014 08:33:25 +0200
Subject: [PATCH 06/13] Org reader: Fix parsing of loose lists
Loose lists (i.e. lists with blankline separated items), were parsed as
multiple lists, each containing a single item. This patch fixes this
issue.
---
src/Text/Pandoc/Readers/Org.hs | 11 +++++++----
tests/Tests/Readers/Org.hs | 21 ++++++++++++++++-----
2 files changed, 23 insertions(+), 9 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 88e81f5fc..1fa8d4d5e 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -605,9 +605,10 @@ definitionListItem parseMarkerGetLength = try $ do
markerLength <- parseMarkerGetLength
term <- manyTill (noneOf "\n\r") (try $ string "::")
first <- anyLineNewline
+ blank <- option "" ("\n" <$ blankline)
cont <- concat <$> many (listContinuation markerLength)
term' <- parseFromString inline term
- contents' <- parseFromString parseBlocks $ first ++ cont
+ contents' <- parseFromString parseBlocks $ first ++ blank ++ cont
return $ (,) <$> term' <*> fmap (:[]) contents'
@@ -617,16 +618,18 @@ listItem :: OrgParser Int
listItem start = try $ do
markerLength <- try start
firstLine <- anyLineNewline
+ blank <- option "" ("\n" <$ blankline)
rest <- concat <$> many (listContinuation markerLength)
- parseFromString parseBlocks $ firstLine ++ rest
+ parseFromString parseBlocks $ firstLine ++ blank ++ rest
-- continuation of a list item - indented and separated by blankline or endline.
-- Note: nested lists are parsed as continuations.
listContinuation :: Int
-> OrgParser String
listContinuation markerLength = try $
- mappend <$> many blankline
- <*> (concat <$> many1 listLine)
+ notFollowedBy' blankline
+ *> (mappend <$> (concat <$> many1 listLine)
+ <*> many blankline)
where listLine = try $ indentWith markerLength *> anyLineNewline
anyLineNewline :: OrgParser String
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 7d5bfe650..572fc501f 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -518,13 +518,24 @@ tests =
, ("TTL", [ plain $ "transistor-transistor" <> space <>
"logic" ])
, ("PSK", [ mconcat
- [ para $ "phase-shift" <> space <> "keying"
- , plain $ spcSep [ "a", "digital"
- , "modulation", "scheme" ]
+ [ para $ "phase-shift" <> space <> "keying"
+ , para $ spcSep [ "a", "digital"
+ , "modulation", "scheme" ]
]
- ]
- )
+ ])
]
+
+ , "Loose bullet list" =:
+ unlines [ "- apple"
+ , ""
+ , "- orange"
+ , ""
+ , "- peach"
+ ] =?>
+ bulletList [ para "apple"
+ , para "orange"
+ , para "peach"
+ ]
]
, testGroup "Tables"
From 09441b65a83f372410394a88af7808f494c3aa57 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Fri, 18 Apr 2014 10:15:58 +0200
Subject: [PATCH 07/13] Org reader: Add support for plain LaTeX fragments
This adds support for LaTeX fragments like the following:
```
\begin{equation}
\int fg \mathrm{d}x
\end{equation}
```
---
src/Text/Pandoc/Readers/Org.hs | 41 +++++++++++++++++++++++++++++++++-
tests/Tests/Readers/Org.hs | 20 ++++++++++++++++-
2 files changed, 59 insertions(+), 2 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 1fa8d4d5e..66cfe720e 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -218,6 +218,7 @@ block = choice [ mempty <$ blanklines
, return <$> hline
, list
, table
+ , latexFragment
, noteBlock
, paraOrPlain
] <?> "block"
@@ -544,6 +545,41 @@ setAligns :: [Alignment]
-> F OrgTable
setAligns aligns t = return $ t{ orgTableAlignments = aligns }
+
+--
+-- LaTeX fragments
+--
+latexFragment :: OrgParser (F Blocks)
+latexFragment = try $ do
+ envName <- latexEnvStart
+ content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)
+ return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)
+ where
+ c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"
+ , c
+ , "\\end{", e, "}\n"
+ ]
+
+latexEnvStart :: OrgParser String
+latexEnvStart = try $ do
+ skipSpaces *> string "\\begin{"
+ *> latexEnvName
+ <* string "}"
+ <* blankline
+
+latexEnd :: String -> OrgParser ()
+latexEnd envName = try $
+ () <$ skipSpaces
+ <* string ("\\end{" ++ envName ++ "}")
+ <* blankline
+
+-- | Parses a LaTeX environment name.
+latexEnvName :: OrgParser String
+latexEnvName = try $ do
+ mappend <$> many1 alphaNum
+ <*> option "" (string "*")
+
+
--
-- Footnote defintions
--
@@ -683,7 +719,9 @@ str :: OrgParser (F Inlines)
str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
<* updateLastStrPos
--- an endline character that can be treated as a space, not a structural break
+-- | An endline character that can be treated as a space, not a structural
+-- break. This should reflect the values of the Emacs variable
+-- @org-element-pagaraph-separate@.
endline :: OrgParser (F Inlines)
endline = try $ do
newline
@@ -695,6 +733,7 @@ endline = try $ do
notFollowedBy' drawerStart
notFollowedBy' headerStart
notFollowedBy' metaLineStart
+ notFollowedBy' latexEnvStart
notFollowedBy' commentLineStart
notFollowedBy' bulletListStart
notFollowedBy' orderedListStart
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 572fc501f..1ac2c1fd8 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -650,7 +650,7 @@ tests =
]
]
- , testGroup "Blocks"
+ , testGroup "Blocks and fragments"
[ "Source block" =:
unlines [ " #+BEGIN_SRC haskell"
, " main = putStrLn greeting"
@@ -722,5 +722,23 @@ tests =
]
]
+ , "LaTeX fragment" =:
+ unlines [ "\\begin{equation}"
+ , "X_i = \\begin{cases}"
+ , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) = \\alpha(i)\\\\"
+ , " C_{\\alpha(i)} & \\text{otherwise}"
+ , " \\end{cases}"
+ , "\\end{equation}"
+ ] =?>
+ rawBlock "latex"
+ (unlines [ "\\begin{equation}"
+ , "X_i = \\begin{cases}"
+ , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) =" ++
+ " \\alpha(i)\\\\"
+ , " C_{\\alpha(i)} & \\text{otherwise}"
+ , " \\end{cases}"
+ , "\\end{equation}"
+ ])
+
]
]
From 6ded3d41d94c1e90d1d30a1f99ddad62e62d9ce6 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Fri, 18 Apr 2014 20:47:50 +0200
Subject: [PATCH 08/13] Org reader: Apply captions to code blocks and tables
The `Table` blocktype already takes the caption as an argument, while code
blocks are wrapped in a `Div` block together with a labelling `Span`.
---
src/Text/Pandoc/Readers/Org.hs | 134 +++++++++++++++++++++++----------
tests/Tests/Readers/Org.hs | 31 +++++++-
2 files changed, 124 insertions(+), 41 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 66cfe720e..025158060 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -43,13 +43,13 @@ import Text.Pandoc.Shared (compactify')
import Control.Applicative ( Applicative, pure
, (<$>), (<$), (<*>), (<*), (*>), (<**>) )
-import Control.Arrow ((***))
import Control.Monad (foldM, guard, liftM, liftM2, when)
import Control.Monad.Reader (Reader, runReader, ask, asks)
import Data.Char (toLower)
import Data.Default
import Data.List (intersperse, isPrefixOf, isSuffixOf)
-import Data.Maybe (listToMaybe, fromMaybe)
+import qualified Data.Map as M
+import Data.Maybe (listToMaybe, fromMaybe, isJust)
import Data.Monoid (Monoid, mconcat, mempty, mappend)
-- | Parse org-mode string and return a Pandoc document.
@@ -74,9 +74,12 @@ parseOrg = do
type OrgNoteRecord = (String, F Blocks)
type OrgNoteTable = [OrgNoteRecord]
+type OrgBlockAttributes = M.Map String String
+
-- | Org-mode parser state
data OrgParserState = OrgParserState
{ orgStateOptions :: ReaderOptions
+ , orgStateBlockAttributes :: OrgBlockAttributes
, orgStateEmphasisCharStack :: [Char]
, orgStateEmphasisNewlines :: Maybe Int
, orgStateLastForbiddenCharPos :: Maybe SourcePos
@@ -102,6 +105,7 @@ instance Default OrgParserState where
defaultOrgParserState :: OrgParserState
defaultOrgParserState = OrgParserState
{ orgStateOptions = def
+ , orgStateBlockAttributes = M.empty
, orgStateEmphasisCharStack = []
, orgStateEmphasisNewlines = Nothing
, orgStateLastForbiddenCharPos = Nothing
@@ -112,6 +116,19 @@ defaultOrgParserState = OrgParserState
, orgStateNotes' = []
}
+addBlockAttribute :: String -> String -> OrgParser ()
+addBlockAttribute key val = updateState $ \s ->
+ let attrs = orgStateBlockAttributes s
+ in s{ orgStateBlockAttributes = M.insert key val attrs }
+
+lookupBlockAttribute :: String -> OrgParser (Maybe String)
+lookupBlockAttribute key =
+ M.lookup key . orgStateBlockAttributes <$> getState
+
+resetBlockAttributes :: OrgParser ()
+resetBlockAttributes = updateState $ \s ->
+ s{ orgStateBlockAttributes = orgStateBlockAttributes def }
+
updateLastStrPos :: OrgParser ()
updateLastStrPos = getPosition >>= \p ->
updateState $ \s -> s{ orgStateLastStrPos = Just p }
@@ -125,19 +142,19 @@ updateLastPreCharPos = getPosition >>= \p ->
updateState $ \s -> s{ orgStateLastPreCharPos = Just p}
pushToInlineCharStack :: Char -> OrgParser ()
-pushToInlineCharStack c = updateState $ \st ->
- st { orgStateEmphasisCharStack = c:orgStateEmphasisCharStack st }
+pushToInlineCharStack c = updateState $ \s ->
+ s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }
popInlineCharStack :: OrgParser ()
-popInlineCharStack = updateState $ \st ->
- st { orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ st }
+popInlineCharStack = updateState $ \s ->
+ s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }
surroundingEmphasisChar :: OrgParser [Char]
surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState
startEmphasisNewlinesCounting :: Int -> OrgParser ()
startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->
- s { orgStateEmphasisNewlines = Just maxNewlines }
+ s{ orgStateEmphasisNewlines = Just maxNewlines }
decEmphasisNewlinesCount :: OrgParser ()
decEmphasisNewlinesCount = updateState $ \s ->
@@ -209,20 +226,50 @@ parseBlocks = mconcat <$> manyTill block eof
block :: OrgParser (F Blocks)
block = choice [ mempty <$ blanklines
- , orgBlock
+ , optionalAttributes $ choice
+ [ orgBlock
+ , figure
+ , table
+ ]
, example
, drawer
- , figure
, specialLine
, header
, return <$> hline
, list
- , table
, latexFragment
, noteBlock
, paraOrPlain
] <?> "block"
+optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
+optionalAttributes parser = try $
+ resetBlockAttributes *> parseBlockAttributes *> parser
+
+parseBlockAttributes :: OrgParser ()
+parseBlockAttributes = do
+ attrs <- many attribute
+ () <$ mapM (uncurry parseAndAddAttribute) attrs
+ where
+ attribute :: OrgParser (String, String)
+ attribute = try $ do
+ key <- metaLineStart *> many1Till (noneOf "\n\r") (char ':')
+ val <- skipSpaces *> anyLine
+ return (map toLower key, val)
+
+parseAndAddAttribute :: String -> String -> OrgParser ()
+parseAndAddAttribute key value = do
+ let key' = map toLower key
+ () <$ addBlockAttribute key' value
+
+lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
+lookupInlinesAttr attr = try $ do
+ val <- lookupBlockAttribute attr
+ maybe (return Nothing)
+ (fmap Just . parseFromString parseInlines)
+ val
+
+
--
-- Org Blocks (#+BEGIN_... / #+END_...)
--
@@ -235,13 +282,13 @@ orgBlock = try $ do
let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
case blockType of
"comment" -> return mempty
- "src" -> returnF $ B.codeBlockWith ("", classArgs, []) content
"html" -> returnF $ B.rawBlock "html" content
"latex" -> returnF $ B.rawBlock "latex" content
"ascii" -> returnF $ B.rawBlock "ascii" content
"example" -> returnF $ exampleCode content
"quote" -> return $ B.blockQuote <$> contentBlocks
"verse" -> parseVerse content
+ "src" -> codeBlockWithAttr classArgs content
_ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks
where
returnF :: a -> OrgParser (F a)
@@ -260,6 +307,18 @@ blockHeader = (,,) <$> blockIndent
blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)
blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline
+codeBlockWithAttr :: [String] -> String -> OrgParser (F Blocks)
+codeBlockWithAttr classArgs content = do
+ identifier <- fromMaybe "" <$> lookupBlockAttribute "name"
+ caption <- lookupInlinesAttr "caption"
+ let codeBlck = B.codeBlockWith (identifier, classArgs, []) content
+ return $ maybe (pure codeBlck) (labelDiv codeBlck) caption
+ where
+ labelDiv blk value =
+ B.divWith nullAttr <$> (mappend <$> labelledBlock value
+ <*> pure blk)
+ labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
+
rawBlockContent :: Int -> String -> OrgParser String
rawBlockContent indent blockType =
unlines . map commaEscaped <$> manyTill indentedLine blockEnder
@@ -333,38 +392,26 @@ drawerEnd = try $
-- Figures (Image on a line by itself, preceded by name and/or caption)
figure :: OrgParser (F Blocks)
figure = try $ do
- (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)
- <$> nameAndOrCaption
+ (cap, nam) <- nameAndCaption
src <- skipSpaces *> selfTarget <* skipSpaces <* newline
guard (isImageFilename src)
return $ do
cap' <- cap
- return $ B.para $ B.image src tit cap'
- where withFigPrefix cs = if "fig:" `isPrefixOf` cs
- then cs
- else "fig:" ++ cs
-
-nameAndOrCaption :: OrgParser (Maybe String, Maybe (F Inlines))
-nameAndOrCaption = try $ nameFirst <|> captionFirst
+ return $ B.para $ B.image src nam cap'
where
- nameFirst = try $ do
- n <- name
- c <- optionMaybe caption
- return (Just n, c)
- captionFirst = try $ do
- c <- caption
- n <- optionMaybe name
- return (n, Just c)
-
-caption :: OrgParser (F Inlines)
-caption = try $ annotation "CAPTION" *> inlinesTillNewline
-
-name :: OrgParser String
-name = try $ annotation "NAME" *> skipSpaces *> manyTill anyChar newline
-
-annotation :: String -> OrgParser String
-annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'
+ nameAndCaption =
+ do
+ maybeCap <- lookupInlinesAttr "caption"
+ maybeNam <- lookupBlockAttribute "name"
+ guard $ isJust maybeCap || isJust maybeNam
+ return ( fromMaybe mempty maybeCap
+ , maybe mempty withFigPrefix maybeNam )
+ withFigPrefix cs =
+ if "fig:" `isPrefixOf` cs
+ then cs
+ else "fig:" ++ cs
+--
-- Comments, Options and Metadata
specialLine :: OrgParser (F Blocks)
specialLine = fmap return . try $ metaLine <|> commentLine
@@ -400,6 +447,10 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")
<* char ':'
<* skipSpaces
+--
+-- Headers
+--
+
-- | Headers
header :: OrgParser (F Blocks)
header = try $ do
@@ -411,6 +462,7 @@ headerStart :: OrgParser Int
headerStart = try $
(length <$> many1 (char '*')) <* many1 (char ' ')
+
-- Don't use (or need) the reader wrapper here, we want hline to be
-- @show@able. Otherwise we can't use it with @notFollowedBy'@.
@@ -444,12 +496,14 @@ table = try $ do
lookAhead tableStart
do
rows <- tableRows
- return $ return . orgToPandocTable . normalizeTable =<< rowsToTable rows
+ cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
+ return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
orgToPandocTable :: OrgTable
+ -> Inlines
-> Blocks
-orgToPandocTable (OrgTable _ aligns heads lns) =
- B.table "" (zip aligns $ repeat 0) heads lns
+orgToPandocTable (OrgTable _ aligns heads lns) caption =
+ B.table caption (zip aligns $ repeat 0) heads lns
tableStart :: OrgParser Char
tableStart = try $ skipSpaces *> char '|'
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 1ac2c1fd8..80a95d36b 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -8,7 +8,7 @@ import Tests.Arbitrary()
import Text.Pandoc.Builder
import Text.Pandoc
import Data.List (intersperse)
-import Data.Monoid (mempty, mconcat)
+import Data.Monoid (mempty, mappend, mconcat)
org :: String -> Pandoc
org = readOrg def
@@ -648,6 +648,18 @@ tests =
[ [ plain "1" , plain "One" , plain "foo" ]
, [ plain "2" , plain mempty , plain mempty ]
]
+
+ , "Table with caption" =:
+ unlines [ "#+CAPTION: Hitchhiker's Multiplication Table"
+ , "| x | 6 |"
+ , "| 9 | 42 |"
+ ] =?>
+ table "Hitchhiker's Multiplication Table"
+ [(AlignDefault, 0), (AlignDefault, 0)]
+ []
+ [ [ plain "x", plain "6" ]
+ , [ plain "9", plain "42" ]
+ ]
]
, testGroup "Blocks and fragments"
@@ -740,5 +752,22 @@ tests =
, "\\end{equation}"
])
+ , "Code block with caption" =:
+ unlines [ "#+CAPTION: Functor laws in Haskell"
+ , "#+NAME: functor-laws"
+ , "#+BEGIN_SRC haskell"
+ , "fmap id = id"
+ , "fmap (p . q) = (fmap p) . (fmap q)"
+ , "#+END_SRC"
+ ] =?>
+ divWith
+ nullAttr
+ (mappend
+ (plain $ spanWith ("", ["label"], [])
+ (spcSep [ "Functor", "laws", "in", "Haskell" ]))
+ (codeBlockWith ("functor-laws", ["haskell"], [])
+ (unlines [ "fmap id = id"
+ , "fmap (p . q) = (fmap p) . (fmap q)"
+ ])))
]
]
From a69416091ba035ab1661ff306ef3e51fd926488b Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Sat, 19 Apr 2014 11:25:39 +0200
Subject: [PATCH 09/13] Org reader: Fix distinction of images and normal links
Fixed a false assumption about the precedence of (&&) vs (||).
---
src/Text/Pandoc/Readers/Org.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 025158060..66211b20e 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -860,8 +860,8 @@ linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")
isImageFilename :: String -> Bool
isImageFilename filename =
any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
- any (\x -> (x++":") `isPrefixOf` filename) protocols ||
- ':' `notElem` filename
+ (any (\x -> (x++":") `isPrefixOf` filename) protocols ||
+ ':' `notElem` filename)
where
imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
protocols = [ "file", "http", "https" ]
From 8e91d362a392d1ee90a497f39cfcf90fee8d8da0 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Sat, 19 Apr 2014 13:15:47 +0200
Subject: [PATCH 10/13] Org reader: Fix parsing of footnotes
Footnotes can consist of multiple blocks and end only at a header or at
the beginning of another footnote. This fixes the previous behavior,
which restricted notes to a single paragraph.
---
src/Text/Pandoc/Readers/Org.hs | 8 +++++--
tests/Tests/Readers/Org.hs | 42 ++++++++++++++++++++++++++++++++++
2 files changed, 48 insertions(+), 2 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 66211b20e..0bc0a2668 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -639,10 +639,14 @@ latexEnvName = try $ do
--
noteBlock :: OrgParser (F Blocks)
noteBlock = try $ do
- ref <- noteMarker
- content <- skipSpaces *> paraOrPlain
+ ref <- noteMarker <* skipSpaces
+ content <- mconcat <$> blocksTillHeaderOrNote
addToNotesTable (ref, content)
return mempty
+ where
+ blocksTillHeaderOrNote =
+ many1Till block (eof <|> () <$ lookAhead noteMarker
+ <|> () <$ lookAhead headerStart)
-- Paragraphs or Plain text
paraOrPlain :: OrgParser (F Blocks)
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 80a95d36b..4cc405c0f 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -383,6 +383,48 @@ tests =
] =?>
para (image "the-red-queen.jpg" "fig:redqueen"
"Used as a metapher in evolutionary biology.")
+
+ , "Footnote" =:
+ unlines [ "A footnote[1]"
+ , ""
+ , "[1] First paragraph"
+ , ""
+ , "second paragraph"
+ ] =?>
+ para (mconcat
+ [ "A", space, "footnote"
+ , note $ mconcat [ para ("First" <> space <> "paragraph")
+ , para ("second" <> space <> "paragraph")
+ ]
+ ])
+
+ , "Two footnotes" =:
+ unlines [ "Footnotes[fn:1][fn:2]"
+ , ""
+ , "[fn:1] First note."
+ , ""
+ , "[fn:2] Second note."
+ ] =?>
+ para (mconcat
+ [ "Footnotes"
+ , note $ para ("First" <> space <> "note.")
+ , note $ para ("Second" <> space <> "note.")
+ ])
+
+ , "Footnote followed by header" =:
+ unlines [ "Another note[fn:yay]"
+ , ""
+ , "[fn:yay] This is great!"
+ , ""
+ , "** Headline"
+ ] =?>
+ mconcat
+ [ para (mconcat
+ [ "Another", space, "note"
+ , note $ para ("This" <> space <> "is" <> space <> "great!")
+ ])
+ , header 2 "Headline"
+ ]
]
, testGroup "Lists" $
From efebade38b3aef30b5fbf04e60f1fc2bd76e6c6c Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Sat, 19 Apr 2014 14:48:35 +0200
Subject: [PATCH 11/13] Move `compactify'DL` from Markdown reader into Shared
The function `compactify'DL`, used to change the final definition item of a
definition list into a `Plain` iff all other items are `Plain`s as well, is
useful in many parsers and hence moved into Text.Pandoc.Shared.
---
src/Text/Pandoc/Readers/Markdown.hs | 17 -----------------
src/Text/Pandoc/Shared.hs | 20 +++++++++++++++++---
2 files changed, 17 insertions(+), 20 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 57e1ca560..053385d20 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -861,22 +861,6 @@ definitionList = do
items <- fmap sequence $ many1 definitionListItem
return $ B.definitionList <$> fmap compactify'DL items
-compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
-compactify'DL items =
- let defs = concatMap snd items
- defBlocks = reverse $ concatMap B.toList defs
- isPara (Para _) = True
- isPara _ = False
- in case defBlocks of
- (Para x:_) -> if not $ any isPara (drop 1 defBlocks)
- then let (t,ds) = last items
- lastDef = B.toList $ last ds
- ds' = init ds ++
- [B.fromList $ init lastDef ++ [Plain x]]
- in init items ++ [(t, ds')]
- else items
- _ -> items
-
--
-- paragraph block
--
@@ -1892,4 +1876,3 @@ doubleQuoted = try $ do
(withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
(fmap B.doubleQuoted . trimInlinesF $ contents))
<|> (return $ return (B.str "\8220") <> contents)
-
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 3835629db..687355701 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -56,6 +56,7 @@ module Text.Pandoc.Shared (
stringify,
compactify,
compactify',
+ compactify'DL,
Element (..),
hierarchicalize,
uniqueIdent,
@@ -82,7 +83,7 @@ module Text.Pandoc.Shared (
import Text.Pandoc.Definition
import Text.Pandoc.Walk
import Text.Pandoc.Generic
-import Text.Pandoc.Builder (Blocks, ToMetaValue(..))
+import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.UTF8 as UTF8
import System.Environment (getProgName)
@@ -435,6 +436,21 @@ compactify' items =
_ -> items
_ -> items
+-- | Like @compactify'@, but akts on items of definition lists.
+compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
+compactify'DL items =
+ let defs = concatMap snd items
+ defBlocks = reverse $ concatMap B.toList defs
+ in case defBlocks of
+ (Para x:_) -> if not $ any isPara (drop 1 defBlocks)
+ then let (t,ds) = last items
+ lastDef = B.toList $ last ds
+ ds' = init ds ++
+ [B.fromList $ init lastDef ++ [Plain x]]
+ in init items ++ [(t, ds')]
+ else items
+ _ -> items
+
isPara :: Block -> Bool
isPara (Para _) = True
isPara _ = False
@@ -698,5 +714,3 @@ safeRead s = case reads s of
(d,x):_
| all isSpace x -> return d
_ -> fail $ "Could not read `" ++ s ++ "'"
-
-
From 8276449520ba85c78f0b4e919fbc9bcf893a74f0 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Sat, 19 Apr 2014 15:05:03 +0200
Subject: [PATCH 12/13] Org reader: Allow for compact definition lists
Use `Text.Pandoc.Shared.compactify'DL` to allow for compact definition
lists.
---
src/Text/Pandoc/Readers/Org.hs | 4 ++--
tests/Tests/Readers/Org.hs | 12 ++++++++++++
2 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 0bc0a2668..c71cc24be 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -39,7 +39,7 @@ import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
, newline, orderedListMarker
, parseFromString
, updateLastStrPos )
-import Text.Pandoc.Shared (compactify')
+import Text.Pandoc.Shared (compactify', compactify'DL)
import Control.Applicative ( Applicative, pure
, (<$>), (<$), (<*>), (<*), (*>), (<**>) )
@@ -665,7 +665,7 @@ list :: OrgParser (F Blocks)
list = choice [ definitionList, bulletList, orderedList ] <?> "list"
definitionList :: OrgParser (F Blocks)
-definitionList = fmap B.definitionList . sequence
+definitionList = fmap B.definitionList . fmap compactify'DL . sequence
<$> many1 (definitionListItem bulletListStart)
bulletList :: OrgParser (F Blocks)
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 4cc405c0f..f62b73ce4 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -567,6 +567,18 @@ tests =
])
]
+ , "Compact definition list" =:
+ unlines [ "- ATP :: adenosine 5' triphosphate"
+ , "- DNA :: deoxyribonucleic acid"
+ , "- PCR :: polymerase chain reaction"
+ , ""
+ ] =?>
+ definitionList
+ [ ("ATP", [ plain $ spcSep [ "adenosine", "5'", "triphosphate" ] ])
+ , ("DNA", [ plain $ spcSep [ "deoxyribonucleic", "acid" ] ])
+ , ("PCR", [ plain $ spcSep [ "polymerase", "chain", "reaction" ] ])
+ ]
+
, "Loose bullet list" =:
unlines [ "- apple"
, ""
From d44815c79bda5a547fb787af42c019564880bf19 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Sat, 19 Apr 2014 15:25:34 +0200
Subject: [PATCH 13/13] Add license statement for org reader files
This adds a brief note to the COPYRIGHT file, declaring the code in the
org-reader files to be licensed under the GPL.
---
COPYRIGHT | 7 +++++++
1 file changed, 7 insertions(+)
diff --git a/COPYRIGHT b/COPYRIGHT
index 8bf62135e..cfec5a4bf 100644
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -55,6 +55,13 @@ Copyright (C) 2010 Paul Rivier
Released under the GPL.
+----------------------------------------------------------------------
+src/Text/Pandoc/Readers/Org.hs
+tests/Tests/Readers/Org.hs
+Copyright (C) 2014 Albert Krewinkel
+
+Released under the GPL.
+
----------------------------------------------------------------------
src/Text/Pandoc/Biblio.hs
Copyright (C) 2008-2010 Andrea Rossato