ClojureNSManager.clj

(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)

gistfile1.txt

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 %))
                                           " **`...`**"))))))
----