From 1fc07ff4dae5b3673ac2090d0a52f69afc1f078e Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 27 Nov 2016 20:31:04 +0100 Subject: Refactor top-level division selection (#3261) The "default" option is no longer represented as `Nothing` but via a new type constructor, making the `Maybe` wrapper superfluous. The default behavior of using heuristics can now be enabled explicitly by setting `--top-level-division=default`. API change (`Text.Pandoc.Options`): The `Division` type was renamed to `TopLevelDivision`. The `Section`, `Chapter`, and `Part` constructors were renamed to `TopLevelSection`, `TopLevelChapter`, and `TopLevelPart`, respectively. An additional `TopLevelDefault` constructor was added, which is now also the new default value of the `writerTopLevelDivision` field in `WriterOptions`. --- src/Text/Pandoc/Options.hs | 16 +++++++++------- src/Text/Pandoc/Writers/ConTeXt.hs | 17 +++++++++-------- src/Text/Pandoc/Writers/Docbook.hs | 14 +++++++------- src/Text/Pandoc/Writers/LaTeX.hs | 21 ++++++++++++--------- src/Text/Pandoc/Writers/TEI.hs | 10 +++++----- 5 files changed, 42 insertions(+), 36 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index b890d1b9a..b02a5181f 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -43,7 +43,7 @@ module Text.Pandoc.Options ( Extension(..) , HTMLSlideVariant (..) , EPUBVersion (..) , WrapOption (..) - , Division (..) + , TopLevelDivision (..) , WriterOptions (..) , TrackChanges (..) , ReferenceLocation (..) @@ -341,10 +341,12 @@ data WrapOption = WrapAuto -- ^ Automatically wrap to width deriving (Show, Read, Eq, Data, Typeable, Generic) -- | Options defining the type of top-level headers. -data Division = Part -- ^ Top-level headers become parts - | Chapter -- ^ Top-level headers become chapters - | Section -- ^ Top-level headers become sections - deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) +data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts + | TopLevelChapter -- ^ Top-level headers become chapters + | TopLevelSection -- ^ Top-level headers become sections + | TopLevelDefault -- ^ Top-level type is determined via + -- heuristics + deriving (Show, Read, Eq, Data, Typeable, Generic) -- | Locations for footnotes and references in markdown output data ReferenceLocation = EndOfBlock -- ^ End of block @@ -382,7 +384,7 @@ data WriterOptions = WriterOptions , writerHtmlQTags :: Bool -- ^ Use @@ tags for quotes in HTML , writerBeamer :: Bool -- ^ Produce beamer LaTeX slide show , writerSlideLevel :: Maybe Int -- ^ Force header level of slides - , writerTopLevelDivision :: Maybe Division -- ^ Type of top-level divisions + , writerTopLevelDivision :: TopLevelDivision -- ^ Type of top-level divisions , writerListings :: Bool -- ^ Use listings package for code , writerHighlight :: Bool -- ^ Highlight source code , writerHighlightStyle :: Style -- ^ Style to use for highlighting @@ -430,7 +432,7 @@ instance Default WriterOptions where , writerHtmlQTags = False , writerBeamer = False , writerSlideLevel = Nothing - , writerTopLevelDivision = Nothing + , writerTopLevelDivision = TopLevelDefault , writerListings = False , writerHighlight = False , writerHighlightStyle = pygments diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 8e6faefe2..70bed4961 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -37,7 +37,7 @@ import Text.Pandoc.Walk (query) import Text.Printf ( printf ) import Data.List ( intercalate, intersperse ) import Data.Char ( ord ) -import Data.Maybe ( catMaybes, fromMaybe ) +import Data.Maybe ( catMaybes ) import Control.Monad.State import Text.Pandoc.Pretty import Text.Pandoc.ImageSize @@ -85,9 +85,9 @@ pandocToConTeXt options (Pandoc meta blocks) = do $ defField "placelist" (intercalate ("," :: String) $ take (writerTOCDepth options + case writerTopLevelDivision options of - Just Part -> 0 - Just Chapter -> 0 - _ -> 1) + TopLevelPart -> 0 + TopLevelChapter -> 0 + _ -> 1) ["chapter","section","subsection","subsubsection", "subsubsubsection","subsubsubsubsection"]) $ defField "body" main @@ -423,10 +423,11 @@ sectionHeader (ident,classes,_) hdrLevel lst = do contents <- inlineListToConTeXt lst st <- get let opts = stOptions st - let level' = case fromMaybe Section (writerTopLevelDivision opts) of - Part -> hdrLevel - 2 - Chapter -> hdrLevel - 1 - Section -> hdrLevel + let level' = case writerTopLevelDivision opts of + TopLevelPart -> hdrLevel - 2 + TopLevelChapter -> hdrLevel - 1 + TopLevelSection -> hdrLevel + TopLevelDefault -> hdrLevel let ident' = toLabel ident let (section, chapter) = if "unnumbered" `elem` classes then (text "subject", text "title") diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 6dc2c3a4b..278bbdcc8 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -39,7 +39,6 @@ import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Readers.TeXMath import Data.List ( stripPrefix, isPrefixOf, intercalate, isSuffixOf ) import Data.Char ( toLower ) -import Data.Maybe ( fromMaybe, isNothing ) import Data.Monoid ( Any(..) ) import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Pretty @@ -82,14 +81,15 @@ writeDocbook opts (Pandoc meta blocks) = else Nothing render' = render colwidth opts' = if ("/book>" `isSuffixOf` (trimr $ writerTemplate opts) && - isNothing (writerTopLevelDivision opts)) - then opts{ writerTopLevelDivision = Just Chapter } + TopLevelDefault == writerTopLevelDivision opts) + then opts{ writerTopLevelDivision = TopLevelChapter } else opts -- The numbering here follows LaTeX's internal numbering - startLvl = case fromMaybe Section (writerTopLevelDivision opts') of - Part -> -1 - Chapter -> 0 - Section -> 1 + startLvl = case writerTopLevelDivision opts' of + TopLevelPart -> -1 + TopLevelChapter -> 0 + TopLevelSection -> 1 + TopLevelDefault -> 1 auths' = map (authorToDocbook opts) $ docAuthors meta meta' = B.setMeta "author" auths' meta Just metadata = metaToJSON opts diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 3657f3464..d9c9e3621 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -89,9 +89,9 @@ writeLaTeX options document = stUrl = False, stGraphics = False, stLHS = False, stBook = (case writerTopLevelDivision options of - Just Part -> True - Just Chapter -> True - _ -> False), + TopLevelPart -> True + TopLevelChapter -> True + _ -> False), stCsquotes = False, stHighlighting = False, stIncremental = writerIncremental options, stInternalLinks = [], stUsesEuro = False } @@ -763,15 +763,18 @@ sectionHeader unnumbered ident level lst = do <> braces (text plain)) book <- gets stBook opts <- gets stOptions - let topLevelDivision = fromMaybe (if book then Chapter else Section) - (writerTopLevelDivision opts) - let level' = if writerBeamer opts && topLevelDivision < Section + let topLevelDivision = if book && writerTopLevelDivision opts == TopLevelDefault + then TopLevelChapter + else writerTopLevelDivision opts + let level' = if writerBeamer opts && + topLevelDivision `elem` [TopLevelPart, TopLevelChapter] -- beamer has parts but no chapters then if level == 1 then -1 else level - 1 else case topLevelDivision of - Part -> level - 2 - Chapter -> level - 1 - Section -> level + TopLevelPart -> level - 2 + TopLevelChapter -> level - 1 + TopLevelSection -> level + TopLevelDefault -> level let sectionType = case level' of -1 -> "part" 0 -> "chapter" diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index 4b3a205a1..27f6898c3 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -36,7 +36,6 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Options import Text.Pandoc.Templates (renderTemplate') import Data.List ( stripPrefix, isPrefixOf ) -import Data.Maybe ( fromMaybe ) import Data.Char ( toLower ) import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Pretty @@ -61,10 +60,11 @@ writeTEI opts (Pandoc meta blocks) = then Just $ writerColumns opts else Nothing render' = render colwidth - startLvl = case fromMaybe Section (writerTopLevelDivision opts) of - Part -> -1 - Chapter -> 0 - Section -> 1 + startLvl = case writerTopLevelDivision opts of + TopLevelPart -> -1 + TopLevelChapter -> 0 + TopLevelSection -> 1 + TopLevelDefault -> 1 auths' = map (authorToTEI opts) $ docAuthors meta meta' = B.setMeta "author" auths' meta Just metadata = metaToJSON opts -- cgit v1.2.3