simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-12 19:08:34 +03:00
Code Issues Projects Releases Wiki Activity

hakyll-std/TableOfContents: markupHeader(s) remain purely in Pandoc data-structures

Browse Source
This commit is contained in:
Everett Hildenbrandt 2018-04-27 10:56:57 -06:00 committed by Simon Michael
parent 91fab7dd48
commit 760f520fef
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
site/hakyll-std/TableOfContents.hs
View File

@ -58,23 +58,23 @@ markupLink (headerId, _, headerProperties) headerText
= let linkText = fromMaybe headerText (fmap (toList . text) $ lookup "toc" headerProperties) = let linkText = fromMaybe headerText (fmap (toList . text) $ lookup "toc" headerProperties)
in Link nullAttr linkText (("#" ++ headerId), headerId) in Link nullAttr linkText (("#" ++ headerId), headerId)
markupHeader :: Tree Block -> H.Html markupHeader :: Tree Block -> [Block]
markupHeader n@(Node (Header _ hAttr hText) headers) markupHeader n@(Node (Header _ hAttr hText) headers)
| headers == [] = H.li $ link | headers == [] = [link]
| otherwise = H.li $ link <> markupHeaders headers | otherwise = [link, markupHeaders headers]
where link = fromRight mempty . runPure . writeHtml5 def $ Pandoc nullMeta [Plain [markupLink hAttr hText]] where link = Plain [markupLink hAttr hText]
markupHeader n = error $ "'markupHeader' should only be passed a 'Node $ Header'\n" markupHeader n = error $ "'markupHeader' should only be passed a 'Node $ Header'\n"
++ " saw: " ++ show n ++ " saw: " ++ show n
markupHeaders :: Forest Block -> H.Html markupHeaders :: Forest Block -> Block
markupHeaders = H.ol . mconcat . map markupHeader markupHeaders = OrderedList (1, Decimal, Period) . map markupHeader
createTable :: TOCAlignment -> Forest Block -> Block createTable :: TOCAlignment -> Forest Block -> Block
createTable _ [] = Null createTable _ [] = Null
createTable alignment headers createTable alignment headers
= render $ (H.nav ! (A.id "toc" <> alignmentAttr)) $ do = render $ (H.nav ! (A.id "toc" <> alignmentAttr)) $ do
H.p "Contents" H.p "Contents"
markupHeaders headers fromRight mempty . runPure . writeHtml5 def $ Pandoc nullMeta [markupHeaders headers]
where render = (RawBlock "html") . renderHtml where render = (RawBlock "html") . renderHtml
alignmentAttr = case alignment of alignmentAttr = case alignment of
TOCRight -> A.class_ "right-toc" TOCRight -> A.class_ "right-toc"