Graphing dependencies of Toccata source file

deps-grph.toc

#! /home/jim/toccata --script

(deftype GraphState [proj-root module-root node-count curr-node file-nodes])

(deftype ImportsGraph [graph root])

(defprotocol DepsGraph
  (imported [_]
    ;; by default, does nothing                                                                                                                                                                                                                
    (state-maybe/state-maybe "")))

(defn get-graphs [s strings]
  (let [[strn file-state] (.carrier s)]
    (or (flat-map (first s) (fn [strn]
                              (get-graphs (rest s) (conj strings strn))))
        (maybe [strings (.graph-state file-state)]))))

(defn graph-deps [file-path file-name checkout]
  (comp (state-maybe/get-in-val [.file-nodes file-path])
        (for [node-index (state-maybe/get-val .node-count)
              _ (state-maybe/set-val .node-count (inc node-index))
              :let [curr-node (str "node_" node-index)]
              _ (state-maybe/assoc-in-val [.file-nodes file-path] (ImportsGraph [] curr-node))
              _ (state-maybe/set-val .curr-node curr-node)
              curr-state (state-maybe/update-state identity)
              [strings new-state] (state-maybe/when
                                      (or (map (file/file-in file-path)
                                               (fn [file]
                                                 (-> (strm/stream file)
                                                     (parse/parse-stream reader/top-level {'file-name file-path
                                                                                           'line-number 0})
                                                     (reduce [empty-list curr-state]
                                                             (fn [[strings state] ast]
                                                               (either ((for [new-strings (imported ast)]
                                                                          (comp strings new-strings)) state)
                                                                       [strings state]))))))
                                          (do
                                            (print-err "Could not open" (str "'" file-path "'") "to graph.")
                                            [empty-list curr-state])))
              _ (state-maybe/update-state (fn [_] new-state))]
          (ImportsGraph (comp [curr-node " [label = \""
                               file-name (either (map checkout (fn [sha]
                                                                 (str "\\n" sha)))
                                                 "")
                               "\"];\n"]
                              strings)
                        curr-node))))

(extend-type ast/add-ns-ast
  DepsGraph
  (imported [ast]
    (imported (.mod ast))))

(extend-type ast/module-ast
  DepsGraph
  (imported [ast]
    (let [file-name (.file-path ast)]
      (for [curr-node (state-maybe/get-val .curr-node)
            curr-module-root (state-maybe/get-val .module-root)
            :let [file-path (str curr-module-root "/" file-name)]
            dep-graph (graph-deps file-path file-name nothing)
            _ (state-maybe/set-val .curr-node curr-node)
            _ (state-maybe/set-val .module-root curr-module-root)]
        (comp (.graph dep-graph) [curr-node " -> " (.root dep-graph) " [style = dashed];\n"])))))

(extend-type ast/git-dep-ast
  DepsGraph
  (imported [ast]
    (let [file-name (.file ast)
          opts (.args ast)
          checkout (either (or (get opts 'tag)
                               (get opts 'sha)
                               (get opts 'branch))
                           "master")]
      (for [curr-node (state-maybe/get-val .curr-node)
            curr-module-root (state-maybe/get-val .module-root)
            proj-root (state-maybe/get-val .proj-root)
            :let [dep-path (str proj-root "dependencies/git/" (.repo ast) "/" checkout)
                  file-path (str dep-path "/" file-name)]
            _ (state-maybe/set-val .module-root dep-path)
            dep-graph (graph-deps file-path file-name (maybe checkout))
            _ (state-maybe/set-val .curr-node curr-node)
            _ (state-maybe/set-val .module-root curr-module-root)]
        (comp (.graph dep-graph) [curr-node " -> " (.root dep-graph) ";\n"])))))

(main [args]
  (or (for [file-name (second args)
            proj-root (sys/file-directory file-name)
            [result] ((graph-deps file-name file-name nothing) (GraphState proj-root proj-root 1 "node_0" {}))]
        (file/stdout (comp ["digraph grammar {\n"]
                           (.graph result)
                           ["}\n"])))
      (print-err "A Toccata source file must be specified")))