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