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