Skip to content

Instantly share code, notes, and snippets.

@JJ-Atkinson JJ-Atkinson/ClojureNSManager.clj Secret
Last active Apr 24, 2019

Embed
What would you like to do?
(ns cs101-clojureworkspace.cardboard.clojure-src-dir-manager.core
(:require [clojure.java.io :as io]
[datoteka.core :as fs]
[sc.api :as scc]
[clojure.string :as str]
[clojure.edn :as edn]))
;; need to spec everything up.
(def dir (fs/path "/media/jarrett/Windows/code-projects/electron-apps/reframe-transform/src"))
(def extensions #{"clj" "cljs" "cljc"})
(defn walk-dir [dir]
(loop [to-visit [dir]
completed []]
(cond (empty? to-visit) completed
(fs/directory? (first to-visit)) ; cant explain it, sometimes has a nil
(recur (concat (rest to-visit) (filter identity (fs/list-dir (first to-visit))))
(conj completed (first to-visit)))
:else
(recur (rest to-visit) (conj completed (first to-visit))))))
(def files (filter #(some (partial = (fs/ext %)) extensions) (walk-dir dir)))
; rules: can see all and only top level forms. Can read its own output.
; currently it is cheating, using the fact that "\((def|ns) ..." is the shape
; of nearly every top level form. With the manual code marking it can do, should
; be fine.
; format for our nice comments
; | ;; LTCodeBlockStart {:name ...}
; | ;; LTCodeBlockEnd
;; these functions need to be extensible. Right now the blockify fn works ok with these as inputs.
(defn is-block-start? [line]
(let [res (or (when (str/starts-with? line "(def") :def)
(when (str/starts-with? line "(ns") :ns)
(when (re-matches #"\([\w-\/*^]*reg.*" line) :reg)
(when (str/starts-with? line ";; LTCodeBlockStart") :lt-code-block-comment)
)]
(if res res false)))
(defn try-extract-meta [first-line type]
(let [name (case type
:def (second (first (re-seq #"def[\w-\.]*[ ,]+([^ ,\(\)]+)" first-line)))
:ns (second (first (re-seq #"ns[\w-\.]*[ ,]+([^ ,\(\)]+)" first-line)))
:reg (second (first (re-seq #"reg[\w-\.]*[ ,]+([^ ,\(\)]+)" first-line)))
nil)]
(if (= :lt-code-block-comment type)
(let [first (str/index-of first-line "{")
meta-str (apply str (drop (dec first) first-line))]
(edn/read-string meta-str))
(when name {:name name}))))
(defn comment-block-end? [line]
(when (re-matches #";;[ ]+LTCodeBlockEnd[ ]*" line) true))
(defn vswap! "Renames a volatile fn to work on local vars" [x f] (var-set x (f @x)))
;; has two ending modes, if not in a comment code block, tries to end when it finds a new one.
;; if it is in a code block, it ignores new blocks until it hits a ;; lt-cblock-end comment
(defn blockify-file [file]
(with-open [in (io/reader file)]
(let [lines (line-seq in)]
(with-local-vars
[remaining-lines lines
code-blocks []
block-start nil
guessed-block-end nil
type-of-block nil
block-meta nil
line-num 0]
(while (not-empty @remaining-lines)
(let [line (first @remaining-lines)
end-of-file? (empty? (rest @remaining-lines))
close-code-block
(fn []
(when-let [last-blk-start @block-start] ;; had a block prev
(vswap! code-blocks #(conj % {:start last-blk-start
:end @guessed-block-end
:meta @block-meta
:code-block/parsed-type @type-of-block
:file file})))
(var-set type-of-block nil)
(var-set block-start nil)) ;; erase prev vals
begin-new-block
(fn [type extracted-meta]
(var-set block-start @line-num) ;; reset block start and give meta
(var-set type-of-block type)
(var-set block-meta extracted-meta))]
;; line inc, dump curr line off seq, if eof, jump g-blk-end to line num
(vswap! remaining-lines rest)
(vswap! line-num inc)
(when end-of-file? ;; don't set guessed block
;; end to line when blank here. must wait for the code to check that
;; this isn't a new code block currently.
(var-set guessed-block-end @line-num))
(when (not= :lt-code-block-comment @type-of-block) ;; not in comment block
(when-let [type (is-block-start? line)] ;; new block start
(close-code-block)
(begin-new-block type (try-extract-meta line type))))
(when (not (str/blank? line)) ;; not line blank set as guessed block end
(var-set guessed-block-end @line-num))
(when (or end-of-file? ;; eof or end of code block comment
(and (= :lt-code-block-comment @type-of-block)
(comment-block-end? line)))
(close-code-block))))
@code-blocks
))))
(defn get-code-block-contents [block]
(let [commented-code-block? (= :lt-code-block-comment (:code-block/parsed-type block))
{:keys [start end]} block
raw-block (with-open [in (io/reader (:file block))]
(loop [lines (line-seq in)
line-num 1
ret []]
(let [ret (if (<= start line-num end) (conj ret (first lines)) ret)]
(if (<= line-num end)
(recur (rest lines) (inc line-num) ret)
ret))))]
(if (not commented-code-block?)
{:code (str/join "\n" raw-block)
:renderer (fn [code] code)}
{:code (str/join "\n" (butlast (rest raw-block)))
:renderer (fn [code] (str (first raw-block) "\n" code "\n" (last raw-block)))})))
(defn rewrite-codeblock [block ^String new-code]
(let [old (:file block)
new (fs/path (str (fs/normalize old) ".swp"))]
(with-open [in (io/reader old)
out (io/writer new)]
(loop [line-num 0
lines (line-seq in)]
(let [line-num (inc line-num)
^String line (first lines)
lines (rest lines)]
(when (not (<= (:start block) line-num (:end block)))
(.write out line)
(.newLine out))
(when (= (:start block) line-num)
(.write out new-code)
(.newLine out))
(if (not-empty lines)
(recur line-num lines)
nil))))
(fs/move new old)))
(defn extract-file-info [file]
(let [blocks (try (blockify-file file)
(catch Exception e
(println e)))
namespace (-> (filter #(= :ns (:code-block/parsed-type %)) blocks)
first :meta :name)
namespace-applied (map #(assoc % :code-block/ns namespace
:name (-> % :meta :name)) blocks)]
{:code-block/ns namespace
:blocks namespace-applied}))
(defn print-ns "purely for debugging" [n]
(println (:code-block/ns n))
(doall (map #(println " " (:name %)) (:blocks n))))
(defn print-code-block "purely for debugging" [cb]
(println "----")
(println (:code cb))
(println "----")
;(println "--- Rendered")
;(println ((:renderer cb) (:code cb)))
)
(defn print-fn [nss ns name]
(->> nss
(filter #(= (:code-block/ns %) ns))
first :blocks
(filter #(= (:name %) name))
first
get-code-block-contents
print-code-block
))
;(defn overwrite-code-block)
Sample usage:
(def nss (map extract-file-info files)))
(doall (map print-ns nss))
=> user
user
start
stop
cljs
electro-note.old.config
electro-note.old.config
debug?
electro-note.old.core
electro-note.old.core
electro-note.old.db
electro-note.old.db
default-db
electro-note.events.events
electro-note.events.events
nil
electro-note.old.repl
electro-note.old.repl
electro-note.old.subs
electro-note.old.subs
::name
::press-count
::re-pressed-example
electro-note.old.views
electro-note.old.views
dispatch-keydown-rules
display-re-pressed-example
title
main-panel
noted.core
noted.core
noted.core
noted.core
debug?
electron
ipc
remote
hide-self
open-new-window
kill-self
dispatch-pull-req-from-main
dispatch-updated-notes
root-component
dev-setup
mount-root
init-main-comms
^:export
:hide-window
:update-notes-fn
:close-window
:open-new-window
(print-fn nss "noted.events.common-transitions" "open-new-window")
----
=> (defn open-new-window [cofx collected-fx]
(assoc collected-fx :open-new-window nil))
----
(print-fn nss "noted.events.common-transitions" "hide-window")
----
=> (defn hide-window [cofx collected-fx]
(assoc collected-fx :hide-window nil))
----
(print-fn nss "noted.subs.sub-utils" "close-char-maps")
----
=> (defn close-char-maps [s]
(str s "" (str/replace (closing-chars-of s) "```" "```\n")))
----
(print-fn nss "noted.subs.sub-utils" "render-contents")
----
=> (defn render-contents [note]
(update note :content #(md/md->html
(tmb/spy (str (apply str (->> (take 500 %)
(apply str)
(close-char-maps)))
(when (< 500 (count %))
" **`...`**"))))))
----
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.