mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 03:42:25 +03:00
tools/pandoc-*.hs, doc/.gitignore: remove haskell pandoc filters and references to them
This commit is contained in:
parent
39b20ffb3f
commit
563d78df66
10
doc/.gitignore
vendored
10
doc/.gitignore
vendored
@ -1,10 +0,0 @@
|
|||||||
../tools/pandoc-add-toc
|
|
||||||
../tools/pandoc-capitalize-headers
|
|
||||||
../tools/pandoc-demote-headers
|
|
||||||
../tools/pandoc-drop-html-blocks
|
|
||||||
../tools/pandoc-drop-html-inlines
|
|
||||||
../tools/pandoc-drop-links
|
|
||||||
../tools/pandoc-drop-man-blocks
|
|
||||||
../tools/pandoc-drop-notes
|
|
||||||
../tools/pandoc-drop-toc
|
|
||||||
../tools/pandoc-drop-web-blocks
|
|
@ -1,124 +0,0 @@
|
|||||||
#!/usr/bin/env stack
|
|
||||||
{- stack runghc --verbosity info
|
|
||||||
--package pandoc
|
|
||||||
-}
|
|
||||||
-- Replace a table of contents marker
|
|
||||||
-- (a bullet list item containing "toc[-N[-M]]")
|
|
||||||
-- with a table of contents based on headings.
|
|
||||||
-- toc means full contents, toc-N means contents to depth N
|
|
||||||
-- and toc-N-M means contents from depth N to depth M.
|
|
||||||
-- Based on code from https://github.com/blaenk/blaenk.github.io
|
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
|
|
||||||
import Data.Char (isDigit)
|
|
||||||
import Data.List (groupBy)
|
|
||||||
import Data.List.Split
|
|
||||||
import Data.Tree (Forest, Tree(Node))
|
|
||||||
#if !(MIN_VERSION_base(4,11,0))
|
|
||||||
import Data.Monoid ((<>), mconcat)
|
|
||||||
#endif
|
|
||||||
import Data.Function (on)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Safe
|
|
||||||
import Text.Blaze.Html (preEscapedToHtml, (!))
|
|
||||||
import Text.Blaze.Html.Renderer.String (renderHtml)
|
|
||||||
import qualified Text.Blaze.Html5 as H
|
|
||||||
import qualified Text.Blaze.Html5.Attributes as A
|
|
||||||
import Text.Pandoc
|
|
||||||
import Text.Pandoc.JSON
|
|
||||||
import Text.Pandoc.Walk (walk, query)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = toJSONFilter tableOfContents
|
|
||||||
|
|
||||||
tableOfContents :: Pandoc -> Pandoc
|
|
||||||
tableOfContents doc =
|
|
||||||
let headers = query collectHeaders doc
|
|
||||||
in walk (generateTOC headers) doc
|
|
||||||
|
|
||||||
collectHeaders :: Block -> [Block]
|
|
||||||
collectHeaders header@(Header _ (_, classes, _) _)
|
|
||||||
| "notoc" `elem` classes = []
|
|
||||||
| otherwise = [header]
|
|
||||||
collectHeaders _ = []
|
|
||||||
|
|
||||||
generateTOC :: [Block] -> Block -> Block
|
|
||||||
generateTOC [] x = x
|
|
||||||
generateTOC headers x@(BulletList (( (( Plain ((Str txt):_)):_)):_)) =
|
|
||||||
case tocParams txt of
|
|
||||||
Just (mstartlevel, mendlevel) ->
|
|
||||||
render .
|
|
||||||
forestDrop mstartlevel .
|
|
||||||
forestPrune mendlevel .
|
|
||||||
groupByHierarchy $
|
|
||||||
headers -- (! A.class_ "right-toc") .
|
|
||||||
where
|
|
||||||
render = (RawBlock "html") . renderHtml . createTable
|
|
||||||
Nothing -> x
|
|
||||||
generateTOC _ x = x
|
|
||||||
|
|
||||||
tocParams :: String -> Maybe (Maybe Int, Maybe Int)
|
|
||||||
tocParams s =
|
|
||||||
case splitOn "-" s of
|
|
||||||
["toc"] -> Just (Nothing, Nothing)
|
|
||||||
["toc",a] | all isDigit a -> Just (Nothing, readMay a)
|
|
||||||
["toc",a,b] | all isDigit a, all isDigit b -> Just (readMay a, readMay b)
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
forestDrop :: Maybe Int -> Forest a -> Forest a
|
|
||||||
forestDrop Nothing f = f
|
|
||||||
forestDrop (Just n) ts = concatMap (treeDrop n) ts
|
|
||||||
|
|
||||||
treeDrop :: Int -> Tree a -> Forest a
|
|
||||||
treeDrop n t | n < 1 = [t]
|
|
||||||
treeDrop n (Node _ ts) = concatMap (treeDrop (n-1)) ts
|
|
||||||
|
|
||||||
forestPrune :: Maybe Int -> Forest a -> Forest a
|
|
||||||
forestPrune Nothing f = f
|
|
||||||
forestPrune (Just n) ts = map (treePrune n) ts
|
|
||||||
|
|
||||||
treePrune :: Int -> Tree a -> Tree a
|
|
||||||
treePrune n t | n < 1 = t
|
|
||||||
treePrune n (Node v ts) = Node v $ map (treePrune (n-1)) ts
|
|
||||||
|
|
||||||
-- | remove all nodes past a certain depth
|
|
||||||
-- treeprune :: Int -> Tree a -> Tree a
|
|
||||||
-- treeprune 0 t = Node (root t) []
|
|
||||||
-- treeprune d t = Node (root t) (map (treeprune $ d-1) $ branches t)
|
|
||||||
|
|
||||||
groupByHierarchy :: [Block] -> Forest Block
|
|
||||||
groupByHierarchy = map (\(x:xs) -> Node x (groupByHierarchy xs)) . groupBy ((<) `on` headerLevel)
|
|
||||||
|
|
||||||
headerLevel :: Block -> Int
|
|
||||||
headerLevel (Header level _ _) = level
|
|
||||||
headerLevel _ = error "not a header"
|
|
||||||
|
|
||||||
createTable :: Forest Block -> H.Html
|
|
||||||
createTable headers =
|
|
||||||
(H.nav ! A.id "toc") $ do
|
|
||||||
H.p "Contents"
|
|
||||||
H.ol $ markupHeaders headers
|
|
||||||
|
|
||||||
markupHeader :: Tree Block -> H.Html
|
|
||||||
markupHeader (Node (Header _ (ident, _, keyvals) inline) headers)
|
|
||||||
| headers == [] = H.li $ link
|
|
||||||
| otherwise = H.li $ link <> (H.ol $ markupHeaders headers)
|
|
||||||
where render x = writeHtmlString def (Pandoc nullMeta [(Plain x)])
|
|
||||||
section = fromMaybe (render inline) (lookup "toc" keyvals)
|
|
||||||
link = H.a ! A.href (H.toValue $ "#" ++ ident) $ preEscapedToHtml section
|
|
||||||
markupHeader _ = error "what"
|
|
||||||
|
|
||||||
markupHeaders :: Forest Block -> H.Html
|
|
||||||
markupHeaders = mconcat . map markupHeader
|
|
||||||
|
|
||||||
-- ignoreTOC :: Block -> Block
|
|
||||||
-- ignoreTOC (Header level (ident, classes, params) inline) =
|
|
||||||
-- Header level (ident, "notoc" : classes, params) inline
|
|
||||||
-- ignoreTOC x = x
|
|
||||||
|
|
||||||
-- removeTOCMarker :: Block -> Block
|
|
||||||
-- removeTOCMarker (BulletList (( (( Plain ((Str "toc"):_)):_)):_)) = Null
|
|
||||||
-- removeTOCMarker x = x
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
|||||||
#!/usr/bin/env stack
|
|
||||||
{- stack runghc --verbosity info --package pandoc-types -}
|
|
||||||
-- Ensure level 1 and 2 headings are first-letter-capitalised.
|
|
||||||
|
|
||||||
import Data.Char
|
|
||||||
import Text.Pandoc.JSON
|
|
||||||
import Text.Pandoc.Walk
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = toJSONFilter capitalizeHeaders
|
|
||||||
|
|
||||||
capitalizeHeaders :: Block -> Block
|
|
||||||
capitalizeHeaders (Header lvl attr xs) | lvl < 3 = Header lvl attr $ map capitalize (take 1 xs) ++ drop 1 xs
|
|
||||||
capitalizeHeaders x = x
|
|
||||||
|
|
||||||
capitalize :: Inline -> Inline
|
|
||||||
capitalize (Str s) = Str $ map toUpper (take 1 s) ++ map toLower (drop 1 s)
|
|
||||||
capitalize x = x
|
|
||||||
|
|
||||||
{-
|
|
||||||
capitalizeHeaderLinks :: Inline -> Inline
|
|
||||||
capitalizeHeaderLinks (Link xs t@('#':_,_)) = Link (walk capitalize xs) t
|
|
||||||
capitalizeHeaderLinks x = x
|
|
||||||
-}
|
|
@ -1,12 +0,0 @@
|
|||||||
#!/usr/bin/env stack
|
|
||||||
{- stack runghc --verbosity info --package pandoc-types -}
|
|
||||||
|
|
||||||
import Text.Pandoc.Builder
|
|
||||||
import Text.Pandoc.JSON
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = toJSONFilter dropManBlocks
|
|
||||||
|
|
||||||
dropManBlocks :: Block -> Block
|
|
||||||
dropManBlocks (Div ("",["man"],[]) _) = Plain []
|
|
||||||
dropManBlocks x = x
|
|
@ -1,12 +0,0 @@
|
|||||||
#!/usr/bin/env stack
|
|
||||||
{- stack runghc --verbosity info --package pandoc-types -}
|
|
||||||
|
|
||||||
import Text.Pandoc.Builder
|
|
||||||
import Text.Pandoc.JSON
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = toJSONFilter dropWebBlocks
|
|
||||||
|
|
||||||
dropWebBlocks :: Block -> Block
|
|
||||||
dropWebBlocks (Div ("",["web"],[]) _) = Plain []
|
|
||||||
dropWebBlocks x = x
|
|
Loading…
Reference in New Issue
Block a user