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:
Albert Krewinkel 2018-09-06 20:53:57 +02:00
parent a734ed6532
commit aac3d752e1

View file

@ -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