summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pandoc.cabal4
-rw-r--r--src/Text/Pandoc/Parsing.hs57
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs2
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs254
-rw-r--r--src/Text/Pandoc/Readers/Org/DocumentTree.hs260
-rw-r--r--src/Text/Pandoc/Readers/Org/ParserState.hs11
-rw-r--r--src/Text/Pandoc/Readers/Org/Parsing.hs2
-rw-r--r--src/Text/Pandoc/Readers/Txt2Tags.hs3
-rw-r--r--test/command/3510-export.latex1
-rw-r--r--test/command/3510-src.hs1
-rw-r--r--test/command/3510-subdoc.org5
-rw-r--r--test/command/3510.md20
12 files changed, 385 insertions, 235 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index a713e9372..61ef5c522 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -138,6 +138,9 @@ Extra-Source-Files:
test/command/abbrevs
test/command/sub-file-chapter-1.tex
test/command/sub-file-chapter-2.tex
+ test/command/3510-subdoc.org
+ test/command/3510-export.latex
+ test/command/3510-src.hs
test/docbook-reader.docbook
test/docbook-xref.docbook
test/html-reader.html
@@ -442,6 +445,7 @@ Library
Text.Pandoc.Readers.Odt.Arrows.Utils,
Text.Pandoc.Readers.Org.BlockStarts,
Text.Pandoc.Readers.Org.Blocks,
+ Text.Pandoc.Readers.Org.DocumentTree,
Text.Pandoc.Readers.Org.ExportSettings,
Text.Pandoc.Readers.Org.Inlines,
Text.Pandoc.Readers.Org.Meta,
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index e90f64c5b..ce2523d12 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -36,6 +36,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
A utility library with parsers used in pandoc readers.
-}
module Text.Pandoc.Parsing ( anyLine,
+ anyLineNewline,
many1Till,
notFollowedBy',
oneOfStrings,
@@ -83,6 +84,7 @@ module Text.Pandoc.Parsing ( anyLine,
HasMacros (..),
HasLogMessages (..),
HasLastStrPosition (..),
+ HasIncludeFiles (..),
defaultParserState,
HeaderType (..),
ParserContext (..),
@@ -120,6 +122,7 @@ module Text.Pandoc.Parsing ( anyLine,
(<+?>),
extractIdClass,
insertIncludedFile,
+ insertIncludedFileF,
-- * Re-exports from Text.Pandoc.Parsec
Stream,
runParser,
@@ -253,6 +256,10 @@ anyLine = do
return this
_ -> mzero
+-- | Parse any line, include the final newline in the output
+anyLineNewline :: Stream [Char] m Char => ParserT [Char] st m [Char]
+anyLineNewline = (++ "\n") <$> anyLine
+
-- | Like @manyTill@, but reads at least one item.
many1Till :: Stream s m t
=> ParserT s st m a
@@ -1008,6 +1015,9 @@ class HasReaderOptions st where
-- default
getOption f = (f . extractReaderOptions) <$> getState
+instance HasReaderOptions ParserState where
+ extractReaderOptions = stateOptions
+
class HasQuoteContext st m where
getQuoteContext :: (Stream s m t) => ParsecT s st m QuoteContext
withQuoteContext :: QuoteContext -> ParsecT s st m a -> ParsecT s st m a
@@ -1023,9 +1033,6 @@ instance Monad m => HasQuoteContext ParserState m where
setState newState { stateQuoteContext = oldQuoteContext }
return result
-instance HasReaderOptions ParserState where
- extractReaderOptions = stateOptions
-
class HasHeaderMap st where
extractHeaderMap :: st -> M.Map Inlines String
updateHeaderMap :: (M.Map Inlines String -> M.Map Inlines String) ->
@@ -1067,6 +1074,16 @@ instance HasLogMessages ParserState where
addLogMessage msg st = st{ stateLogMessages = msg : stateLogMessages st }
getLogMessages st = reverse $ stateLogMessages st
+class HasIncludeFiles st where
+ getIncludeFiles :: st -> [String]
+ addIncludeFile :: String -> st -> st
+ dropLatestIncludeFile :: st -> st
+
+instance HasIncludeFiles ParserState where
+ getIncludeFiles = stateContainers
+ addIncludeFile f s = s{ stateContainers = f : stateContainers s }
+ dropLatestIncludeFile s = s { stateContainers = drop 1 $ stateContainers s }
+
defaultParserState :: ParserState
defaultParserState =
ParserState { stateOptions = def,
@@ -1358,17 +1375,18 @@ extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
Nothing -> cls
kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
-insertIncludedFile :: PandocMonad m
- => ParserT String ParserState m Blocks
- -> [FilePath] -> FilePath
- -> ParserT String ParserState m Blocks
-insertIncludedFile blocks dirs f = do
+insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st,
+ Functor mf, Applicative mf, Monad mf)
+ => ParserT String st m (mf Blocks)
+ -> [FilePath] -> FilePath
+ -> ParserT String st m (mf Blocks)
+insertIncludedFile' blocks dirs f = do
oldPos <- getPosition
oldInput <- getInput
- containers <- stateContainers <$> getState
+ containers <- getIncludeFiles <$> getState
when (f `elem` containers) $
throwError $ PandocParseError $ "Include file loop at " ++ show oldPos
- updateState $ \s -> s{ stateContainers = f : stateContainers s }
+ updateState $ addIncludeFile f
mbcontents <- readFileFromDirs dirs f
contents <- case mbcontents of
Just s -> return s
@@ -1380,5 +1398,22 @@ insertIncludedFile blocks dirs f = do
bs <- blocks
setInput oldInput
setPosition oldPos
- updateState $ \s -> s{ stateContainers = tail $ stateContainers s }
+ updateState dropLatestIncludeFile
return bs
+
+-- | Parse content of include file as blocks. Circular includes result in an
+-- @PandocParseError@.
+insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
+ => ParserT String st m Blocks
+ -> [FilePath] -> FilePath
+ -> ParserT String st m Blocks
+insertIncludedFile blocks dirs f =
+ runIdentity <$> insertIncludedFile' (Identity <$> blocks) dirs f
+
+-- | Parse content of include file as future blocks. Circular includes result in
+-- an @PandocParseError@.
+insertIncludedFileF :: (PandocMonad m, HasIncludeFiles st)
+ => ParserT String st m (Future st Blocks)
+ -> [FilePath] -> FilePath
+ -> ParserT String st m (Future st Blocks)
+insertIncludedFileF = insertIncludedFile'
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 0c0d07140..7434ef1f6 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -614,7 +614,7 @@ hrule = try $ do
--
indentedLine :: PandocMonad m => MarkdownParser m String
-indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")
+indentedLine = indentSpaces >> anyLineNewline
blockDelimiter :: PandocMonad m
=> (Char -> Bool)
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 788ec26dc..f5823c7aa 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
{-
Copyright (C) 2014-2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -18,7 +15,9 @@ You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
{- |
Module : Text.Pandoc.Readers.Org.Options
Copyright : Copyright (C) 2014-2017 Albert Krewinkel
@@ -34,6 +33,7 @@ module Text.Pandoc.Readers.Org.Blocks
) where
import Text.Pandoc.Readers.Org.BlockStarts
+import Text.Pandoc.Readers.Org.DocumentTree (headline, headlineToBlocks)
import Text.Pandoc.Readers.Org.Inlines
import Text.Pandoc.Readers.Org.Meta (metaExport, metaKey, metaLine)
import Text.Pandoc.Readers.Org.ParserState
@@ -56,196 +56,6 @@ import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid ((<>))
--
--- Org headers
---
-newtype Tag = Tag { fromTag :: String }
- deriving (Show, Eq)
-
--- | Create a tag containing the given string.
-toTag :: String -> Tag
-toTag = Tag
-
--- | The key (also called name or type) of a property.
-newtype PropertyKey = PropertyKey { fromKey :: String }
- deriving (Show, Eq, Ord)
-
--- | Create a property key containing the given string. Org mode keys are
--- case insensitive and are hence converted to lower case.
-toPropertyKey :: String -> PropertyKey
-toPropertyKey = PropertyKey . map toLower
-
--- | The value assigned to a property.
-newtype PropertyValue = PropertyValue { fromValue :: String }
-
--- | Create a property value containing the given string.
-toPropertyValue :: String -> PropertyValue
-toPropertyValue = PropertyValue
-
--- | Check whether the property value is non-nil (i.e. truish).
-isNonNil :: PropertyValue -> Bool
-isNonNil p = map toLower (fromValue p) `notElem` ["()", "{}", "nil"]
-
--- | Key/value pairs from a PROPERTIES drawer
-type Properties = [(PropertyKey, PropertyValue)]
-
--- | Org mode headline (i.e. a document subtree).
-data Headline = Headline
- { headlineLevel :: Int
- , headlineTodoMarker :: Maybe TodoMarker
- , headlineText :: Inlines
- , headlineTags :: [Tag]
- , headlineProperties :: Properties
- , headlineContents :: Blocks
- , headlineChildren :: [Headline]
- }
-
---
--- Parsing headlines and subtrees
---
-
--- | Read an Org mode headline and its contents (i.e. a document subtree).
--- @lvl@ gives the minimum acceptable level of the tree.
-headline :: PandocMonad m => Int -> OrgParser m (F Headline)
-headline lvl = try $ do
- level <- headerStart
- guard (lvl <= level)
- todoKw <- optionMaybe todoKeyword
- title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle
- tags <- option [] headerTags
- newline
- properties <- option mempty propertiesDrawer
- contents <- blocks
- children <- many (headline (level + 1))
- return $ do
- title' <- title
- contents' <- contents
- children' <- sequence children
- return $ Headline
- { headlineLevel = level
- , headlineTodoMarker = todoKw
- , headlineText = title'
- , headlineTags = tags
- , headlineProperties = properties
- , headlineContents = contents'
- , headlineChildren = children'
- }
- where
- endOfTitle :: Monad m => OrgParser m ()
- endOfTitle = void . lookAhead $ optional headerTags *> newline
-
- headerTags :: Monad m => OrgParser m [Tag]
- headerTags = try $
- let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
- in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)
-
--- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
-headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
-headlineToBlocks hdln@(Headline {..}) = do
- maxHeadlineLevels <- getExportSetting exportHeadlineLevels
- case () of
- _ | any isNoExportTag headlineTags -> return mempty
- _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln
- _ | isCommentTitle headlineText -> return mempty
- _ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln
- _ | otherwise -> headlineToHeaderWithContents hdln
-
-isNoExportTag :: Tag -> Bool
-isNoExportTag = (== toTag "noexport")
-
-isArchiveTag :: Tag -> Bool
-isArchiveTag = (== toTag "ARCHIVE")
-
--- | Check if the title starts with COMMENT.
--- FIXME: This accesses builder internals not intended for use in situations
--- like these. Replace once keyword parsing is supported.
-isCommentTitle :: Inlines -> Bool
-isCommentTitle (B.toList -> (Str "COMMENT":_)) = True
-isCommentTitle _ = False
-
-archivedHeadlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
-archivedHeadlineToBlocks hdln = do
- archivedTreesOption <- getExportSetting exportArchivedTrees
- case archivedTreesOption of
- ArchivedTreesNoExport -> return mempty
- ArchivedTreesExport -> headlineToHeaderWithContents hdln
- ArchivedTreesHeadlineOnly -> headlineToHeader hdln
-
-headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
-headlineToHeaderWithList hdln@(Headline {..}) = do
- maxHeadlineLevels <- getExportSetting exportHeadlineLevels
- header <- headlineToHeader hdln
- listElements <- sequence (map headlineToBlocks headlineChildren)
- let listBlock = if null listElements
- then mempty
- else B.orderedList listElements
- let headerText = if maxHeadlineLevels == headlineLevel
- then header
- else flattenHeader header
- return $ headerText <> headlineContents <> listBlock
- where
- flattenHeader :: Blocks -> Blocks
- flattenHeader blks =
- case B.toList blks of
- (Header _ _ inlns:_) -> B.para (B.fromList inlns)
- _ -> mempty
-
-headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
-headlineToHeaderWithContents hdln@(Headline {..}) = do
- header <- headlineToHeader hdln
- childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
- return $ header <> headlineContents <> childrenBlocks
-
-headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
-headlineToHeader (Headline {..}) = do
- exportTodoKeyword <- getExportSetting exportWithTodoKeywords
- let todoText = if exportTodoKeyword
- then case headlineTodoMarker of
- Just kw -> todoKeywordToInlines kw <> B.space
- Nothing -> mempty
- else mempty
- let text = tagTitle (todoText <> headlineText) headlineTags
- let propAttr = propertiesToAttr headlineProperties
- attr <- registerHeader propAttr headlineText
- return $ B.headerWith attr headlineLevel text
-
-todoKeyword :: Monad m => OrgParser m TodoMarker
-todoKeyword = try $ do
- taskStates <- activeTodoMarkers <$> getState
- let kwParser tdm = try $ (tdm <$ string (todoMarkerName tdm) <* spaceChar)
- choice (map kwParser taskStates)
-
-todoKeywordToInlines :: TodoMarker -> Inlines
-todoKeywordToInlines tdm =
- let todoText = todoMarkerName tdm
- todoState = map toLower . show $ todoMarkerState tdm
- classes = [todoState, todoText]
- in B.spanWith (mempty, classes, mempty) (B.str todoText)
-
-propertiesToAttr :: Properties -> Attr
-propertiesToAttr properties =
- let
- toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
- customIdKey = toPropertyKey "custom_id"
- classKey = toPropertyKey "class"
- unnumberedKey = toPropertyKey "unnumbered"
- specialProperties = [customIdKey, classKey, unnumberedKey]
- id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
- cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties
- kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst)
- $ properties
- isUnnumbered =
- fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties
- in
- (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
-
-tagTitle :: Inlines -> [Tag] -> Inlines
-tagTitle title tags = title <> (mconcat $ map tagToInline tags)
-
-tagToInline :: Tag -> Inlines
-tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
-
-
---
-- parsing blocks
--
@@ -253,9 +63,9 @@ tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
blockList :: PandocMonad m => OrgParser m [Block]
blockList = do
initialBlocks <- blocks
- headlines <- sequence <$> manyTill (headline 1) eof
+ headlines <- sequence <$> manyTill (headline blocks inline 1) eof
st <- getState
- headlineBlocks <- fmap mconcat . sequence . map headlineToBlocks $ runF headlines st
+ headlineBlocks <- fmap mconcat . mapM headlineToBlocks $ runF headlines st
return . B.toList $ (runF initialBlocks st) <> headlineBlocks
-- | Get the meta information saved in the state.
@@ -274,6 +84,7 @@ block = choice [ mempty <$ blanklines
, figure
, example
, genericDrawer
+ , include
, specialLine
, horizontalRule
, list
@@ -631,25 +442,6 @@ drawerEnd :: Monad m => OrgParser m String
drawerEnd = try $
skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
--- | Read a :PROPERTIES: drawer and return the key/value pairs contained
--- within.
-propertiesDrawer :: Monad m => OrgParser m Properties
-propertiesDrawer = try $ do
- drawerType <- drawerStart
- guard $ map toUpper drawerType == "PROPERTIES"
- manyTill property (try drawerEnd)
- where
- property :: Monad m => OrgParser m (PropertyKey, PropertyValue)
- property = try $ (,) <$> key <*> value
-
- key :: Monad m => OrgParser m PropertyKey
- key = fmap toPropertyKey . try $
- skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
-
- value :: Monad m => OrgParser m PropertyValue
- value = fmap toPropertyValue . try $
- skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline)
-
--
-- Figures
@@ -717,6 +509,34 @@ exampleCode = B.codeBlockWith ("", ["example"], [])
specialLine :: PandocMonad m => OrgParser m (F Blocks)
specialLine = fmap return . try $ rawExportLine <|> metaLine <|> commentLine
+-- | Include the content of a file.
+include :: PandocMonad m => OrgParser m (F Blocks)
+include = try $ do
+ metaLineStart <* stringAnyCase "include:" <* skipSpaces
+ filename <- includeTarget
+ blockType <- optionMaybe $ skipSpaces *> many1 alphaNum
+ blocksParser <- case blockType of
+ Just "example" -> do
+ return $ pure . B.codeBlock <$> parseRaw
+ Just "export" -> do
+ format <- skipSpaces *> many (noneOf "\n\r\t ")
+ return $ pure . B.rawBlock format <$> parseRaw
+ Just "src" -> do
+ language <- skipSpaces *> many (noneOf "\n\r\t ")
+ let attr = (mempty, [language], mempty)
+ return $ pure . B.codeBlockWith attr <$> parseRaw
+ _ -> return $ pure . B.fromList <$> blockList
+ anyLine
+ insertIncludedFileF blocksParser ["."] filename
+ where
+ includeTarget :: PandocMonad m => OrgParser m FilePath
+ includeTarget = do
+ char '"'
+ manyTill (noneOf "\n\r\t") (char '"')
+
+ parseRaw :: PandocMonad m => OrgParser m String
+ parseRaw = many anyChar
+
rawExportLine :: PandocMonad m => OrgParser m Blocks
rawExportLine = try $ do
metaLineStart
@@ -1017,7 +837,3 @@ listContinuation markerLength = try $
then count num (char ' ')
else choice [ try (count num (char ' '))
, try (char '\t' >> count (num - tabStop) (char ' ')) ]
-
--- | Parse any line, include the final newline in the output.
-anyLineNewline :: Monad m => OrgParser m String
-anyLineNewline = (++ "\n") <$> anyLine
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
new file mode 100644
index 000000000..53ec2ef57
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -0,0 +1,260 @@
+{-
+Copyright (C) 2014-2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+{- |
+ Module : Text.Pandoc.Readers.Org.DocumentTree
+ Copyright : Copyright (C) 2014-2017 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Parsers for org-mode headlines and document subtrees
+-}
+module Text.Pandoc.Readers.Org.DocumentTree
+ ( headline
+ , headlineToBlocks
+ ) where
+
+import Control.Monad (guard, void)
+import Data.Char (toLower, toUpper)
+import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
+import Text.Pandoc.Builder (Blocks, Inlines)
+import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Definition
+import Text.Pandoc.Readers.Org.BlockStarts
+import Text.Pandoc.Readers.Org.Parsing
+import Text.Pandoc.Readers.Org.ParserState
+
+import qualified Text.Pandoc.Builder as B
+
+--
+-- Org headers
+--
+newtype Tag = Tag { fromTag :: String }
+ deriving (Show, Eq)
+
+-- | Create a tag containing the given string.
+toTag :: String -> Tag
+toTag = Tag
+
+-- | The key (also called name or type) of a property.
+newtype PropertyKey = PropertyKey { fromKey :: String }
+ deriving (Show, Eq, Ord)
+
+-- | Create a property key containing the given string. Org mode keys are
+-- case insensitive and are hence converted to lower case.
+toPropertyKey :: String -> PropertyKey
+toPropertyKey = PropertyKey . map toLower
+
+-- | The value assigned to a property.
+newtype PropertyValue = PropertyValue { fromValue :: String }
+
+-- | Create a property value containing the given string.
+toPropertyValue :: String -> PropertyValue
+toPropertyValue = PropertyValue
+
+-- | Check whether the property value is non-nil (i.e. truish).
+isNonNil :: PropertyValue -> Bool
+isNonNil p = map toLower (fromValue p) `notElem` ["()", "{}", "nil"]
+
+-- | Key/value pairs from a PROPERTIES drawer
+type Properties = [(PropertyKey, PropertyValue)]
+
+-- | Org mode headline (i.e. a document subtree).
+data Headline = Headline
+ { headlineLevel :: Int
+ , headlineTodoMarker :: Maybe TodoMarker
+ , headlineText :: Inlines
+ , headlineTags :: [Tag]
+ , headlineProperties :: Properties
+ , headlineContents :: Blocks
+ , headlineChildren :: [Headline]
+ }
+
+-- | Read an Org mode headline and its contents (i.e. a document subtree).
+-- @lvl@ gives the minimum acceptable level of the tree.
+headline :: PandocMonad m
+ => OrgParser m (F Blocks)
+ -> OrgParser m (F Inlines)
+ -> Int
+ -> OrgParser m (F Headline)
+headline blocks inline lvl = try $ do
+ level <- headerStart
+ guard (lvl <= level)
+ todoKw <- optionMaybe todoKeyword
+ title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle
+ tags <- option [] headerTags
+ newline
+ properties <- option mempty propertiesDrawer
+ contents <- blocks
+ children <- many (headline blocks inline (level + 1))
+ return $ do
+ title' <- title
+ contents' <- contents
+ children' <- sequence children
+ return $ Headline
+ { headlineLevel = level
+ , headlineTodoMarker = todoKw
+ , headlineText = title'
+ , headlineTags = tags
+ , headlineProperties = properties
+ , headlineContents = contents'
+ , headlineChildren = children'
+ }
+ where
+ endOfTitle :: Monad m => OrgParser m ()
+ endOfTitle = void . lookAhead $ optional headerTags *> newline
+
+ headerTags :: Monad m => OrgParser m [Tag]
+ headerTags = try $
+ let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
+ in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)
+
+-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
+headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
+headlineToBlocks hdln@(Headline {..}) = do
+ maxHeadlineLevels <- getExportSetting exportHeadlineLevels
+ case () of
+ _ | any isNoExportTag headlineTags -> return mempty
+ _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln
+ _ | isCommentTitle headlineText -> return mempty
+ _ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln
+ _ | otherwise -> headlineToHeaderWithContents hdln
+
+isNoExportTag :: Tag -> Bool
+isNoExportTag = (== toTag "noexport")
+
+isArchiveTag :: Tag -> Bool
+isArchiveTag = (== toTag "ARCHIVE")
+
+-- | Check if the title starts with COMMENT.
+-- FIXME: This accesses builder internals not intended for use in situations
+-- like these. Replace once keyword parsing is supported.
+isCommentTitle :: Inlines -> Bool
+isCommentTitle (B.toList -> (Str "COMMENT":_)) = True
+isCommentTitle _ = False
+
+archivedHeadlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
+archivedHeadlineToBlocks hdln = do
+ archivedTreesOption <- getExportSetting exportArchivedTrees
+ case archivedTreesOption of
+ ArchivedTreesNoExport -> return mempty
+ ArchivedTreesExport -> headlineToHeaderWithContents hdln
+ ArchivedTreesHeadlineOnly -> headlineToHeader hdln
+
+headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
+headlineToHeaderWithList hdln@(Headline {..}) = do
+ maxHeadlineLevels <- getExportSetting exportHeadlineLevels
+ header <- headlineToHeader hdln
+ listElements <- mapM headlineToBlocks headlineChildren
+ let listBlock = if null listElements
+ then mempty
+ else B.orderedList listElements
+ let headerText = if maxHeadlineLevels == headlineLevel
+ then header
+ else flattenHeader header
+ return $ headerText <> headlineContents <> listBlock
+ where
+ flattenHeader :: Blocks -> Blocks
+ flattenHeader blks =
+ case B.toList blks of
+ (Header _ _ inlns:_) -> B.para (B.fromList inlns)
+ _ -> mempty
+
+headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
+headlineToHeaderWithContents hdln@(Headline {..}) = do
+ header <- headlineToHeader hdln
+ childrenBlocks <- mconcat <$> mapM headlineToBlocks headlineChildren
+ return $ header <> headlineContents <> childrenBlocks
+
+headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
+headlineToHeader (Headline {..}) = do
+ exportTodoKeyword <- getExportSetting exportWithTodoKeywords
+ let todoText = if exportTodoKeyword
+ then case headlineTodoMarker of
+ Just kw -> todoKeywordToInlines kw <> B.space
+ Nothing -> mempty
+ else mempty
+ let text = tagTitle (todoText <> headlineText) headlineTags
+ let propAttr = propertiesToAttr headlineProperties
+ attr <- registerHeader propAttr headlineText
+ return $ B.headerWith attr headlineLevel text
+
+todoKeyword :: Monad m => OrgParser m TodoMarker
+todoKeyword = try $ do
+ taskStates <- activeTodoMarkers <$> getState
+ let kwParser tdm = try $ (tdm <$ string (todoMarkerName tdm) <* spaceChar)
+ choice (map kwParser taskStates)
+
+todoKeywordToInlines :: TodoMarker -> Inlines
+todoKeywordToInlines tdm =
+ let todoText = todoMarkerName tdm
+ todoState = map toLower . show $ todoMarkerState tdm
+ classes = [todoState, todoText]
+ in B.spanWith (mempty, classes, mempty) (B.str todoText)
+
+propertiesToAttr :: Properties -> Attr
+propertiesToAttr properties =
+ let
+ toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
+ customIdKey = toPropertyKey "custom_id"
+ classKey = toPropertyKey "class"
+ unnumberedKey = toPropertyKey "unnumbered"
+ specialProperties = [customIdKey, classKey, unnumberedKey]
+ id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
+ cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties
+ kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst)
+ $ properties
+ isUnnumbered =
+ fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties
+ in
+ (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
+
+tagTitle :: Inlines -> [Tag] -> Inlines
+tagTitle title tags = title <> (mconcat $ map tagToInline tags)
+
+-- | Convert
+tagToInline :: Tag -> Inlines
+tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
+
+-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
+-- within.
+propertiesDrawer :: Monad m => OrgParser m Properties
+propertiesDrawer = try $ do
+ drawerType <- drawerStart
+ guard $ map toUpper drawerType == "PROPERTIES"
+ manyTill property (try endOfDrawer)
+ where
+ property :: Monad m => OrgParser m (PropertyKey, PropertyValue)
+ property = try $ (,) <$> key <*> value
+
+ key :: Monad m => OrgParser m PropertyKey
+ key = fmap toPropertyKey . try $
+ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
+
+ value :: Monad m => OrgParser m PropertyValue
+ value = fmap toPropertyValue . try $
+ skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline)
+
+ endOfDrawer :: Monad m => OrgParser m String
+ endOfDrawer = try $
+ skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
+
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index f530d1d03..51666fc64 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -66,7 +66,8 @@ import Text.Pandoc.Logging
import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..),
HasLogMessages (..),
HasLastStrPosition (..), HasQuoteContext (..),
- HasReaderOptions (..), ParserContext (..),
+ HasReaderOptions (..), HasIncludeFiles (..),
+ ParserContext (..),
QuoteContext (..), SourcePos, Future,
askF, asksF, returnF, runF, trimInlinesF)
@@ -106,6 +107,7 @@ data OrgParserState = OrgParserState
, orgStateExportSettings :: ExportSettings
, orgStateHeaderMap :: M.Map Inlines String
, orgStateIdentifiers :: Set.Set String
+ , orgStateIncludeFiles :: [String]
, orgStateLastForbiddenCharPos :: Maybe SourcePos
, orgStateLastPreCharPos :: Maybe SourcePos
, orgStateLastStrPos :: Maybe SourcePos
@@ -148,6 +150,12 @@ instance HasLogMessages OrgParserState where
addLogMessage msg st = st{ orgLogMessages = msg : orgLogMessages st }
getLogMessages st = reverse $ orgLogMessages st
+instance HasIncludeFiles OrgParserState where
+ getIncludeFiles = orgStateIncludeFiles
+ addIncludeFile f st = st { orgStateIncludeFiles = f : orgStateIncludeFiles st }
+ dropLatestIncludeFile st =
+ st { orgStateIncludeFiles = drop 1 $ orgStateIncludeFiles st }
+
instance Default OrgParserState where
def = defaultOrgParserState
@@ -159,6 +167,7 @@ defaultOrgParserState = OrgParserState
, orgStateExportSettings = def
, orgStateHeaderMap = M.empty
, orgStateIdentifiers = Set.empty
+ , orgStateIncludeFiles = []
, orgStateLastForbiddenCharPos = Nothing
, orgStateLastPreCharPos = Nothing
, orgStateLastStrPos = Nothing
diff --git a/src/Text/Pandoc/Readers/Org/Parsing.hs b/src/Text/Pandoc/Readers/Org/Parsing.hs
index 50f5ebae5..5c93a7eca 100644
--- a/src/Text/Pandoc/Readers/Org/Parsing.hs
+++ b/src/Text/Pandoc/Readers/Org/Parsing.hs
@@ -31,6 +31,7 @@ functions are adapted to Org-mode specific functionality.
module Text.Pandoc.Readers.Org.Parsing
( OrgParser
, anyLine
+ , anyLineNewline
, blanklines
, newline
, parseFromString
@@ -71,6 +72,7 @@ module Text.Pandoc.Readers.Org.Parsing
, ellipses
, citeKey
, gridTableWith
+ , insertIncludedFileF
-- * Re-exports from Text.Pandoc.Parsec
, runParser
, runParserT
diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs
index 012ab7cb1..aa7774b4c 100644
--- a/src/Text/Pandoc/Readers/Txt2Tags.hs
+++ b/src/Text/Pandoc/Readers/Txt2Tags.hs
@@ -277,9 +277,6 @@ listContinuation markerLength = try $
<*> many blankline)
where listLine = try $ indentWith markerLength *> anyLineNewline
-anyLineNewline :: T2T String
-anyLineNewline = (++ "\n") <$> anyLine
-
indentWith :: Int -> T2T String
indentWith n = count n spaceChar
diff --git a/test/command/3510-export.latex b/test/command/3510-export.latex
new file mode 100644
index 000000000..6d8636322
--- /dev/null
+++ b/test/command/3510-export.latex
@@ -0,0 +1 @@
+\emph{Hello} \ No newline at end of file
diff --git a/test/command/3510-src.hs b/test/command/3510-src.hs
new file mode 100644
index 000000000..ad5744b80
--- /dev/null
+++ b/test/command/3510-src.hs
@@ -0,0 +1 @@
+putStrLn outString
diff --git a/test/command/3510-subdoc.org b/test/command/3510-subdoc.org
new file mode 100644
index 000000000..5bcc6678a
--- /dev/null
+++ b/test/command/3510-subdoc.org
@@ -0,0 +1,5 @@
+* Subsection
+
+Included text
+
+Lorem ipsum.
diff --git a/test/command/3510.md b/test/command/3510.md
new file mode 100644
index 000000000..7993db848
--- /dev/null
+++ b/test/command/3510.md
@@ -0,0 +1,20 @@
+See <http://orgmode.org/manual/Include-files.html>
+```
+% pandoc -f org -t native
+Text
+
+#+include: "command/3510-subdoc.org"
+
+#+INCLUDE: "command/3510-src.hs" src haskell
+#+INCLUDE: "command/3510-export.latex" export latex
+
+More text
+^D
+[Para [Str "Text"]
+,Header 1 ("subsection",[],[]) [Str "Subsection"]
+,Para [Str "Included",Space,Str "text"]
+,Plain [Str "Lorem",Space,Str "ipsum."]
+,CodeBlock ("",["haskell"],[]) "putStrLn outString\n"
+,RawBlock (Format "latex") "\\emph{Hello}"
+,Para [Str "More",Space,Str "text"]]
+```