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