Allow configuring specific headers in theme

README.md

@@ -502,6 +502,22 @@ and `onRgb#101060` for a deep purple background).  Naturally, your terminal
 needs to support 24-bit RGB for this to work.  When creating portable
 presentations, it might be better to stick with the named colours listed above.
 
+#### Theming headers
+
+In addition to `header`, individual headers can also be customized.  The
+configuration blocks under `headers` accepts a `style` list, a `prefix` string
+and an `underline` string that is repeated match the width of the header.
+
+```yaml
+patat:
+  theme:
+    headers:
+      h3:
+        style: [vividRed]
+        prefix: '### '
+        underline: '-~-~'
+```
+
 ### Syntax Highlighting
 
 `patat` uses [Kate] Syntax Highlighting files.  `patat` ships with support for

lib/Patat/Presentation/Display.hs

@@ -10,11 +10,12 @@ module Patat.Presentation.Display
 
 
 --------------------------------------------------------------------------------
-import           Control.Monad                        (guard)
+import           Control.Monad                        (guard, mplus)
 import qualified Data.Aeson.Extended                  as A
 import           Data.Char.WCWidth.Extended           (wcstrwidth)
 import           Data.Data.Extended                   (grecQ)
 import qualified Data.List                            as L
+import qualified Data.Map                             as M
 import           Data.Maybe                           (fromMaybe, maybeToList)
 import qualified Data.Sequence.Extended               as Seq
 import qualified Data.Text                            as T
@@ -23,7 +24,7 @@ import           Patat.Presentation.Display.CodeBlock
 import           Patat.Presentation.Display.Internal
 import           Patat.Presentation.Display.Table
 import           Patat.Presentation.Internal
-import           Patat.PrettyPrint                    ((<$$>), (<+>))
+import           Patat.PrettyPrint                    ((<$$>))
 import qualified Patat.PrettyPrint                    as PP
 import           Patat.Size
 import           Patat.Theme                          (Theme (..))
@@ -206,9 +207,21 @@ prettyBlock ds (Pandoc.Plain inlines) = prettyInlines ds inlines
 prettyBlock ds (Pandoc.Para inlines) =
     prettyInlines ds inlines <> PP.hardline
 
-prettyBlock ds (Pandoc.Header i _ inlines) =
-    themed ds themeHeader (PP.string (replicate i '#') <+> prettyInlines ds inlines) <>
-    PP.hardline
+prettyBlock ds (Pandoc.Header n _ inlines) =
+    themed ds style content <> PP.hardline <>
+    (case underline of
+        Nothing -> mempty
+        Just t  ->
+            themed ds style (PP.string $ take cols $ cycle $ T.unpack t) <>
+            PP.hardline)
+  where
+    prefix    = fromMaybe mempty $ config (dsTheme ds) >>= Theme.htPrefix
+    content   = PP.text prefix <> prettyInlines ds inlines
+    (_, cols) = PP.dimensions content
+    underline = config (dsTheme ds) >>= Theme.htUnderline
+
+    style  t = (config t >>= Theme.htStyle) `mplus` themeHeader t
+    config t = themeHeaders t >>= M.lookup ("h" ++ show n)
 
 prettyBlock ds (Pandoc.CodeBlock (_, classes, _) txt) =
     prettyCodeBlock ds classes txt

lib/Patat/Theme.hs

@@ -3,7 +3,8 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE TemplateHaskell            #-}
 module Patat.Theme
-    ( Theme (..)
+    ( HeaderTheme (..)
+    , Theme (..)
     , defaultTheme
 
     , Style (..)
@@ -31,10 +32,19 @@ import qualified System.Console.ANSI    as Ansi
 import           Text.Read              (readMaybe)
 
 
+--------------------------------------------------------------------------------
+data HeaderTheme = HeaderTheme
+    { htStyle     :: !(Maybe Style)
+    , htPrefix    :: !(Maybe T.Text)
+    , htUnderline :: !(Maybe T.Text)
+    } deriving (Show)
+
+
 --------------------------------------------------------------------------------
 data Theme = Theme
     { themeBorders            :: !(Maybe Style)
     , themeHeader             :: !(Maybe Style)
+    , themeHeaders            :: !(Maybe (M.Map String HeaderTheme))
     , themeCodeBlock          :: !(Maybe Style)
     , themeBulletList         :: !(Maybe Style)
     , themeBulletListMarkers  :: !(Maybe T.Text)
@@ -65,6 +75,7 @@ instance Semigroup Theme where
     l <> r = Theme
         { themeBorders            = mplusOn   themeBorders
         , themeHeader             = mplusOn   themeHeader
+        , themeHeaders            = mappendOn themeHeaders
         , themeCodeBlock          = mplusOn   themeCodeBlock
         , themeBulletList         = mplusOn   themeBulletList
         , themeBulletListMarkers  = mplusOn   themeBulletListMarkers
@@ -99,13 +110,17 @@ instance Monoid Theme where
     mempty  = Theme
         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-        Nothing Nothing Nothing Nothing Nothing Nothing
+        Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 --------------------------------------------------------------------------------
 defaultTheme :: Theme
 defaultTheme = Theme
     { themeBorders            = dull Ansi.Yellow
     , themeHeader             = dull Ansi.Blue
+    , themeHeaders            = Just $ M.fromList $ do
+        n <- [1 .. 6]
+        let prefix = T.replicate n "#" <> " "
+        pure ("h" <> show n, HeaderTheme Nothing (Just prefix) Nothing)
     , themeCodeBlock          = dull Ansi.White `mappend` ondull Ansi.Black
     , themeBulletList         = dull Ansi.Magenta
     , themeBulletListMarkers  = Just "-*"
@@ -322,4 +337,5 @@ syntaxHighlight theme tokenType = do
 
 
 --------------------------------------------------------------------------------
+$(A.deriveJSON A.dropPrefixOptions ''HeaderTheme)
 $(A.deriveJSON A.dropPrefixOptions ''Theme)

tests/golden/inputs/theme-headers.md

@@ -0,0 +1,23 @@
+---
+patat:
+  theme:
+    headers:
+      h1:
+        underline: "=~"
+      h3:
+        style: [vividRed]
+        prefix: '== '
+        underline: '^ '
+...
+
+# Header 1
+
+## Header 2
+
+### Header 3
+
+Some Content
+
+### A long Header 3
+
+More Content

tests/golden/outputs/theme-headers.md.dump

@@ -0,0 +1,48 @@
+                            theme-headers.md                            
+
+
+
+
+
+
+
+
+                                Header 1
+                                =~=~=~=~
+
+                                                                  1 / 4 
+
+{slide}
+                      theme-headers.md > Header 1                       
+
+
+
+
+
+
+
+
+
+                               ## Header 2
+
+                                                                  2 / 4 
+
+{slide}
+                 theme-headers.md > Header 1 > Header 2                 
+
+== Header 3
+^ ^ ^ ^ ^ ^
+
+Some Content
+
+                                                                  3 / 4 
+
+{slide}
+                 theme-headers.md > Header 1 > Header 2                 
+
+== A long Header 3
+^ ^ ^ ^ ^ ^ ^ ^ ^ 
+
+More Content
+
+                                                                  4 / 4