hakyll-std/TableOfContents: all rendering done with Pandoc instead of Blaze

This commit is contained in:
Everett Hildenbrandt 2018-04-27 11:39:47 -06:00 committed by Simon Michael
parent 760f520fef
commit 9c99dcde39

View File

@ -18,7 +18,6 @@ import Text.Pandoc.Options (def)
import Data.Either (fromRight) import Data.Either (fromRight)
import Data.List (groupBy) import Data.List (groupBy)
import Data.Text (unpack)
import Data.Tree (Forest, Tree(Node)) import Data.Tree (Forest, Tree(Node))
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>), mconcat) import Data.Monoid ((<>), mconcat)
@ -72,13 +71,14 @@ 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 = let alignAttr = case alignment of
H.p "Contents" TOCRight -> " class=\"right-toc\""
fromRight mempty . runPure . writeHtml5 def $ Pandoc nullMeta [markupHeaders headers] _ -> ""
where render = (RawBlock "html") . renderHtml navBegin = "<nav id=\"toc\"" ++ alignAttr ++ ">"
alignmentAttr = case alignment of navEnd = "</nav>"
TOCRight -> A.class_ "right-toc" tocDoc = Pandoc nullMeta [Para [Str "Contents"], markupHeaders headers]
_ -> mempty tocString = unpack . fromRight mempty . runPure . writeHtml5String def $ tocDoc
in RawBlock "html" (navBegin ++ "\n" ++ tocString ++ "\n" ++ navEnd)
generateTOC :: [Block] -> TOCAlignment -> Block -> Block generateTOC :: [Block] -> TOCAlignment -> Block -> Block
generateTOC headers alignment x@(BulletList (( (( Plain ((Str "toc"):_)):_)):_)) generateTOC headers alignment x@(BulletList (( (( Plain ((Str "toc"):_)):_)):_))