slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tools/pandoc-site: remove unused datastructure TOCAlignment and function ignoreTOC

Browse Source
This commit is contained in:
Everett Hildenbrandt 2018-05-19 18:32:21 -06:00 committed by Simon Michael
parent 946fa1d498
commit 78e10f7663
1 changed files with 8 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
tools/pandoc-site.hs
View File

@ -15,17 +15,10 @@ import Data.Function (on)
import Data.Maybe (fromMaybe)
import Data.Text (unpack)
data TOCAlignment = TOCOff | TOCLeft | TOCRight
headerLevel :: Block -> Int
headerLevel (Header level _ _) = level
headerLevel _ = error "not a header"
ignoreTOC :: Block -> Block
ignoreTOC (Header level (ident, classes, params) inlines) =
Header level (ident, "notoc" : classes, params) inlines
ignoreTOC x = x
collectHeaders :: Block -> [Block]
collectHeaders header@(Header _ (_, classes, _) _) =
if "notoc" `elem` classes
@ -52,13 +45,10 @@ markupHeader n = error $ "'markupHeader' should only be passed a 'Node $ Head
markupHeaders :: Forest Block -> Block
markupHeaders = OrderedList (1, Decimal, Period) . map markupHeader
createTable :: TOCAlignment -> Forest Block -> Block
createTable _ [] = Null
createTable alignment headers
= let alignAttr = case alignment of
TOCRight -> " class=\"right-toc\""
_ -> ""
navBegin = "<nav id=\"toc\"" ++ alignAttr ++ ">"
createTable :: Forest Block -> Block
createTable [] = Null
createTable headers
= let navBegin = "<nav id=\"toc\" class=\"right-toc\">"
navEnd = "</nav>"
tocDoc = Pandoc nullMeta [Para [Str "Contents"], markupHeaders headers]
tocString = unpack . fromRight mempty . runPure . writeHtml5String def $ tocDoc
@ -68,12 +58,11 @@ generateTOC :: Block -> Block -> Block
generateTOC toc (Para [Str "$toc$"]) = toc
generateTOC _ x = x
tableOfContents :: TOCAlignment -> Pandoc -> Pandoc
tableOfContents TOCOff ast = walk ignoreTOC ast
tableOfContents alignment ast
tableOfContents :: Pandoc -> Pandoc
tableOfContents ast
= let headers = query collectHeaders ast
toc = createTable alignment . groupByHierarchy $ headers
toc = createTable . groupByHierarchy $ headers
in walk (generateTOC toc) ast
main :: IO ()
main = toJSONFilter (tableOfContents TOCRight)
main = toJSONFilter tableOfContents