Org reader internals: disable some GHC extensions
The RecordWildCards and ViewPatterns language extensions can be used to shorten code, but usually also makes it harder to read. The DocumentTree module was hence refactored and no longer relies on these extensions.
This commit is contained in:
parent
a734ed6532
commit
aac3d752e1
1 changed files with 32 additions and 26 deletions
|
@ -1,4 +1,3 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
|
||||||
{-
|
{-
|
||||||
Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
||||||
|
|
||||||
|
@ -17,8 +16,7 @@ along with this program; if not, write to the Free Software
|
||||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
|
||||||
{- |
|
{- |
|
||||||
Module : Text.Pandoc.Readers.Org.DocumentTree
|
Module : Text.Pandoc.Readers.Org.DocumentTree
|
||||||
Copyright : Copyright (C) 2014-2018 Albert Krewinkel
|
Copyright : Copyright (C) 2014-2018 Albert Krewinkel
|
||||||
|
@ -167,13 +165,16 @@ headline blocks inline lvl = try $ do
|
||||||
|
|
||||||
-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
|
-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
|
||||||
headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
|
headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
|
||||||
headlineToBlocks hdln@Headline {..} = do
|
headlineToBlocks hdln = do
|
||||||
maxHeadlineLevels <- getExportSetting exportHeadlineLevels
|
maxLevel <- getExportSetting exportHeadlineLevels
|
||||||
|
let tags = headlineTags hdln
|
||||||
|
let text = headlineText hdln
|
||||||
|
let level = headlineLevel hdln
|
||||||
case () of
|
case () of
|
||||||
_ | any isNoExportTag headlineTags -> return mempty
|
_ | any isNoExportTag tags -> return mempty
|
||||||
_ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln
|
_ | any isArchiveTag tags -> archivedHeadlineToBlocks hdln
|
||||||
_ | isCommentTitle headlineText -> return mempty
|
_ | isCommentTitle text -> return mempty
|
||||||
_ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln
|
_ | maxLevel <= level -> headlineToHeaderWithList hdln
|
||||||
_ | otherwise -> headlineToHeaderWithContents hdln
|
_ | otherwise -> headlineToHeaderWithContents hdln
|
||||||
|
|
||||||
isNoExportTag :: Tag -> Bool
|
isNoExportTag :: Tag -> Bool
|
||||||
|
@ -186,8 +187,9 @@ isArchiveTag = (== toTag "ARCHIVE")
|
||||||
-- FIXME: This accesses builder internals not intended for use in situations
|
-- FIXME: This accesses builder internals not intended for use in situations
|
||||||
-- like these. Replace once keyword parsing is supported.
|
-- like these. Replace once keyword parsing is supported.
|
||||||
isCommentTitle :: Inlines -> Bool
|
isCommentTitle :: Inlines -> Bool
|
||||||
isCommentTitle (B.toList -> (Str "COMMENT":_)) = True
|
isCommentTitle inlns = case B.toList inlns of
|
||||||
isCommentTitle _ = False
|
(Str "COMMENT":_) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
archivedHeadlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
|
archivedHeadlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
|
||||||
archivedHeadlineToBlocks hdln = do
|
archivedHeadlineToBlocks hdln = do
|
||||||
|
@ -198,17 +200,21 @@ archivedHeadlineToBlocks hdln = do
|
||||||
ArchivedTreesHeadlineOnly -> headlineToHeader hdln
|
ArchivedTreesHeadlineOnly -> headlineToHeader hdln
|
||||||
|
|
||||||
headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
|
headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
|
||||||
headlineToHeaderWithList hdln@Headline {..} = do
|
headlineToHeaderWithList hdln = do
|
||||||
maxHeadlineLevels <- getExportSetting exportHeadlineLevels
|
maxHeadlineLevels <- getExportSetting exportHeadlineLevels
|
||||||
header <- headlineToHeader hdln
|
header <- headlineToHeader hdln
|
||||||
listElements <- mapM headlineToBlocks headlineChildren
|
listElements <- mapM headlineToBlocks (headlineChildren hdln)
|
||||||
let listBlock = if null listElements
|
let listBlock = if null listElements
|
||||||
then mempty
|
then mempty
|
||||||
else B.orderedList listElements
|
else B.orderedList listElements
|
||||||
let headerText = if maxHeadlineLevels == headlineLevel
|
let headerText = if maxHeadlineLevels == headlineLevel hdln
|
||||||
then header
|
then header
|
||||||
else flattenHeader header
|
else flattenHeader header
|
||||||
return $ headerText <> headlineContents <> listBlock
|
return . mconcat $
|
||||||
|
[ headerText
|
||||||
|
, headlineContents hdln
|
||||||
|
, listBlock
|
||||||
|
]
|
||||||
where
|
where
|
||||||
flattenHeader :: Blocks -> Blocks
|
flattenHeader :: Blocks -> Blocks
|
||||||
flattenHeader blks =
|
flattenHeader blks =
|
||||||
|
@ -217,27 +223,27 @@ headlineToHeaderWithList hdln@Headline {..} = do
|
||||||
_ -> mempty
|
_ -> mempty
|
||||||
|
|
||||||
headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
|
headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
|
||||||
headlineToHeaderWithContents hdln@Headline {..} = do
|
headlineToHeaderWithContents hdln = do
|
||||||
header <- headlineToHeader hdln
|
header <- headlineToHeader hdln
|
||||||
childrenBlocks <- mconcat <$> mapM headlineToBlocks headlineChildren
|
childrenBlocks <- mconcat <$> mapM headlineToBlocks (headlineChildren hdln)
|
||||||
return $ header <> headlineContents <> childrenBlocks
|
return $ header <> headlineContents hdln <> childrenBlocks
|
||||||
|
|
||||||
headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
|
headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
|
||||||
headlineToHeader Headline {..} = do
|
headlineToHeader hdln = do
|
||||||
exportTodoKeyword <- getExportSetting exportWithTodoKeywords
|
exportTodoKeyword <- getExportSetting exportWithTodoKeywords
|
||||||
exportTags <- getExportSetting exportWithTags
|
exportTags <- getExportSetting exportWithTags
|
||||||
let todoText = if exportTodoKeyword
|
let todoText = if exportTodoKeyword
|
||||||
then case headlineTodoMarker of
|
then case headlineTodoMarker hdln of
|
||||||
Just kw -> todoKeywordToInlines kw <> B.space
|
Just kw -> todoKeywordToInlines kw <> B.space
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
else mempty
|
else mempty
|
||||||
let text = todoText <> headlineText <>
|
let text = todoText <> headlineText hdln <>
|
||||||
if exportTags
|
if exportTags
|
||||||
then tagsToInlines headlineTags
|
then tagsToInlines (headlineTags hdln)
|
||||||
else mempty
|
else mempty
|
||||||
let propAttr = propertiesToAttr headlineProperties
|
let propAttr = propertiesToAttr (headlineProperties hdln)
|
||||||
attr <- registerHeader propAttr headlineText
|
attr <- registerHeader propAttr (headlineText hdln)
|
||||||
return $ B.headerWith attr headlineLevel text
|
return $ B.headerWith attr (headlineLevel hdln) text
|
||||||
|
|
||||||
todoKeyword :: Monad m => OrgParser m TodoMarker
|
todoKeyword :: Monad m => OrgParser m TodoMarker
|
||||||
todoKeyword = try $ do
|
todoKeyword = try $ do
|
||||||
|
|
Loading…
Add table
Reference in a new issue