Pandoc haskell filter

.gitignore

@@ -2,3 +2,4 @@
 /.cask
 /config.mk
 *autoloads.el
+.stack-work/

README.md

@@ -781,7 +781,7 @@ example](img/rustic-doc.png)
 
 Required:
 
-- [pandoc](https://pandoc.org/installing.html) preferably at least version 2.11, as it will give somewhat nicer generated documentation. Versions older than 2.9 may not work - if you're on a debian based distro installing through your regular repo might not work out.
+- [pandoc](https://pandoc.org/installing.html) Installed automatically.
 - [cargo](https://doc.rust-lang.org/cargo/getting-started/installation.html)
 - [cargo-makedocs](https://github.com/Bunogi/cargo-makedocs)
 - [fd-find](https://github.com/sharkdp/fd) Old versions, especially before 2.x, may not work. Install through Cargo if you're having issues.

rustic-doc.el

@@ -31,16 +31,12 @@
     (require 'xdg)
     (fset 'rustic-doc--xdg-data-home 'xdg-data-home)))
 
-(defvar rustic-doc-lua-filter (concat (file-name-as-directory (getenv "HOME"))
-                                      ".local/bin/rustic-doc-filter.lua")
-  "Save location for the rustic-doc lua filter.")
-
-(defvar rustic-doc-convert-prog (concat (file-name-as-directory (getenv "HOME"))
-                                        ".local/bin/rustic-doc-convert.sh")
-  "Save location for the rustic-doc conversion script.")
-
-(defvar rustic-doc-source-repo
-  "https://raw.githubusercontent.com/brotzeit/rustic/master/rustic-doc/")
+(setq rustic-doc-bin-location (f-join  (file-name-as-directory (getenv "HOME")) ".local/bin/rustic-doc/"))
+(setq rustic-doc-filter (f-join rustic-doc-bin-location "filter"))
+(setq rustic-doc-convert-prog  (f-join rustic-doc-bin-location "convert.sh"))
+(setq rustic-doc-pandoc  (f-join rustic-doc-bin-location "pandoc"))
+(setq rustic-doc-pandoc-tar (f-join rustic-doc-bin-location "pandoc.tar.gz"))
+(setq rustic-doc-source-repo "https://raw.githubusercontent.com/samhedin/rustic/pandoc-haskell-filter/rustic-doc/")
 
 (defvar rustic-doc-current-project nil
   "Location to search for documentation.
@@ -49,13 +45,23 @@ All projects and std by default, otherwise last open project and std.")
 (defvar rustic-doc-save-loc (concat (rustic-doc--xdg-data-home)
                                     "/emacs/rustic-doc"))
 
-(defvar rustic-doc-resources
+;; todo: fix rustic-doc-filter link after merge.
+(setq rustic-doc-resources
   `((,rustic-doc-convert-prog
      (:exec)
      ,(concat rustic-doc-source-repo "convert.sh"))
-    (,rustic-doc-lua-filter
-     ()
-     ,(concat rustic-doc-source-repo "filter.lua"))))
+    (,rustic-doc-filter
+     (:exec)
+     "https://github.com/samhedin/rustic/blob/pandoc-haskell-filter/rustic-doc/pandoc_filter/rustdoc-to-org-exe?raw=true")))
+
+(defun rustic-doc--install-pandoc ()
+  "Install a compatible version of pandoc. Does not modify potential existing system installation of pandoc."
+  (unless (file-exists-p rustic-doc-pandoc)
+    (if   (url-copy-file "https://github.com/jgm/pandoc/releases/download/2.17.0.1/pandoc-2.17.0.1-linux-amd64.tar.gz" rustic-doc-pandoc-tar t)
+        (progn
+          (shell-command (format "tar -xf %s " rustic-doc-pandoc-tar ))
+          (shell-command (format "cp pandoc-2.17.0.1/bin/pandoc %s" rustic-doc-pandoc)))
+      (message "Couldn't install pandoc"))))
 
 (defun rustic-doc-default-rg-search-command ()
   "The default search command when using helm-ag.
@@ -257,15 +263,15 @@ If the user has not visited a project, returns the main doc directory."
       (progn
         (message "Converting documentation for %s "
                  rustic-doc-current-project)
-        (if (/= 0 (call-process "cargo" nil "*cargo-makedocs*" nil "makedocs"))
+        (if (/= 0 (call-process "cargo" nil "*cargo-makedocs*" nil "makedocs")) ;todo: This needs to be run in  rustic-doc-current project folder.
             (message "\
 cargo makedocs could not generate docs for the current package. \
 See buffer *cargo-makedocs* for more info")
           (let* ((docs-src
                   (concat (file-name-as-directory rustic-doc-current-project)
                           "target/doc"))
                  (finish-func (lambda (_p)
-                                (message "Finished converting docs for %s"
+                                (message "Finished converting docs for dependencies of %s. Std conversion might still be running."
                                          rustic-doc-current-project))))
             (rustic-doc-create-project-dir)
             (rustic-doc--start-process "rustic-doc-convert"
@@ -280,18 +286,15 @@ See buffer *cargo-makedocs* for more info")
   (when (not missing-fd)
     (when  (> 8 (string-to-number
                   (substring (shell-command-to-string "fd --version") 3 4)))
-      (message "Your version of fd is too old, please install a recent version, maybe through cargo.")))
-
-  (when (>= 11 (string-to-number
-                (substring (shell-command-to-string "pandoc --version") 9 11)))
-    (message "Your version of pandoc is too old, please install a more recent version. See their github for more info.")))
+      (message "Your version of fd is too old, please install a recent version, maybe through cargo."))))
 
 
 (defun rustic-doc-install-deps (&optional noconfirm)
   "Install dependencies with Cargo.
 If NOCONFIRM is non-nil, install all dependencies without prompting user."
   (if (not (executable-find "cargo"))
       (message "You need to have cargo installed to use rustic-doc")
+  (rustic-doc--install-pandoc)
     (let ((missing-rg (not (executable-find "rg")))
           (missing-fd (and  (not (executable-find "fd") )))
           (missing-makedocs (not (executable-find "cargo-makedocs"))))

rustic-doc/Makefile

@@ -1,41 +1,31 @@
 # Used for development
-standard:
+standard: create_filter
 	cd debug_files ;\
-	pandoc enum.Option.html  --lua-filter ../filter.lua -t native -o filterednative ;\
+	pandoc enum.Option.html -t json | ../pandoc_filter/rustdoc-to-org-exe | pandoc -f json -t native -o filterednative ;\
 	pandoc -f native filterednative -o option.org
 
-standard_unfiltered:
+trait: create_filter
 	cd debug_files ;\
-	pandoc enum.Option.html -t native -o filterednative ;\
-	pandoc -f native filterednative -o option.org
-
-
-primitive:
-	cd debug_files ;\
-	pandoc primitive.i16.html  --lua-filter ../filter.lua -t native -o filterednative ;\
-	pandoc -f native filterednative -o primitive.i16.org
-
-
-primitive_unfiltered:
-	cd debug_files ;\
-	pandoc primitive.i16.html -t native -o filterednative ;\
-	pandoc -f native filterednative -o primitive.i16.org
-
-trait:
-	cd debug_files ;\
-	pandoc trait.AsRef.html --lua-filter ../filter.lua -t native -o filterednative ;\
+	pandoc trait.AsRef.html -t json | ../pandoc_filter/rustdoc-to-org-exe | pandoc -f json -t native -o filterednative ;\
 	pandoc -f native filterednative -o AsRef.org
 
-code:
+code: create_filter
 	cd debug_files ;\
-	pandoc shared.rs.html --lua-filter ../filter.lua -t native -o filterednative ;\
+	pandoc shared.rs.html -t json | ../pandoc_filter/rustdoc-to-org-exe | pandoc -f json -t native -o filterednative ;\
 	pandoc -f native filterednative -o shared.rs.org
 
-constant:
+constant: create_filter
 	cd debug_files ;\
-	pandoc constant.ARCH.html --lua-filter ../filter.lua -t native -o filterednative ;\
+	pandoc constant.ARCH.html -t json | ../pandoc_filter/rustdoc-to-org-exe | pandoc -f json -t native -o filterednative ;\
 	pandoc -f native filterednative -o constant.arch.org
 
-overwrite_filter:
-	rm ~/.local/bin/rustic-doc-filter.lua
-	cp ./filter.lua ~/.local/bin/rustic-doc-filter.lua
+create_filter:
+	cd pandoc_filter; \
+	stack install --local-bin-path .; \
+	cd ..
+
+overwrite_local:
+	cd pandoc_filter; \
+	stack install --local-bin-path ~/.local/bin/rustic-doc-filter; \
+	cd ..
+	cp convert.sh ~/.local/bin/rustic-doc-convert.sh

rustic-doc/README.org

@@ -1,8 +1,8 @@
 #+TITLE: Readme
 The way I develop the filter is:
 1. Select an html-file to focus on, such as [[./debug_files/enum.Option.html]].
-2. Open [[./filter.lua]].
+2. Open the haskell filter in [[./pandoc_filter/app/Main.hs]]
 3. Open [[./debug_files/option.org]].
 4. Open [[./debug_files/filterednative]].
-5. Running `make` will now update =option.org= with the org-representation and =filterednative= with the pandoc representation. If anything looks weird in the org-version, more details can be found in filterednative.
+5. Running `make standard` will now update =option.org= with the org-representation and =filterednative= with the pandoc representation. If anything looks weird in the org-version, more details can be found in filterednative.
    6. See [[./Makefile]] for the alternatives. =make standard= uses the default, whereas =make primitive= uses HTML for the type =i16=, which is formatted differently since it is a primitive.

rustic-doc/convert.sh

@@ -1,6 +1,6 @@
 #!/usr/bin/env bash
 
-LUA_FILTER="$HOME/.local/bin/rustic-doc-filter.lua"
+FILTER="$HOME/.local/bin/rustic-doc/filter"
 function get_toolchain {
     rustup show | sed -nr 's/(.*) \(default\)/\1/p' | head -n 1
 }
@@ -58,5 +58,5 @@ fd . \
     --ignore-file "$ignore_file" \
     -j"$cores" \
     -x pandoc '{}' \
-    --lua-filter "$LUA_FILTER" \
+    --filter "$FILTER" \
     -o "$DEST_DIR/{.}.org"

rustic-doc/pandoc_filter/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for rustdoc-to-org
+
+## Unreleased changes

rustic-doc/pandoc_filter/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

rustic-doc/pandoc_filter/app/Main.hs

@@ -0,0 +1,156 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+module Main where
+import           Text.Pandoc.JSON
+import           Text.Pandoc.Walk
+import qualified Data.Text                     as T
+
+main :: IO ()
+main = toJSONFilter runAll
+
+runAll :: [Block] -> [Block]
+--runAll b = b
+runAll = map (sections . cleanBlock)
+
+emptyAttrs :: (T.Text, [T.Text], [(T.Text, T.Text)])
+emptyAttrs = ("", [], [])
+
+-- cleanBlock removes things like the sidebar, and calls cleanInlines to remove whitespace and more
+cleanBlock :: Block -> Block
+cleanBlock block = case block of
+  (Div (_, classname : _, _) _)
+    | classname
+      == "shortcuts"
+      || classname
+      == "sidebar-elems"
+      || classname
+      == "theme-picker"
+      || classname
+      == "infos"
+      || classname
+      == "search-container"
+      || classname
+      == "sidebar-menu"
+      || classname
+      == "logo-container"
+      || classname
+      == "toggle-wrapper"
+    -> Null
+
+  (Div (_, [_, section], _) blocks) | section == "small-section-header" -> Div emptyAttrs $ map cleanBlock blocks
+
+  (Para [Link _ [] _]) -> Null
+
+  (Plain ((Link (_, [name], _) _ _) : _))
+    | name == "sidebar-title" || name == "test-arrow" -> Null
+
+  (Div (tag, _, _) bs)
+    | tag
+      == "main"
+      || tag
+      == "search"
+      || tag
+      == "imlementation-list"
+      || tag
+      == "synthetic-implementations-list"
+      || tag
+      == "blanket-implementations-list"
+    -> Div emptyAttrs $ map cleanBlock bs
+
+  (Plain [Span _ [Str panics]]) | panics == "Panics" -> Null
+  (Plain inlines) -> Plain $ cleanInlines $ filter
+    (\case
+      (Link (_, [classname], _) _ _)
+        | classname == "srclink" || classname == "collapse" -> False
+
+      _ -> True
+    )
+    inlines
+
+  (Header 1 (panics, _, _) ins) | T.isPrefixOf "panics" panics ->
+    Plain $ cleanInlines ins
+
+  (CodeBlock (_, [linenumbers], _) _) | linenumbers == "line-numbers" -> Null
+  (CodeBlock _ t) -> Para [Str "#+BEGIN_SRC rust \n", Str t, Str "\n#+END_SRC"] -- This lets us use syntax highlighting
+  (Header 1 _ [Str panics]) | panics == "Panics" -> Null
+  (Para ins                ) -> Para $ cleanInlines ins
+  (Header 4 _ [Code _ _]) -> Null
+  (Header _ _    []        ) -> Null
+  (Div _ [Header 4 _ [], Plain [Span _ []]]) -> Null
+  (Header 1 _ [Link _ [Str examples] _]) | examples == "Examples" -> Null
+  (Header a attr ins    )    -> Header a attr (cleanInlines ins)
+
+  (Div attr blocks      )    -> Div attr (map cleanBlock blocks)
+  (BlockQuote blocks    )    -> BlockQuote (map cleanBlock blocks)
+  (BulletList blocklists)    -> BulletList blocklists
+
+  _                          -> block
+
+-- Amongst other things, removes some causes of unwanted linebreaks, for example space leads to linebreaks sometimes so it's replaced with Str " "
+cleanInlines :: [Inline] -> [Inline]
+cleanInlines = foldr
+  (\x acc -> case x of
+    Str src | src == "[src]" -> acc
+    Space              -> Str " " : acc
+    LineBreak          -> Str " " : acc
+    SoftBreak          -> Str " " : acc
+    (Link _ _ (url, _)) | url == "#required-sections" -> acc
+    (Link _ (_ : (Span (_, [inner], _) _) : _) _) | inner == "inner" -> acc
+    (Link _ is _) -> Span emptyAttrs (cleanInlines is) : acc
+    (Span _ []       ) -> acc
+    (Span (_, [classname], _) _)
+      | classname == "since" || classname == "emoji" -> acc
+    (Span attr is ) -> Span attr (cleanInlines is) : acc
+    (Strong    ins) -> Strong (cleanInlines ins) : acc
+    (Emph      ins) -> Emph (cleanInlines ins) : acc
+    (Strikeout ins) -> Strikeout (cleanInlines ins) : acc
+    _               -> x : acc
+  )
+  []
+
+-- This makes [inline] of This is a nightly-only experimental API, so that it doesn't become a header.
+mkNotice :: [Block] -> [Inline]
+mkNotice = foldr
+  (\x acc -> case x of
+    (Plain ins     ) -> ins ++ acc
+    (Para  ins     ) -> ins ++ acc
+    (Div _ bs      ) -> mkNotice bs ++ acc
+    (Header _ _ ins) -> ins ++ acc
+    _                -> acc
+  )
+  []
+
+
+sections :: Block -> Block
+sections b = case b of
+  (Plain [Link _ _ (_, _), Code (_, _, _) code]) ->
+    Header 3 emptyAttrs [Code emptyAttrs code]
+  (Div (_, classnames, _) blocks) | "stability" `elem` classnames ->
+    Plain $ mkNotice blocks
+
+  (Header 3 (_, [classname], _) (code : (Link _ _ (url, _)) : _))
+    | classname == "impl" -> Header 2
+                                    emptyAttrs
+                                    [Link emptyAttrs [code] (url, "")]
+  (Header 1 _ ins) -> Header 1 emptyAttrs $ foldInlines ins
+
+  (Header l _ ins) -> Header (l - 1) emptyAttrs $ foldInlines ins
+
+  (Div (_, [docblock], _) docs) | docblock == "docblock" -> Div emptyAttrs docs
+  _ -> b
+
+ where
+  foldInlines = foldr
+    (\x acc -> case x of
+      (Span _ [Str src]) | src == "[src]" -> acc
+      (Code _ desc) | T.isPrefixOf "#[must" desc ->
+        let descNoMustUse = T.drop 1 (T.dropWhile (/= ']') desc)
+            mustUse =
+                T.takeWhile (/= ']') (T.drop 1 (T.dropWhile (/= '=') desc))
+        in  Code emptyAttrs descNoMustUse : Str " " : if T.length mustUse > 3
+              then Note [Plain [Str mustUse]] : acc
+              else acc
+      (Span attr ins) -> Span attr ins : acc
+      x               -> x : acc
+    )
+    []