(ns clojars.search
  (:refer-clojure :exclude [index])
  (:require [clojars
             [config :refer [config]]
             [stats :as stats]]
            [clojure
             [set :as set]
             [string :as string]]
            [clojure.java.io :as io]
            [clucy.core :as clucy]
            [com.stuartsierra.component :as component]
            [clojars.db :as db]
            [clojure.string :as str])
  (:import [org.apache.lucene.analysis KeywordAnalyzer PerFieldAnalyzerWrapper]
           org.apache.lucene.analysis.standard.StandardAnalyzer
           org.apache.lucene.index.IndexNotFoundException
           org.apache.lucene.queryParser.QueryParser
           [org.apache.lucene.search.function CustomScoreQuery DocValues FieldCacheSource ValueSourceQuery]
           org.apache.lucene.search.IndexSearcher))

(defprotocol Search
  (index! [t pom])
  (search [t query page])
  (delete!
    [t group-id]
    [t group-id artifact-id]))

(def content-fields [:artifact-id :group-id :version :description
                     :url #(->> % :authors (str/join " "))])

(def field-settings {:artifact-id {:analyzed false}
                     :group-id {:analyzed false}
                     :version {:analyzed false}
                     :at {:analyzed false}})

;; TODO: make this easy to do from clucy
(defonce analyzer (let [a (PerFieldAnalyzerWrapper.
                           ;; Our default analyzer has no stop words.
                           (StandardAnalyzer. clucy/*version* #{}))]
                    (doseq [[field {:keys [analyzed]}] field-settings
                            :when (false? analyzed)]
                      (.addAnalyzer a (name field) (KeywordAnalyzer.)))
                    a))

(def renames {:name       :artifact-id
              :jar_name   :artifact-id
              :group      :group-id
              :group_name :group-id
              :created    :at
              :homepage   :url})

(defn delete-from-index [index group-id & [artifact-id]]
  (binding [clucy/*analyzer* analyzer]
    (clucy/search-and-delete index
                             (cond-> (str "group-id:" group-id)
                                     artifact-id (str " AND artifact-id:" artifact-id)))))

(defn index-jar [index jar]
  (let [jar' (-> jar
                (set/rename-keys renames)
                (update-in [:licenses] #(mapv :name %)))
        ;; TODO: clucy forces its own :_content on you
        content (string/join " " ((apply juxt content-fields) jar'))
        doc (assoc (dissoc jar' :dependencies :scm)
                   :_content content)]
    (binding [clucy/*analyzer* analyzer]
      (let [[old] (try
                    (clucy/search index (format "artifact-id:%s AND group-id:%s"
                                                (some-> doc :artifact-id (QueryParser/escape))
                                                (some-> doc :group-id (QueryParser/escape))) 1)
                    (catch IndexNotFoundException _
                      ;; This happens when the index is searched before any data
                      ;; is added. We can treat it here as a nil return
                      ))]
        (if old
          (when (< (Long. (:at old)) (:at doc))
            (clucy/search-and-delete index (format "artifact-id:%s AND group-id:%s"
                                                   (some-> doc :artifact-id (QueryParser/escape))
                                                   (some-> doc :group-id (QueryParser/escape))))
            (clucy/add index (with-meta doc field-settings)))
          (clucy/add index (with-meta doc field-settings)))))))

(defn generate-index [db]
  (let [indexed (atom 0)]
    (with-open [index (clucy/disk-index (@config :index-path))]
      ;; searching with an empty index creates an exception
      (clucy/add index {:dummy true})
      (doseq [jar (db/all-jars db)]
        (swap! indexed inc)
        (when (zero? (mod @indexed 100))
          (println "Indexed" @indexed))
        (try
          (index-jar index jar)
          (catch Exception e
              (println (format "Failed to index %s/%s:%s - %s" (:group_name jar) (:jar_name jar) (:version jar)
                               (.getMessage e)))
              (.printStackTrace e))))
      (clucy/search-and-delete index "dummy:true"))))

;; We multiply this by the fraction of total downloads an item gets to
;; compute its download score. It's an arbitrary value chosen to give
;; subjectively good search results.
;;
;; The most downloaded item has about 3% of the total downloads, so
;; the maximum score is about 50 * 0.03 = 1.5.

(def download-score-weight 50)

(defn download-values [stats]
  (let [total (stats/total-downloads stats)]
    (ValueSourceQuery.
     (proxy [FieldCacheSource] ["download-count"]
       (getCachedFieldValues [cache _ reader]
         (let [ids (map vector
                        (.getStrings cache reader "group-id")
                        (.getStrings cache reader "artifact-id"))
               download-score (fn [i]
                                (let [score
                                      (inc
                                         (* download-score-weight
                                            (/ (apply
                                                (comp inc stats/download-count)
                                                stats
                                                (nth ids i))
                                               (max 1 total))))]
                                  score))]
           (proxy [DocValues] []
             (floatVal [i]
               (download-score i))
             (intVal [i]
               (download-score i))
             (toString [i]
               (str "download-count="
                    (download-score i))))))))))

(defn date-in-epoch-ms
  [iso-8601-date-string]
  (-> (java.time.ZonedDateTime/parse iso-8601-date-string)
      .toInstant
      .toEpochMilli
      str))

(defn lucene-time-syntax
  [start-time end-time]
  (format "at:[%s TO %s]"
          (date-in-epoch-ms start-time)
          (date-in-epoch-ms end-time)))

(defn replace-time-range
  "Replaces human readable time range in query with epoch milliseconds"
  [query]
  (let [matches (re-find #"at:\[(.*) TO (.*)\]" query)]
    (if (or (nil? matches) (not= (count matches) 3))
      query
      (try (->> (lucene-time-syntax (nth matches 1) (nth matches 2))
                (string/replace query (nth matches 0)))
           (catch Exception e query)))))

; http://stackoverflow.com/questions/963781/how-to-achieve-pagination-in-lucene
  (defn -search [stats index query page]
    (if (empty? query)
      []
      (binding [clucy/*analyzer* analyzer]
        (with-open [searcher (IndexSearcher. index)]
          (let [per-page 24
                offset (* per-page (- page 1))
                parser (QueryParser. clucy/*version*
                                     "_content"
                                     clucy/*analyzer*)
                query  (.parse parser (replace-time-range query))
                query  (CustomScoreQuery. query (download-values stats))
                hits   (.search searcher query (* per-page page))
                highlighter (#'clucy/make-highlighter query searcher nil)]
            (doall
             (let [dhits (take per-page (drop offset (.scoreDocs hits)))]
               (with-meta (for [hit dhits]
                            (#'clucy/document->map
                             (.doc searcher (.doc hit))
                             (.score hit)
                             highlighter))
                 {:total-hits (.totalHits hits)
                  :max-score (.getMaxScore hits)
                  :results-per-page per-page
                  :offset offset}))))))))

(defrecord LuceneSearch [stats index-factory index]
  Search
  (index! [t pom]
    (index-jar index pom))
  (search [t query page]
    (-search stats index query page))
  (delete! [t group-id]
    (delete-from-index index group-id))
  (delete! [t group-id artifact-id]
    (delete-from-index index group-id artifact-id))
  component/Lifecycle
  (start [t]
    (if index
      t
      (assoc t :index (index-factory))))
  (stop [t]
    (when index
      (.close index))
    (assoc t :index nil)))

(defn lucene-component []
  (map->LuceneSearch {}))

Fix indentation of fn in search.clj

Fix indentation of fn in search.clj


(ns com.rpl.specter.macros
  (:use [com.rpl.specter impl])
  )

(defn gensyms [amt]
  (vec (repeatedly amt gensym)))

(defn determine-params-impls [[name1 & impl1] [name2 & impl2]]
  (if-not (= #{name1 name2} #{'select* 'transform*})
    (throw-illegal "defpath must implement select* and transform*, instead got "
      name1 " and " name2))
  (if (= name1 'select*)
    [impl1 impl2]
    [impl2 impl1]))

(def PARAMS-SYM (vary-meta (gensym "params") assoc :tag 'objects))
(def PARAMS-IDX-SYM (gensym "params-idx"))

(defn paramspath* [bindings num-params [impl1 impl2]]
  (let [[[[_ s-structure-sym s-next-fn-sym] & select-body]
         [[_ t-structure-sym t-next-fn-sym] & transform-body]]
         (determine-params-impls impl1 impl2)]
    (if (= 0 num-params)
      `(no-params-compiled-path
         (->TransformFunctions
           StructurePathExecutor
           (fn [~s-structure-sym ~s-next-fn-sym]
             ~@select-body)
           (fn [~t-structure-sym ~t-next-fn-sym]
             ~@transform-body)
           ))
      `(->ParamsNeededPath
         (->TransformFunctions
           RichPathExecutor
           (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#]
             (let [~s-next-fn-sym (fn [structure#]
                                    (next-fn#
                                      ~PARAMS-SYM
                                      (+ ~PARAMS-IDX-SYM ~num-params)
                                      vals#
                                      structure#))
                   ~@bindings]
               ~@select-body
               ))
           (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~t-structure-sym next-fn#]
             (let [~t-next-fn-sym (fn [structure#]
                                    (next-fn#
                                      ~PARAMS-SYM
                                      (+ ~PARAMS-IDX-SYM ~num-params)
                                      vals#
                                      structure#))
                   ~@bindings]
               ~@transform-body
               )))
         ~num-params
         ))))

(defn paramscollector* [post-bindings num-params [_ [_ structure-sym] & body]]
  `(let [collector# (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#]
                      (let [~@post-bindings ~@[] ; to avoid syntax highlighting issues
                            c# (do ~@body)]
                        (next-fn#
                          ~PARAMS-SYM
                          (+ ~PARAMS-IDX-SYM ~num-params)
                          (conj vals# c#)
                          ~structure-sym)
                        ))]
     (->ParamsNeededPath
       (->TransformFunctions
         RichPathExecutor
         collector#
         collector# )
       ~num-params
       )))

(defn pathed-path* [builder paths-seq latefns-sym pre-bindings post-bindings impls]
  (let [num-params-sym (gensym "num-params")]
    `(let [paths# (map comp-paths* ~paths-seq)
           needed-params# (map num-needed-params paths#)
           offsets# (cons 0 (reductions + needed-params#))
           ~num-params-sym (last offsets#)
           ~latefns-sym (map
                          (fn [o# p#]
                            (if (compiled-path? p#)
                              (fn [params# params-idx#]
                                p# )
                              (fn [params# params-idx#]
                                (bind-params* p# params# (+ params-idx# o#))
                                )))
                          offsets#
                          paths#)
           ~@pre-bindings
           ret# ~(builder post-bindings num-params-sym impls)
           ]
    (if (= 0 ~num-params-sym)
      (bind-params* ret# nil 0)
      ret#
      ))))

(defn make-param-retrievers [params]
  (->> params
       (map-indexed
         (fn [i p]
           [p `(aget ~PARAMS-SYM
                     (+ ~PARAMS-IDX-SYM ~i))]
           ))
       (apply concat)))

(defmacro path
  "Defines a StructurePath with late bound parameters. This path can be precompiled
  with other selectors without knowing the parameters. When precompiled with other
  selectors, the resulting selector takes in parameters for all selectors in the path
  that needed parameters (in the order in which they were declared)."
  [params impl1 impl2]
  (let [num-params (count params)
        retrieve-params (make-param-retrievers params)]
    (paramspath* retrieve-params num-params [impl1 impl2])
    ))

(defmacro paramsfn [params [structure-sym] & impl]
  `(path ~params
     (~'select* [this# structure# next-fn#]
       (let [afn# (fn [~structure-sym] ~@impl)]
         (filter-select afn# structure# next-fn#)
         ))
     (~'transform* [this# structure# next-fn#]
       (let [afn# (fn [~structure-sym] ~@impl)]
         (filter-transform afn# structure# next-fn#)
         ))))

(defmacro paramscollector
  "Defines a Collector with late bound parameters. This collector can be precompiled
  with other selectors without knowing the parameters. When precompiled with other
  selectors, the resulting selector takes in parameters for all selectors in the path
  that needed parameters (in the order in which they were declared).
   "
  [params impl]
  (let [num-params (count params)
        retrieve-params (make-param-retrievers params)]
    (paramscollector* retrieve-params num-params impl)
    ))

(defmacro defpath [name & body]
  `(def ~name (path ~@body)))

(defmacro defcollector [name & body]
  `(def ~name (paramscollector ~@body)))

(defmacro fixed-pathed-path
  "This helper is used to define selectors that take in a fixed number of other selector
   paths as input. Those selector paths may require late-bound params, so this helper
   will create a parameterized selector if that is the case. If no late-bound params
   are required, then the result is executable."
  [bindings impl1 impl2]
  (let [bindings (partition 2 bindings)
        paths (mapv second bindings)
        names (mapv first bindings)
        latefns-sym (gensym "latefns")
        latefn-syms (vec (gensyms (count paths)))]
    (pathed-path*
      paramspath*
      paths
      latefns-sym
      [latefn-syms latefns-sym]
      (mapcat (fn [n l] [n `(~l ~PARAMS-SYM ~PARAMS-IDX-SYM)]) names latefn-syms)
      [impl1 impl2])))

(defmacro variable-pathed-path
  "This helper is used to define selectors that take in a variable number of other selector
   paths as input. Those selector paths may require late-bound params, so this helper
   will create a parameterized selector if that is the case. If no late-bound params
   are required, then the result is executable."
  [[latepaths-seq-sym paths-seq] impl1 impl2]
  (let [latefns-sym (gensym "latefns")]
    (pathed-path*
      paramspath*
      paths-seq
      latefns-sym
      []
      [latepaths-seq-sym `(map (fn [l#] (l# ~PARAMS-SYM ~PARAMS-IDX-SYM))
                               ~latefns-sym)]
      [impl1 impl2]
      )))

(defmacro pathed-collector
  "This helper is used to define collectors that take in a single selector
   paths as input. That path may require late-bound params, so this helper
   will create a parameterized selector if that is the case. If no late-bound params
   are required, then the result is executable."
  [[name path] impl]
  (let [latefns-sym (gensym "latefns")
        latefn (gensym "latefn")]
    (pathed-path*
      paramscollector*
      [path]
      latefns-sym
      [[latefn] latefns-sym]
      [name `(~latefn ~PARAMS-SYM ~PARAMS-IDX-SYM)]
      impl
      )
    ))

(defn- protpath-sym [name]
  (-> name (str "-prot") symbol))

(defmacro defprotocolpath [name params]
  (let [prot-name (protpath-sym name)
        m (-> name (str "-retrieve") symbol)
        num-params (count params)
        ssym (gensym "structure")
        rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")]
        retrieve `(~m ~ssym)
        ]
    `(do
        (defprotocol ~prot-name (~m [structure#]))
        (def ~name
          (if (= ~num-params 0)
            (no-params-compiled-path
              (->TransformFunctions
                RichPathExecutor
                (fn ~rargs
                  (let [path# ~retrieve
                        selector# (compiled-selector path#)]
                    (selector# ~@rargs)
                    ))
                (fn ~rargs
                  (let [path# ~retrieve
                        transformer# (compiled-transformer path#)]
                    (transformer# ~@rargs)
                    ))))
            (->ParamsNeededPath
              (->TransformFunctions
                RichPathExecutor
                (fn ~rargs
                  (let [path# ~retrieve
                        selector# (params-needed-selector path#)]
                    (selector# ~@rargs)
                    ))
                (fn ~rargs
                  (let [path# ~retrieve
                        transformer# (params-needed-transformer path#)]
                    (transformer# ~@rargs)
                    )))
              ~num-params
              )
            )))))

(defn declared-name [name]
  (symbol (str name "-declared")))

(defmacro declarepath [name]
  (let [declared (declared-name name)
        rargs [(gensym "params") (gensym "pidx") (gensym "vals")
               (gensym "structure") (gensym "next-fn")]]
    `(do
       (declare ~declared)
       (def ~name
         (no-params-compiled-path
           (->TransformFunctions
            RichPathExecutor
            (fn ~rargs
              (let [selector# (compiled-selector ~declared)]
                (selector# ~@rargs)
                ))
            (fn ~rargs
              (let [transformer# (compiled-transformer ~declared)]
                (transformer# ~@rargs)
                ))))
         ))))

(defmacro providepath [name apath]
  `(def ~(declared-name name)
     (update-in (comp-paths* ~apath)
                [:transform-fns]
                coerce-tfns-rich)
     ))

;;TODO: hmm... not sure how to proxy it as don't know if its paramsneeded/compiler or rich/regular
;;could require later definition to be done with "defproxiedpath" or wrapped in proxied-path

(defmacro extend-protocolpath [protpath & extensions]
  `(extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions)))

(ns com.rpl.specter.macros
  (:use [com.rpl.specter impl])
  )

(defn gensyms [amt]
  (vec (repeatedly amt gensym)))

(defn determine-params-impls [[name1 & impl1] [name2 & impl2]]
  (if-not (= #{name1 name2} #{'select* 'transform*})
    (throw-illegal "defpath must implement select* and transform*, instead got "
      name1 " and " name2))
  (if (= name1 'select*)
    [impl1 impl2]
    [impl2 impl1]))

(def PARAMS-SYM (vary-meta (gensym "params") assoc :tag 'objects))
(def PARAMS-IDX-SYM (gensym "params-idx"))

(defn paramspath* [bindings num-params [impl1 impl2]]
  (let [[[[_ s-structure-sym s-next-fn-sym] & select-body]
         [[_ t-structure-sym t-next-fn-sym] & transform-body]]
         (determine-params-impls impl1 impl2)]
    (if (= 0 num-params)
      `(no-params-compiled-path
         (->TransformFunctions
           StructurePathExecutor
           (fn [~s-structure-sym ~s-next-fn-sym]
             ~@select-body)
           (fn [~t-structure-sym ~t-next-fn-sym]
             ~@transform-body)
           ))
      `(->ParamsNeededPath
         (->TransformFunctions
           RichPathExecutor
           (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#]
             (let [~s-next-fn-sym (fn [structure#]
                                    (next-fn#
                                      ~PARAMS-SYM
                                      (+ ~PARAMS-IDX-SYM ~num-params)
                                      vals#
                                      structure#))
                   ~@bindings]
               ~@select-body
               ))
           (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~t-structure-sym next-fn#]
             (let [~t-next-fn-sym (fn [structure#]
                                    (next-fn#
                                      ~PARAMS-SYM
                                      (+ ~PARAMS-IDX-SYM ~num-params)
                                      vals#
                                      structure#))
                   ~@bindings]
               ~@transform-body
               )))
         ~num-params
         ))))

(defn paramscollector* [post-bindings num-params [_ [_ structure-sym] & body]]
  `(let [collector# (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#]
                      (let [~@post-bindings ~@[] ; to avoid syntax highlighting issues
                            c# (do ~@body)]
                        (next-fn#
                          ~PARAMS-SYM
                          (+ ~PARAMS-IDX-SYM ~num-params)
                          (conj vals# c#)
                          ~structure-sym)
                        ))]
     (->ParamsNeededPath
       (->TransformFunctions
         RichPathExecutor
         collector#
         collector# )
       ~num-params
       )))

(defn pathed-path* [builder paths-seq latefns-sym pre-bindings post-bindings impls]
  (let [num-params-sym (gensym "num-params")]
    `(let [paths# (map comp-paths* ~paths-seq)
           needed-params# (map num-needed-params paths#)
           offsets# (cons 0 (reductions + needed-params#))
           ~num-params-sym (last offsets#)
           ~latefns-sym (map
                          (fn [o# p#]
                            (if (compiled-path? p#)
                              (fn [params# params-idx#]
                                p# )
                              (fn [params# params-idx#]
                                (bind-params* p# params# (+ params-idx# o#))
                                )))
                          offsets#
                          paths#)
           ~@pre-bindings
           ret# ~(builder post-bindings num-params-sym impls)
           ]
    (if (= 0 ~num-params-sym)
      (bind-params* ret# nil 0)
      ret#
      ))))

(defn make-param-retrievers [params]
  (->> params
       (map-indexed
         (fn [i p]
           [p `(aget ~PARAMS-SYM
                     (+ ~PARAMS-IDX-SYM ~i))]
           ))
       (apply concat)))

(defmacro path
  "Defines a StructurePath with late bound parameters. This path can be precompiled
  with other selectors without knowing the parameters. When precompiled with other
  selectors, the resulting selector takes in parameters for all selectors in the path
  that needed parameters (in the order in which they were declared)."
  [params impl1 impl2]
  (let [num-params (count params)
        retrieve-params (make-param-retrievers params)]
    (paramspath* retrieve-params num-params [impl1 impl2])
    ))

(defmacro paramsfn [params [structure-sym] & impl]
  `(path ~params
     (~'select* [this# structure# next-fn#]
       (let [afn# (fn [~structure-sym] ~@impl)]
         (filter-select afn# structure# next-fn#)
         ))
     (~'transform* [this# structure# next-fn#]
       (let [afn# (fn [~structure-sym] ~@impl)]
         (filter-transform afn# structure# next-fn#)
         ))))

(defmacro paramscollector
  "Defines a Collector with late bound parameters. This collector can be precompiled
  with other selectors without knowing the parameters. When precompiled with other
  selectors, the resulting selector takes in parameters for all selectors in the path
  that needed parameters (in the order in which they were declared).
   "
  [params impl]
  (let [num-params (count params)
        retrieve-params (make-param-retrievers params)]
    (paramscollector* retrieve-params num-params impl)
    ))

(defmacro defpath [name & body]
  `(def ~name (path ~@body)))

(defmacro defcollector [name & body]
  `(def ~name (paramscollector ~@body)))

(defmacro fixed-pathed-path
  "This helper is used to define selectors that take in a fixed number of other selector
   paths as input. Those selector paths may require late-bound params, so this helper
   will create a parameterized selector if that is the case. If no late-bound params
   are required, then the result is executable."
  [bindings impl1 impl2]
  (let [bindings (partition 2 bindings)
        paths (mapv second bindings)
        names (mapv first bindings)
        latefns-sym (gensym "latefns")
        latefn-syms (vec (gensyms (count paths)))]
    (pathed-path*
      paramspath*
      paths
      latefns-sym
      [latefn-syms latefns-sym]
      (mapcat (fn [n l] [n `(~l ~PARAMS-SYM ~PARAMS-IDX-SYM)]) names latefn-syms)
      [impl1 impl2])))

(defmacro variable-pathed-path
  "This helper is used to define selectors that take in a variable number of other selector
   paths as input. Those selector paths may require late-bound params, so this helper
   will create a parameterized selector if that is the case. If no late-bound params
   are required, then the result is executable."
  [[latepaths-seq-sym paths-seq] impl1 impl2]
  (let [latefns-sym (gensym "latefns")]
    (pathed-path*
      paramspath*
      paths-seq
      latefns-sym
      []
      [latepaths-seq-sym `(map (fn [l#] (l# ~PARAMS-SYM ~PARAMS-IDX-SYM))
                               ~latefns-sym)]
      [impl1 impl2]
      )))

(defmacro pathed-collector
  "This helper is used to define collectors that take in a single selector
   paths as input. That path may require late-bound params, so this helper
   will create a parameterized selector if that is the case. If no late-bound params
   are required, then the result is executable."
  [[name path] impl]
  (let [latefns-sym (gensym "latefns")
        latefn (gensym "latefn")]
    (pathed-path*
      paramscollector*
      [path]
      latefns-sym
      [[latefn] latefns-sym]
      [name `(~latefn ~PARAMS-SYM ~PARAMS-IDX-SYM)]
      impl
      )
    ))

(defn- protpath-sym [name]
  (-> name (str "-prot") symbol))

(defmacro defprotocolpath [name params]
  (let [prot-name (protpath-sym name)
        m (-> name (str "-retrieve") symbol)
        num-params (count params)
        ssym (gensym "structure")
        rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")]
        retrieve `(~m ~ssym)
        ]
    `(do
        (defprotocol ~prot-name (~m [structure#]))
        (def ~name
          (if (= ~num-params 0)
            (no-params-compiled-path
              (->TransformFunctions
                RichPathExecutor
                (fn ~rargs
                  (let [path# ~retrieve
                        selector# (compiled-selector path#)]
                    (selector# ~@rargs)
                    ))
                (fn ~rargs
                  (let [path# ~retrieve
                        transformer# (compiled-transformer path#)]
                    (transformer# ~@rargs)
                    ))))
            (->ParamsNeededPath
              (->TransformFunctions
                RichPathExecutor
                (fn ~rargs
                  (let [path# ~retrieve
                        selector# (params-needed-selector path#)]
                    (selector# ~@rargs)
                    ))
                (fn ~rargs
                  (let [path# ~retrieve
                        transformer# (params-needed-transformer path#)]
                    (transformer# ~@rargs)
                    )))
              ~num-params
              )
            )))))

(defn declared-name [name]
  (symbol (str name "-declared")))

(defmacro declarepath [name]
  (let [declared (declared-name name)
        rargs [(gensym "params") (gensym "pidx") (gensym "vals")
               (gensym "structure") (gensym "next-fn")]]
    `(do
       (declare ~declared)
       (def ~name
         (no-params-compiled-path
           (->TransformFunctions
            RichPathExecutor
            (fn ~rargs
              (let [selector# (compiled-selector ~declared)]
                (selector# ~@rargs)
                ))
            (fn ~rargs
              (let [transformer# (compiled-transformer ~declared)]
                (transformer# ~@rargs)
                ))))
         ))))

(defmacro providepath [name apath]
  `(def ~(declared-name name)
     (update-in (comp-paths* ~apath)
                [:transform-fns]
                coerce-tfns-rich)
     ))

(defmacro extend-protocolpath [protpath & extensions]
  `(extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions)))

clean up notes

clean up notes


(ns momentum.core.deferred
  (:import
   [momentum.async
    AsyncSeq
    AsyncVal
    Pipeline
    Pipeline$Catcher
    Pipeline$Recur
    Receiver]))

(defprotocol DeferredValue
  (received? [_])
  (received  [_])
  (receive   [_ success error]))

(extend-protocol DeferredValue
  AsyncVal
  (received? [val]
    (.isRealized val))
  (received [val]
    (deref val 0 nil))
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  AsyncSeq
  (received? [seq]
    (.isRealized seq))
  (received [seq]
    seq)
  (receive [seq success error]
    (doto seq
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Pipeline
  (received? [pipeline]
    (.isRealized pipeline))
  (received [pipeline]
    (deref pipeline 0 nil))
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Object
  (received? [o] true)
  (received  [o] o)
  (receive [o success _]
    (success o)
    o)

  nil
  (received? [_] true)
  (received  [_])
  (receive [_ success _]
    (success nil)
    nil))

(defprotocol DeferredRealizer
  (put [_ v])
  (abort [_ err]))

(extend-protocol DeferredRealizer
  AsyncVal
  (put [dval val]   (.put dval val))
  (abort [dval err] (.abort dval err))

  Pipeline
  (put   [pipeline val] (.put pipeline val))
  (abort [pipeline err] (.abort pipeline err)))

(defn deferred
  []
  (AsyncVal.))

;; ==== Pipeline stuff

(defn pipeline
  [stages catchers finalizer]
  (Pipeline. (reverse stages) catchers finalizer))

(defn recur*
  ([]    (Pipeline$Recur. nil))
  ([val] (Pipeline$Recur. val)))

(defn join
  [& args]
  )

;; ==== Async macro

(defn- catch?
  [clause]
  (and (seq? clause) (= 'catch (first clause))))

(defn- finally?
  [clause]
  (and (seq? clause) (= 'finally (first clause))))

(defn- partition-clauses
  [clauses]
  (reduce
   (fn [[stages catches finally] clause]
     (cond
      (and (catch? clause) (not finally))
      [stages (conj catches clause) finally]

      (and (finally? clause) (not finally))
      [stages catches clause]

      (or (catch? clause) (finally? clause) (first catches) finally)
      (throw (IllegalArgumentException. (str "malformed pipeline statement: " clause)))

      :else
      [(conj stages clause) catches finally]))
   [[] [] nil] clauses))

(defn- to-catcher
  [[ _ k b & stmts]]
  `(Pipeline$Catcher. ~k (fn [~b] ~@stmts)))

(defn- to-finally
  [[_ & stmts]]
  `(fn [] ~@stmts))

(defmacro doasync
  [seed & clauses]
  (let [[stages catches finally] (partition-clauses clauses)]
    `(doto (pipeline [~@stages] [~@(map to-catcher catches)] ~(to-finally finally))
       (put ~seed))))

(defn async-seq
  ([f] (AsyncSeq. f)))

(defn batch
  "Returns a deferred value that is realized with the given collection
  when all (or n if supplied) elements of the collection have been
  realized."
  [coll]
  (doasync coll
    (fn [x]
      (if x
        (recur* (next x))
        coll))))
;; ([n coll] (throw (Exception. "Not implemented - requires (join ...)")))

(defn map*
  [f coll]
  (async-seq
    (fn [_]
      (doasync coll
        (fn [[v & more]]
          (cons v (map* f more)))))))

(ns momentum.core.deferred
  (:import
   [momentum.async
    AsyncSeq
    AsyncVal
    Pipeline
    Pipeline$Catcher
    Pipeline$Recur
    Receiver]))

(defprotocol DeferredValue
  (received? [_])
  (receive   [_ success error]))

(extend-protocol DeferredValue
  AsyncVal
  (received? [val]
    (.isRealized val))
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  AsyncSeq
  (received? [seq]
    (.isRealized seq))
  (receive [seq success error]
    (doto seq
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Pipeline
  (received? [pipeline]
    (.isRealized pipeline))
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Object
  (received? [o] true)
  (receive [o success _]
    (success o)
    o)

  nil
  (received? [_] true)
  (receive [_ success _]
    (success nil)
    nil))

(defprotocol DeferredRealizer
  (put [_ v])
  (abort [_ err]))

(extend-protocol DeferredRealizer
  AsyncVal
  (put [dval val]   (.put dval val))
  (abort [dval err] (.abort dval err))

  Pipeline
  (put   [pipeline val] (.put pipeline val))
  (abort [pipeline err] (.abort pipeline err)))

(defn deferred
  []
  (AsyncVal.))

;; ==== Pipeline stuff

(defn pipeline
  [stages catchers finalizer]
  (Pipeline. (reverse stages) catchers finalizer))

(defn recur*
  ([]    (Pipeline$Recur. nil))
  ([val] (Pipeline$Recur. val)))

(defn join
  [& args]
  )

;; ==== Async macro

(defn- catch?
  [clause]
  (and (seq? clause) (= 'catch (first clause))))

(defn- finally?
  [clause]
  (and (seq? clause) (= 'finally (first clause))))

(defn- partition-clauses
  [clauses]
  (reduce
   (fn [[stages catches finally] clause]
     (cond
      (and (catch? clause) (not finally))
      [stages (conj catches clause) finally]

      (and (finally? clause) (not finally))
      [stages catches clause]

      (or (catch? clause) (finally? clause) (first catches) finally)
      (throw (IllegalArgumentException. (str "malformed pipeline statement: " clause)))

      :else
      [(conj stages clause) catches finally]))
   [[] [] nil] clauses))

(defn- to-catcher
  [[ _ k b & stmts]]
  `(Pipeline$Catcher. ~k (fn [~b] ~@stmts)))

(defn- to-finally
  [[_ & stmts]]
  `(fn [] ~@stmts))

(defmacro doasync
  [seed & clauses]
  (let [[stages catches finally] (partition-clauses clauses)]
    `(doto (pipeline [~@stages] [~@(map to-catcher catches)] ~(to-finally finally))
       (put ~seed))))

(defn async-seq
  ([f] (AsyncSeq. f)))

(defn batch
  "Returns a deferred value that is realized with the given collection
  when all (or n if supplied) elements of the collection have been
  realized."
  [coll]
  (doasync coll
    (fn [x]
      (if x
        (recur* (next x))
        coll))))
;; ([n coll] (throw (Exception. "Not implemented - requires (join ...)")))

(defn map*
  [f coll]
  (async-seq
    (fn [_]
      (doasync coll
        (fn [[v & more]]
          (cons v (map* f more)))))))

Remove dead code (received )

Remove dead code (received )


(ns doctopus.doctopus.tentacle
  "A `Tentacle' defines a single unit of documentation -- one 'source' worth,
  and all the configs required to build it."
  (:require [clojure.string :as str]
            [compojure.core :refer [GET routes context]]
            [doctopus.shell :refer [make-html-from-vec git-clone]]
            [doctopus.storage :refer [save-to-storage load-from-storage count-records-for-tentacle backend]]
            [me.raynes.fs :as fs]
            [taoensso.timbre :as log]))

(defn- get-source
  "We may eventually support more ways of getting source! Would be nice. Not
  today."
  [sc-location dest]
  (git-clone sc-location dest))

;; #### "Try, report, return"-ing
;; I've found myself doing a lot of this:
;; (if (do-a-thing-that-returns-something-or-nil)
;;     (do (log the result) true)
;;     (do (log the failure) nil))

(defn report-success
  [msg]
  (log/info msg)
  true)

(defn report-error
  [msg]
  (log/error msg)
  nil)

(defn check-and-report
  [result noun success-msg fail-msg]
  (let [success-tpl "Success: %s for %s"
        error-tpl   "Couldn't %s for %s"]
    (if result
      (report-success (format success-tpl success-msg noun))
      (report-error (format error-tpl fail-msg noun)))))

;; TENTACLES
(defprotocol TentacleMethods
  (load-html [this] "Makes sure the HTML has been generated for this tentacle")
  (generate-html [this])
  (save-build-output [this dir])
  (get-html-entrypoint [this])
  (generate-routes [this]))

(defrecord Tentacle
    [name html-commands output-root source-location entry-point]
  TentacleMethods
  (load-html [this]
    (if (= 0 (count-records-for-tentacle backend this))
      (do (log/debug "Generating") (generate-html this))
      (log/info "Found html for" (:name this) ", count is:" (count-records-for-tentacle backend (:name this)) "for name:" (:name this))))
  (generate-html [this]
    (log/info "Generating HTML for" (:name this))
    (let [{:keys [html-commands source-location output-root]} this
          target-dir (fs/temp-dir "doctopus-clone")
          success? (get-source source-location (.getPath target-dir))]
      (if success?
        (do (binding [fs/*cwd* target-dir]
              (let [html-dir (fs/file output-root)]
                (make-html-from-vec html-commands target-dir)
                (check-and-report
                 (save-build-output this html-dir) name "generated HTML" "generate HTML"))))
        (report-error "Couldn't clone source! Argggggg!"))))
  (save-build-output [this dir]
    (let [{:keys [name]} this]
      (check-and-report
       (save-to-storage backend name dir) name "saved HTML" "save HTML")))
  (get-html-entrypoint [this]
    (str/join "/" ["" "docs" (:name this) (:entry-point this)]))
  (generate-routes [this]
    (routes
     (GET "*" {:keys [uri]}
          (log/debug "Looking for URI:" uri)
          (load-from-storage backend uri)))))

(ns doctopus.doctopus.tentacle
  "A `Tentacle' defines a single unit of documentation -- one 'source' worth,
  and all the configs required to build it."
  (:require [clojure.string :as str]
            [compojure.core :refer [GET routes context]]
            [doctopus.shell :refer [make-html-from-vec git-clone]]
            [doctopus.storage :refer [save-to-storage load-from-storage count-records-for-tentacle backend]]
            [me.raynes.fs :as fs]
            [taoensso.timbre :as log]))

(defn- get-source
  "We may eventually support more ways of getting source! Would be nice. Not
  today."
  [sc-location dest]
  (git-clone sc-location dest))

;; #### "Try, report, return"-ing
;; I've found myself doing a lot of this:
;; (if (do-a-thing-that-returns-something-or-nil)
;;     (do (log the result) true)
;;     (do (log the failure) nil))

(defn report-success
  [msg]
  (log/info msg)
  true)

(defn report-error
  [msg]
  (log/error msg)
  nil)

(defn check-and-report
  [result noun success-msg fail-msg]
  (let [success-tpl "Success: %s for %s"
        error-tpl   "Couldn't %s for %s"]
    (if result
      (report-success (format success-tpl success-msg noun))
      (report-error (format error-tpl fail-msg noun)))))

;; TENTACLES
(defprotocol TentacleMethods
  (load-html [this] "Makes sure the HTML has been generated for this tentacle")
  (generate-html [this])
  (save-build-output [this dir])
  (get-html-entrypoint [this])
  (generate-routes [this]))

(defrecord Tentacle
    [name html-commands output-root source-location entry-point]
  TentacleMethods
  (load-html [this]
    (if (= 0 (count-records-for-tentacle backend this))
      (do (log/info "No HTML found for" (:name this))
          (generate-html this))
      (log/info "Found html for" (:name this))))
  (generate-html [this]
    (log/info "Generating HTML for" (:name this))
    (let [{:keys [html-commands source-location output-root]} this
          target-dir (fs/temp-dir "doctopus-clone")
          success? (get-source source-location (.getPath target-dir))]
      (if success?
        (do (binding [fs/*cwd* target-dir]
              (let [html-dir (fs/file output-root)]
                (make-html-from-vec html-commands target-dir)
                (check-and-report
                 (save-build-output this html-dir) name "generated HTML" "generate HTML"))))
        (report-error "Couldn't clone source! Argggggg!"))))
  (save-build-output [this dir]
    (let [{:keys [name]} this]
      (check-and-report
       (save-to-storage backend name dir) name "saved HTML" "save HTML")))
  (get-html-entrypoint [this]
    (str/join "/" ["" "docs" (:name this) (:entry-point this)]))
  (generate-routes [this]
    (routes
     (GET "*" {:keys [uri]}
          (log/debug "Looking for URI:" uri)
          (load-from-storage backend uri)))))

tweak logging

tweak logging


(ns user
  (:require [uswitch.bifrost.system :refer (make-system)]
            [clojure.tools.logging :refer (error)]
            [clojure.tools.namespace.repl :refer (refresh)]
            [com.stuartsierra.component :as component]))

(def system nil)

(defn init []
  (alter-var-root #'system
                  (constantly (make-system (read-string (slurp "./etc/config.edn"))))))

(defn start []
  (alter-var-root #'system (fn [s] (try (component/start s)
                                       (catch Exception e
                                         (error e "Error when starting system")
                                         nil))) ))

(defn stop []
  (alter-var-root #'system (fn [s] (when s (try (component/stop s)
                                               (catch Exception e
                                                 (error e "Error when stopping system")
                                                 nil))))))

(defn go []
  (init)
  (start))

(defn reset []
  (stop)
  (refresh :after 'user/go))

(ns user
  (:require [clojure.tools.logging :refer (error)]
            [clojure.tools.namespace.repl :refer (refresh)]
            [com.stuartsierra.component :as component]))

(def system nil)

(defn init []
  ;; We do some gymnastics here to make sure that the REPL can always start
  ;; even in the presence of compilation errors.
  (require '[uswitch.bifrost.system])

  (let [make-system (resolve 'uswitch.bifrost.system/make-system)]
    (alter-var-root #'system
                  (constantly (make-system (read-string (slurp "./etc/config.edn")))))))

(defn start []
  (alter-var-root #'system (fn [s] (try (component/start s)
                                       (catch Exception e
                                         (error e "Error when starting system")
                                         nil))) ))

(defn stop []
  (alter-var-root #'system (fn [s] (when s (try (component/stop s)
                                               (catch Exception e
                                                 (error e "Error when stopping system")
                                                 nil))))))

(defn go []
  (init)
  (start))

(defn reset []
  (stop)
  (refresh :after 'user/go))

Apply 'can always start the repl pattern'.

Actually this can still fail in the presence of aot'd files. have you
tried lein clean?


{:user {:dependencies [[clj-stacktrace "0.2.7"]
                       [im.chit/vinyasa "0.1.0"]
                       [io.aviso/pretty "0.1.8"]
                       [org.clojure/tools.namespace "0.2.4"]
                       [slamhound "1.3.1"]
                       [spyscope "0.1.4"]
                       [criterium "0.4.2"]]

        :plugins [[codox "0.6.6"]
                  [jonase/eastwood "0.0.2"]
                  [lein-cljsbuild "1.0.0"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [lein-swank "1.4.4"]]

        :injections [(require 'spyscope.core
                              'vinyasa.inject
                              'io.aviso.repl
                              'clojure.repl
                              'clojure.main
                              '[criterium.core :refer [bench quick-bench]])

                     (vinyasa.inject/inject
                       'clojure.core
                       '[[vinyasa.inject [inject inject]]
                         [vinyasa.pull [pull pull]]
                         [vinyasa.lein [lein lein]]
                         [clojure.repl apropos dir doc find-doc source
                          [root-cause cause]]
                         [clojure.tools.namespace.repl [refresh refresh]]
                         [clojure.pprint [pprint >pprint]]
                         [io.aviso.binary [write-binary >bin]]])]

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :source-paths ["/Users/jcf/.lein/dev"]
        :search-page-size 30}}

{:user {:dependencies [[clj-stacktrace "0.2.7"]
                       [org.clojure/tools.namespace "0.2.4"]
                       [slamhound "1.3.1"]
                       [spyscope "0.1.4"]
                       [criterium "0.4.2"]]

        :plugins [[codox "0.6.6"]
                  [jonase/eastwood "0.0.2"]
                  [lein-cljsbuild "1.0.0"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [lein-swank "1.4.4"]]

        :injections [(require 'spyscope.core
                              '[criterium.core :refer [bench quick-bench]])]

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 30}}

Remove a load of hacky Clojure injections


(ns devtools.core
  (:require [devtools.debug :as debug]))

(def max-coll-elements 10)
(def max-map-elements 5)
(def max-set-elements 10)
(def max-seq-elements 20)
(def abbreviation "…")
(def line-index-separator ":")
(def formatter-key "devtoolsFormatter")
(def dq "\"")
(def surrogate-key "$$surrogate")
(def standard-ol-style "list-style-type:none; padding-left:0px; margin-top:0px; margin-bottom:0px; margin-left:12px")
(def standard-li-style "margin-left:12px")
(def spacer " ")
(def span "span")
(def ol "ol")
(def li "li")

(def ^:dynamic *devtools-installed* false)
(def ^:dynamic *devtools-enabled* true)
(def ^:dynamic *original-formatter* nil)

(declare inlined-value-template)

; dirty TODO: find a reliable way how to detect cljs values
(defn cljs-value? [value]
  (or (exists? (aget value "meta"))
      (exists? (aget value "_meta"))
      (exists? (aget value "_hash"))))

(defn js-value? [value]
  (not (cljs-value? value)))

(defn surrogate? [value]
  (exists? (aget value surrogate-key)))

(defn template [tag style & children]
  (let [js-array #js [tag (if (empty? style) #js {} #js {"style" style})]]
    (doseq [child children]
      (if (coll? child)
        (.apply (aget js-array "push") js-array (into-array child)) ; convenience helper to splat cljs collections
        (.push js-array child)))
    js-array))

(defn reference [object & children]
  (let [js-array #js ["object" #js {"object" object}]]
    (doseq [child children]
      (.push js-array child))
    js-array))

(defn surrogate [object header]
  (js-obj
    surrogate-key true
    "target" object
    "header" header))

(defn nil-template [_]
  (template span "color:#808080" "nil"))

(defn keyword-template [value]
  (template span "color:#881391" (str ":" (name value))))

(defn symbol-template [value]
  (template span "color:#000000" (str value)))

(defn number-template [value]
  (if (integer? value)
    (template span "color:#1C00CF" value)
    (template span "color:#1C88CF" value)))

(defn index-template [value]
  (template span "color:#881391" value line-index-separator))

(defn deref-template [value]
  (cond
    (satisfies? IAtom value) (template span "color:#f0f" "#<Atom " (reference @value) ">")
    (satisfies? IVolatile value) (template span "color:#f0f" "#<Volatile " (reference @value) ">")
    :else (pr-str value))) ; TODO: should we handle IDelay and others? I believe it is not safe to dereference them here

; TODO: abbreviate long strings
(defn string-template [value]
  (template span "color:#C41A16" (str dq value dq)))

(defn fn-template [value]
  (template span "color:#090" (reference (surrogate value "λ"))))

(defn header-inlined-templates [value renderer max]
  (let [rendered-items (apply concat (interpose [spacer] (map renderer (take max value))))]
    (if (> (count value) max)
      (concat rendered-items [abbreviation])
      rendered-items)))

(defn header-map-template [value]
  (let [renderer (fn [[key value]] [(inlined-value-template key) spacer (inlined-value-template value)])
        items (header-inlined-templates value renderer max-map-elements)]
    (template span "color:#000" "{" items "}")))

(defn header-set-template [value]
  (let [renderer (fn [item] [(inlined-value-template item)])
        items (header-inlined-templates value renderer max-set-elements)]
    (template span "color:#000" "#{" items "}")))

(defn header-seq-template [value]
  (let [renderer (fn [item] [(inlined-value-template item)])
        items (header-inlined-templates value renderer max-seq-elements)]
    (template span "color:#000" "(" items ")")))

(defn header-coll-template [value]
  (let [renderer (fn [item] [(inlined-value-template item)])
        items (header-inlined-templates value renderer max-coll-elements)]
    (template span "color:#000" "[" items "]")))

(defn bool-template [value]
  (template span "color:#099" value))

(defn generic-template [value]
  (template span "color:#000" (reference value)))

(defn js-object-template [value]
  (if (js-value? value)
    (template span "color:#000" (reference (surrogate value "#js"))))) ; TODO: we could render short preview of #js value here

(defn bool? [value]
  (or (true? value) (false? value)))

(defn deref? [value]
  (satisfies? IDeref value))

(defn atomic-template [value]
  (cond
    (nil? value) (nil-template value)
    (bool? value) (bool-template value)
    (string? value) (string-template value)
    (number? value) (number-template value)
    (keyword? value) (keyword-template value)
    (symbol? value) (symbol-template value)
    (fn? value) (fn-template value)
    (deref? value) (deref-template value)))

(defn header-container-template [value]
  (cond
    (map? value) (header-map-template value)
    (set? value) (header-set-template value)
    (seq? value) (header-seq-template value)
    (coll? value) (header-coll-template value)))

(defn inlined-value-template [value]
  (or (atomic-template value)
      (js-object-template value)
      (generic-template value)))

(defn header-template [value]
  (or (atomic-template value)
      (header-container-template value)
      (pr-str value)))

(defn build-header [value]
  (template span "background-color:#efe" (header-template value)))

(defn body-line-template [index value]
  (template li standard-li-style (index-template index) spacer (inlined-value-template value)))

(defn body-line-templates [value]
  (loop [data (seq value) ; TODO: limit max number of lines here?
         index 0
         lines []]
    (if (empty? data)
      lines
      (recur (rest data) (inc index) (conj lines (body-line-template index (first data)))))))

(defn build-body [value]
  (template ol standard-ol-style (body-line-templates value)))

(defn something-abbreviated? [value]
  (if (coll? value)
    (some #(something-abbreviated? %) value)
    (= abbreviation value)))

(defn abbreviated? [template]
  (something-abbreviated? (js->clj template)))

(defn want-value? [value]
  (or (cljs-value? value)
      (surrogate? value)))

(defn header-hook [value]
  (if (surrogate? value)
    (.-header value)
    (build-header value)))

(defn has-body-hook [value]
  (if (surrogate? value)
    true
    (abbreviated? (build-header value))))

(defn build-surrogate-body [value]
  (let [target (.-target value)]
    (template ol standard-ol-style (template li standard-li-style (reference target (pr-str target))))))

(defn body-hook [value]
  (if (surrogate? value)
    (build-surrogate-body value)
    (build-body value)))

(defn sanitize
  "wraps our hook in try-catch block to prevent leaking of exceptions if something goes wrong"
  [hook]
  (fn [value]
    (try
      (hook value)
      (catch js/Object e
        (debug/log-exception e)
        nil))))

(defn chain
  "chains our hook with original formatter"
  [name original-formatter hook]
  (let [call-original-formatter? (fn [value]
                                   (if (not (nil? original-formatter))
                                     (do ; TODO should we wrap this in try-catch instead?
                                       (debug/log-info "passing call to original formatter")
                                       (.call (aget original-formatter name) original-formatter value))))]
    (fn [value]
      (if (and *devtools-enabled* (want-value? value))
        (hook value)
        (call-original-formatter? value)))))

(defn cljs-formatter [original-formatter]
  (let [hook-wrapper (fn [name hook] (debug/hook-monitor name (chain name original-formatter (sanitize hook))))]
    (js-obj
      "header" (hook-wrapper "header" header-hook)
      "hasBody" (hook-wrapper "hasBody" has-body-hook)
      "body" (hook-wrapper "body" body-hook))))

(defn install-devtools! []
  (if *devtools-installed*
    (debug/log-info "devtools already installed - nothing to do")
    (do
      (set! *devtools-installed* true)
      (set! *original-formatter* (aget js/window formatter-key))
      (aset js/window formatter-key (cljs-formatter *original-formatter*)))))

; NOT SAFE
(defn uninstall-devtools! []
  (aset js/window formatter-key *original-formatter*)
  (set! *original-formatter* nil)
  (set! *devtools-installed* false))

(defn disable-devtools! []
  (set! *devtools-enabled* false))

(defn enable-devtools! []
  (set! *devtools-enabled* true))

(ns devtools.core
  (:require [devtools.debug :as debug]))

(def max-coll-elements 10)
(def max-map-elements 5)
(def max-set-elements 10)
(def max-seq-elements 20)
(def abbreviation "…")
(def line-index-separator ":")
(def formatter-key "devtoolsFormatter")
(def dq "\"")
(def surrogate-key "$$surrogate")
(def standard-ol-style "list-style-type:none; padding-left:0px; margin-top:0px; margin-bottom:0px; margin-left:12px")
(def standard-li-style "margin-left:12px")
(def spacer " ")
(def span "span")
(def ol "ol")
(def li "li")

(def ^:dynamic *devtools-installed* false)
(def ^:dynamic *devtools-enabled* true)
(def ^:dynamic *original-formatter* nil)

(declare inlined-value-template)

; dirty TODO: find a reliable way how to detect cljs values
(defn cljs-value? [value]
  (or (exists? (aget value "meta"))
      (exists? (aget value "_meta"))
      (exists? (aget value "_hash"))))

(defn js-value? [value]
  (not (cljs-value? value)))

(defn surrogate? [value]
  (exists? (aget value surrogate-key)))

(defn template [tag style & children]
  (let [js-array #js [tag (if (empty? style) #js {} #js {"style" style})]]
    (doseq [child children]
      (if (coll? child)
        (.apply (aget js-array "push") js-array (into-array child)) ; convenience helper to splat cljs collections
        (.push js-array child)))
    js-array))

(defn reference [object & children]
  (let [js-array #js ["object" #js {"object" object}]]
    (doseq [child children]
      (.push js-array child))
    js-array))

(defn surrogate [object header]
  (js-obj
    surrogate-key true
    "target" object
    "header" header))

(defn nil-template [_]
  (template span "color:#808080" "nil"))

(defn keyword-template [value]
  (template span "color:#881391" (str ":" (name value))))

(defn symbol-template [value]
  (template span "color:#000000" (str value)))

(defn number-template [value]
  (if (integer? value)
    (template span "color:#1C00CF" value)
    (template span "color:#1C88CF" value)))

(defn index-template [value]
  (template span "color:#881391" value line-index-separator))

(defn deref-template [value]
  (cond
    (satisfies? IAtom value) (template span "color:#f0f" "#<Atom " (reference @value) ">")
    (satisfies? IVolatile value) (template span "color:#f0f" "#<Volatile " (reference @value) ">")
    :else (pr-str value))) ; TODO: should we handle IDelay and others? I believe it is not safe to dereference them here

; TODO: abbreviate long strings
(defn string-template [value]
  (template span "color:#C41A16" (str dq value dq)))

(defn fn-template [value]
  (template span "color:#090" (reference (surrogate value "λ"))))

(defn header-inlined-templates [value renderer max]
  (let [rendered-items (apply concat (interpose [spacer] (map renderer (take max value))))]
    (if (> (count value) max)
      (concat rendered-items [abbreviation])
      rendered-items)))

(defn header-map-template [value]
  (let [renderer (fn [[key value]] [(inlined-value-template key) spacer (inlined-value-template value)])
        items (header-inlined-templates value renderer max-map-elements)]
    (template span "color:#000" "{" items "}")))

(defn header-set-template [value]
  (let [renderer (fn [item] [(inlined-value-template item)])
        items (header-inlined-templates value renderer max-set-elements)]
    (template span "color:#000" "#{" items "}")))

(defn header-seq-template [value]
  (let [renderer (fn [item] [(inlined-value-template item)])
        items (header-inlined-templates value renderer max-seq-elements)]
    (template span "color:#000" "(" items ")")))

(defn header-coll-template [value]
  (let [renderer (fn [item] [(inlined-value-template item)])
        items (header-inlined-templates value renderer max-coll-elements)]
    (template span "color:#000" "[" items "]")))

(defn bool-template [value]
  (template span "color:#099" value))

(defn generic-template [value]
  (template span "color:#000" (reference value)))

(defn js-object-template [value]
  (if (js-value? value)
    (template span "color:#000" (reference (surrogate value "#js"))))) ; TODO: we could render short preview of #js value here

(defn bool? [value]
  (or (true? value) (false? value)))

(defn deref? [value]
  (satisfies? IDeref value))

(defn atomic-template [value]
  (cond
    (nil? value) (nil-template value)
    (bool? value) (bool-template value)
    (string? value) (string-template value)
    (number? value) (number-template value)
    (keyword? value) (keyword-template value)
    (symbol? value) (symbol-template value)
    (fn? value) (fn-template value)
    (deref? value) (deref-template value)))

(defn header-container-template [value]
  (cond
    (map? value) (header-map-template value)
    (set? value) (header-set-template value)
    (seq? value) (header-seq-template value)
    (coll? value) (header-coll-template value)))

(defn inlined-value-template [value]
  (or (atomic-template value)
      (js-object-template value)
      (generic-template value)))

(defn header-template [value]
  (or (atomic-template value)
      (header-container-template value)
      (pr-str value)))

(defn build-header [value]
  (template span "background-color:#efe" (header-template value)))

(defn body-line-template [index value]
  (template li standard-li-style (index-template index) spacer (inlined-value-template value)))

(defn body-line-templates [value]
  (loop [data (seq value) ; TODO: limit max number of lines here?
         index 0
         lines []]
    (if (empty? data)
      lines
      (recur (rest data) (inc index) (conj lines (body-line-template index (first data)))))))

(defn build-body [value]
  (template ol standard-ol-style (body-line-templates value)))

(defn something-abbreviated? [value]
  (if (coll? value)
    (some #(something-abbreviated? %) value)
    (= abbreviation value)))

(defn abbreviated? [template]
  (something-abbreviated? (js->clj template)))

(defn want-value? [value]
  (or (cljs-value? value)
      (surrogate? value)))

(defn header-hook [value]
  (if (surrogate? value)
    (.-header value)
    (build-header value)))

(defn has-body-hook [value]
  (if (surrogate? value)
    true
    (abbreviated? (build-header value))))

(defn build-surrogate-body [value]
  (let [target (.-target value)]
    (template ol standard-ol-style (template li standard-li-style (reference target (pr-str target))))))

(defn body-hook [value]
  (if (surrogate? value)
    (build-surrogate-body value)
    (build-body value)))

(defn sanitize
  "wraps our hook in try-catch block to prevent leaking of exceptions if something goes wrong"
  [hook]
  (fn [value]
    (try
      (hook value)
      (catch js/Object e
        (debug/log-exception e)
        nil))))

(defn chain
  "chains our hook with original formatter"
  [name original-formatter hook]
  (let [call-original-formatter? (fn [value]
                                   (if (not (nil? original-formatter))
                                     (do ; TODO should we wrap this in try-catch instead?
                                       (debug/log-info "passing call to original formatter")
                                       (.call (aget original-formatter name) original-formatter value))))]
    (fn [value]
      (if (and *devtools-enabled* (want-value? value))
        (hook value)
        (call-original-formatter? value)))))

(defn cljs-formatter [original-formatter]
  (let [api [["header" header-hook]
             ["hasBody" has-body-hook]
             ["body" body-hook]]
        hook-wrapper (fn [name hook]
                       (let [monitor (partial debug/hook-monitor name)
                             chainer (partial chain name original-formatter)
                             sanitizer sanitize]
                         ((comp monitor chainer sanitizer) hook)))
        api-gen (fn [[name hook]] [name (hook-wrapper name hook)])]
    (apply js-obj (mapcat #(api-gen %) api))))

(defn install-devtools! []
  (if *devtools-installed*
    (debug/log-info "devtools already installed - nothing to do")
    (do
      (set! *devtools-installed* true)
      (set! *original-formatter* (aget js/window formatter-key))
      (aset js/window formatter-key (cljs-formatter *original-formatter*)))))

; NOT SAFE
(defn uninstall-devtools! []
  (aset js/window formatter-key *original-formatter*)
  (set! *original-formatter* nil)
  (set! *devtools-installed* false))

(defn disable-devtools! []
  (set! *devtools-enabled* false))

(defn enable-devtools! []
  (set! *devtools-enabled* true))

Rewrite cljs-formatter using comp

Rewrite cljs-formatter using comp


{:repl {:plugins [[cider/cider-nrepl "0.15.1"]]
        :dependencies [[org.clojure/tools.nrepl "0.2.13"]]}
 :user {:plugins [[lein-pprint "1.2.0"]]}}

{:repl {:plugins [[cider/cider-nrepl "0.16.0"]]
        :dependencies [[org.clojure/tools.nrepl "0.2.13"]]}
 :user {:plugins [[lein-pprint "1.2.0"]]}}

Update cider-nrepl for Leiningen

Update cider-nrepl for Leiningen


{;;; Modular profiles

 :cider {:plugins [;; REPL-side support for CIDER and other editor tools
                   [cider/cider-nrepl "0.13.0"]]}

 :humane {:dependencies [;; Better-formatted clojure.test output
                         [pjstadig/humane-test-output "0.8.0"]]

          :injections [;; Activate better-formatted clojure.test output
                       (require 'pjstadig.humane-test-output)
                       (pjstadig.humane-test-output/activate!)]}

 :inject {:dependencies [;; Inject utility functions into convenient namespaces
                         ;; (by default, the '.' namespace)
                         [im.chit/vinyasa.inject "0.4.7"]]

          :injections [;; The following injections do not incur any additional startup
                       ;; cost -- the clojure.* namespaces are loaded by default when
                       ;; the REPL starts up, and vinyasa.inject is obviously already
                       ;; being loaded because that is the whole point of this profile.
                       ;; So, unlike the other injections, these ones are not split out
                       ;; into different profiles.
                       (require 'vinyasa.inject)
                       (vinyasa.inject/in
                         [clojure.java.shell sh]
                         [clojure.pprint pp pprint]
                         [clojure.repl doc pst source]
                         [vinyasa.inject [in inject]])]}

 ;; BEGIN profiles with optional injections
 ;; Put these *after* the :inject profile if you want the injections.

 :alembic {:dependencies [;; Pull dependencies from Clojars in the REPL,
                          ;; and invoke Leiningen tasks from the REPL
                          [alembic "0.3.2"]]

           :injections [;; Modify the alembic/distill function to work without needing a
                        ;; project.clj file. This is a hack! It works simply by
                        ;; telling alembic not to look for repositories in the project.clj.
                        ;; However, this is a global override, so if you need to use one
                        ;; of the repositories in the project.clj, you must either pass
                        ;; the :repositories key explicitly, or pass the keyword :project
                        ;; to suppress this hack and allow alembic to search project.clj
                        ;; for repositories.
                        (require 'alembic.still)
                        (alter-var-root
                          #'alembic.still/distill
                          (fn [distill]
                            (fn [dependencies & args]
                              (if (= (first args) :project)
                                (apply distill dependencies (rest args))
                                (apply distill dependencies :repositories [] args)))))

                        ;; For some reason, Leiningen tries to resolve every unquoted
                        ;; symbol in the :injections code, even the ones that wouldn't
                        ;; be resolved normally (e.g. the vinyasa.inject/in symbol
                        ;; inside the when form). So to prevent it from choking on the
                        ;; potentially nonexistent symbol inside the when block we have
                        ;; to use this hilariously ridiculous eval hack.
                        (when (resolve 'vinyasa.inject/in)
                          (eval
                            `(~(symbol "vinyasa.inject/in")
                              ~'[alembic.still distill lein])))]}

 :pull {:dependencies [;; Pull dependencies from Clojars in the REPL
                       [im.chit/vinyasa.maven "0.4.7"]]

        :injections [;; See :alembic profile for an explanation of this hack.
                     (when (resolve 'vinyasa.inject/in)
                       (eval
                         `(~(symbol "vinyasa.inject/in")
                           ~'[vinyasa.maven pull])))]}

 :reflection {:dependencies [;; Convenient reflection functions
                             [im.chit/vinyasa.reflection "0.4.7"]]

              :injections [;; See :alembic profile for an explanation of this hack.
                           (when (resolve 'vinyasa.inject/in)
                             (eval
                               `(~(symbol "vinyasa.inject/in")
                                 ~'clojure.core
                                 ~'[vinyasa.reflection .& .> .? .* .% .%>])))]}

 :refresh {:dependencies [;; Properly refresh a dirty namespace
                          [org.clojure/tools.namespace "0.2.11"]]

           :injections [;; See :alembic profile for an explanation of this hack.
                        (when (resolve 'vinyasa.inject/in)
                          (eval
                            `(~(symbol "vinyasa.inject/in")
                              ~'[clojure.tools.namespace.repl refresh])))]}

 ;;; END profiles with optional injections

 :lint {:plugins [;; Miscellaneous linting
                  [jonase/eastwood "0.2.3"]

                  ;; Check for outdated dependencies and plugins
                  [lein-ancient "0.6.10"]

                  ;; Basic linting
                  [lein-bikeshed "0.3.0"]

                  ;; Style linting
                  [lein-cljfmt "0.5.3"]

                  ;; Miscellaneous linting
                  [lein-kibit "0.1.2"]

                  ;; Check for unused functions
                  [venantius/yagni "0.1.4"]]}

 :pretty {:dependencies [;; Pretty stack traces
                         [io.aviso/pretty "0.1.29"]]

          :injections [;; Use pretty stack traces for pst. CIDER has even better stack trace
                       ;; functionality by default, so we won't make the REPL print a full
                       ;; stack trace on encountering an exception. (This would be done by
                       ;; overriding clojure.main/repl-caught.)
                       (require 'clojure.repl 'io.aviso.repl)
                       (alter-var-root
                         #'clojure.repl/pst
                         (constantly (fn [& args]
                                       ;; This prevents a NPE when no exception has yet
                                       ;; occurred.
                                       (when *e
                                         (apply io.aviso.repl/pretty-pst args)))))]}

 :refactor {:plugins [;; REPL-side support for clj-refactor
                      [refactor-nrepl "2.2.0"]]}

 :spyscope {:dependencies [;; Quick-and-dirty debugging tools
                           [spyscope "0.1.5"]]

            :injections [;; Make the spyscope reader macros available.
                         (require 'spyscope.core)]}

 ;;; Composite profiles

 ;; This is an easy way to have a custom subset of the above modular profiles enabled in your
 ;; REPL. To start an awesome REPL use 'lein with-profiles +awesome repl'.
 :awesome [:cider
           :humane
           :inject
           :alembic
           :refresh
           :pretty]

 :user [;; Linters need to be available everywhere.
        :lint

        ;; Prevent the Clojure REPL from showing in the Mac app switcher.
        ;; See http://stackoverflow.com/questions/24619300/hide-clojure-repl-from-command-tab-application-switcher-via-lein-command-line
        {:jvm-opts ["-Dapple.awt.UIElement=true"]}]

 ;; Use humane test output when running 'lein test'.
 :test [:humane]}

{;;; Modular profiles

 :cider {:plugins [;; REPL-side support for CIDER and other editor tools
                   [cider/cider-nrepl "0.13.0"]]}

 :humane {:dependencies [;; Better-formatted clojure.test output
                         [pjstadig/humane-test-output "0.8.0"]]

          :injections [;; Activate better-formatted clojure.test output
                       (require 'pjstadig.humane-test-output)
                       (pjstadig.humane-test-output/activate!)]}

 :inject {:dependencies [;; Inject utility functions into convenient namespaces
                         ;; (by default, the '.' namespace)
                         [im.chit/vinyasa.inject "0.4.7"]]

          :injections [;; The following injections do not incur any additional startup
                       ;; cost -- the clojure.* namespaces are loaded by default when
                       ;; the REPL starts up, and vinyasa.inject is obviously already
                       ;; being loaded because that is the whole point of this profile.
                       ;; So, unlike the other injections, these ones are not split out
                       ;; into different profiles.
                       (require 'vinyasa.inject)
                       (vinyasa.inject/in
                         [clojure.java.shell sh]
                         [clojure.pprint pp pprint]
                         [clojure.repl doc pst source]
                         [vinyasa.inject [in inject]])]}

 ;; BEGIN profiles with optional injections
 ;; Put these *after* the :inject profile if you want the injections.

 :alembic {:dependencies [;; Pull dependencies from Clojars in the REPL,
                          ;; and invoke Leiningen tasks from the REPL
                          [alembic "0.3.2"]]

           :injections [;; Modify the alembic/distill function to work without needing a
                        ;; project.clj file. This is a hack! It works simply by
                        ;; telling alembic not to look for repositories in the project.clj.
                        ;; However, this is a global override, so if you need to use one
                        ;; of the repositories in the project.clj, you must either pass
                        ;; the :repositories key explicitly, or pass the keyword :project
                        ;; to suppress this hack and allow alembic to search project.clj
                        ;; for repositories.
                        (require 'alembic.still)
                        (alter-var-root
                          #'alembic.still/distill
                          (fn [distill]
                            (fn [dependencies & args]
                              (if (= (first args) :project)
                                (apply distill dependencies (rest args))
                                (apply distill dependencies :repositories [] args)))))

                        ;; For some reason, Leiningen tries to resolve every unquoted
                        ;; symbol in the :injections code, even the ones that wouldn't
                        ;; be resolved normally (e.g. the vinyasa.inject/in symbol
                        ;; inside the when form). So to prevent it from choking on the
                        ;; potentially nonexistent symbol inside the when block we have
                        ;; to use this hilariously ridiculous eval hack.
                        (when (resolve 'vinyasa.inject/in)
                          (eval
                            `(~(symbol "vinyasa.inject/in")
                              ~'[alembic.still distill lein])))]}

 :pull {:dependencies [;; Pull dependencies from Clojars in the REPL
                       [im.chit/vinyasa.maven "0.4.7"]]

        :injections [;; See :alembic profile for an explanation of this hack.
                     (when (resolve 'vinyasa.inject/in)
                       (eval
                         `(~(symbol "vinyasa.inject/in")
                           ~'[vinyasa.maven pull])))]}

 :reflection {:dependencies [;; Convenient reflection functions
                             [im.chit/vinyasa.reflection "0.4.7"]]

              :injections [;; See :alembic profile for an explanation of this hack.
                           (when (resolve 'vinyasa.inject/in)
                             (eval
                               `(~(symbol "vinyasa.inject/in")
                                 ~'clojure.core
                                 ~'[vinyasa.reflection .& .> .? .* .% .%>])))]}

 :refresh {:dependencies [;; Properly refresh a dirty namespace
                          [org.clojure/tools.namespace "0.2.11"]]

           :injections [;; See :alembic profile for an explanation of this hack.
                        (when (resolve 'vinyasa.inject/in)
                          (eval
                            `(~(symbol "vinyasa.inject/in")
                              ~'[clojure.tools.namespace.repl refresh])))]}

 ;; END profiles with optional injections

 :lint {:plugins [;; Miscellaneous linting
                  [jonase/eastwood "0.2.3"]

                  ;; Check for outdated dependencies and plugins
                  [lein-ancient "0.6.10"]

                  ;; Basic linting
                  [lein-bikeshed "0.3.0"]

                  ;; Style linting
                  [lein-cljfmt "0.5.3"]

                  ;; Miscellaneous linting
                  [lein-kibit "0.1.2"]

                  ;; Check for unused functions
                  [venantius/yagni "0.1.4"]]}

 :pretty {:dependencies [;; Pretty stack traces
                         [io.aviso/pretty "0.1.29"]]

          :injections [;; Use pretty stack traces for pst. CIDER has even better stack trace
                       ;; functionality by default, so we won't make the REPL print a full
                       ;; stack trace on encountering an exception. (This would be done by
                       ;; overriding clojure.main/repl-caught.)
                       (require 'clojure.repl 'io.aviso.repl)
                       (alter-var-root
                         #'clojure.repl/pst
                         (constantly (fn [& args]
                                       ;; This prevents a NPE when no exception has yet
                                       ;; occurred.
                                       (when *e
                                         (apply io.aviso.repl/pretty-pst args)))))]}

 :refactor {:plugins [;; REPL-side support for clj-refactor
                      [refactor-nrepl "2.2.0"]]}

 :spyscope {:dependencies [;; Quick-and-dirty debugging tools
                           [spyscope "0.1.5"]]

            :injections [;; Make the spyscope reader macros available.
                         (require 'spyscope.core)]}

 ;;; Composite profiles

 ;; This is an easy way to have a custom subset of the above modular profiles enabled in your
 ;; REPL. To start an awesome REPL use 'lein with-profiles +awesome repl'.
 :awesome [:cider
           :humane
           :inject
           :alembic
           :refresh
           :pretty]

 :user [;; Linters need to be available everywhere.
        :lint

        ;; Prevent the Clojure REPL from showing in the Mac app switcher.
        ;; See http://stackoverflow.com/questions/24619300/hide-clojure-repl-from-command-tab-application-switcher-via-lein-command-line
        {:jvm-opts ["-Dapple.awt.UIElement=true"]}]

 ;; Use humane test output when running 'lein test'.
 :test [:humane]}

Fix formatting of comment in profiles.clj


(ns ^{:clojure.tools.namespace.repl/load false} R
  (:refer-clojure :exclude [find-ns])
  (:require
    [clojure.pprint]
    [clojure.tools.namespace.find :as ns.find]
    [clojure.tools.namespace.repl :as ns.repl]
    [kaocha.repl]
    [clojure.string :as str])
  (:import
    (java.io
      File)))

(ns.repl/disable-reload! *ns*)

(defn pp
  [thing]
  (clojure.pprint/pprint thing)
  thing)

(defn help [& _n]
  (println (str ">>> in ns " 'R))
  (mapv (fn [[_k v]]
          (println v)) (ns-publics 'R))
  ::ok)

(defn init! []
  (ns.repl/disable-reload! *ns*)
  (ns.repl/set-refresh-dirs "src" "test")
  (help))

(defn list-ns
  "Return list of symbols of namespaces found in src dir"
  ([root]
   (ns.find/find-namespaces-in-dir (File. root)))
  ([]
   (list-ns "./src/")))

(defn find-ns
  "Find namespace vars by a regex"
  [re]
  (vec (filter #(re-find re (str %)) (list-ns))))

(defn find-test-ns
  "Find test namespace vars by a regex"
  [pattern]
  (let [re (cond
             (string? pattern) (re-pattern pattern)
             (= java.util.regex.Pattern (class pattern)) pattern
             :else (throw (ex-info "this is not a patternable thing" {:pattern pattern})))]
  (vec (filter #(re-find re (str %)) (list-ns "./test/")))))

(def system-status (atom {}))

(defn safe-to-refresh? []
  (or (empty? @system-status)
      (= #{false} (-> @system-status vals set))))

(defn  refresh
  "Refresh changed namespaces"
  []
  (if (safe-to-refresh?)
    (ns.repl/refresh)
    ::system-running!))

(defn refresh-all
  "Refresh everything"
  []
  (if (safe-to-refresh?)
    (ns.repl/refresh-all)
    ::system-running!))

(defn start-system!
  "Given a namespace, usually some-service, do the following:
  - find some-service.user namespace (by convention)
  - refresh
  - require the user ns e.g. some-service.user
  - start  system, invoking somer-service.user/start
  Warning: best if the system is not running, or things will go south

  Example: (R/start-system! 'foo.user)"
  ([]
   ;; automagically guess the <app>.user namespace
   (let [an-ns (-> *ns*
                   str
                   (str/replace #"\..+" ".user")
                   symbol)]
     (require an-ns)
     (start-system! an-ns)))
  ([an-ns]
     (printf "!! Starting %s\n" an-ns)
     (if (get @system-status an-ns)
       (println "!! System possibly running" an-ns)
       (do
         (println "!! Refreshing and reloading " an-ns)
         (remove-ns an-ns)
         (refresh)
         (require [an-ns] :reload)
         (if-let [f (ns-resolve an-ns 'start)]
           (do
             (f)
             (swap! system-status (fn [s] (assoc s an-ns true)))))))))

(defn stop-system!
  "Given a namespace, usually some-service.user, stop the system. If not passed, stops currently running system"
  ([]
   (stop-system! (first (keys @system-status))))
  ([an-ns]
   (let [f (ns-resolve an-ns 'stop)]
     (f)
     (swap! system-status (fn [s] (assoc s an-ns false))))))

(defn sys
  "Pull out the system for passing around"
  []
  (var-get (ns-resolve (first (keys @system-status)) 'SYS)))

(defn c
  "Pul out a compont from a running system"
  [component-name]
  (let [sys (sys)]
    (get sys component-name)))

(defn t
  "Run tests via kaocha - either all or a list of vars"
  ([]
   (kaocha.repl/run :unit {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))
  ([ns-list]
   (apply kaocha.repl/run (conj ns-list {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))))

(defn t!
  "Run tests via kaocha, but refresh first - runs all tests or a list of vars"
  ([]
   (refresh)
   (kaocha.repl/run :unit {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))
  ([ns-list]
   (refresh)
   (apply kaocha.repl/run (conj ns-list {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))))

(defn clear-aliases
  "Reset aliases for given ns or current if no args given"
  ([]
  (clear-aliases *ns*))
  (
  [an-ns]
  (mapv #(ns-unalias an-ns %) (keys (ns-aliases an-ns)))))

(init!)

(ns ^{:clojure.tools.namespace.repl/load false} R
  (:refer-clojure :exclude [find-ns])
  (:require
    [clojure.pprint]
    [clojure.tools.namespace.find :as ns.find]
    [clojure.tools.namespace.repl :as ns.repl]
    [kaocha.repl]
    [clojure.string :as str])
  (:import
    (java.io
      File)))

(ns.repl/disable-reload! *ns*)

(defn pp
  [thing]
  (clojure.pprint/pprint thing)
  thing)

(defn help [& _n]
  (println (str ">>> in ns " 'R))
  (mapv (fn [[_k v]]
          (println v)) (ns-publics 'R))
  ::ok)

(defn init! []
  (ns.repl/disable-reload! *ns*)
  (ns.repl/set-refresh-dirs "src" "test")
  (help))

(defn list-ns
  "Return list of symbols of namespaces found in src dir"
  ([root]
   (ns.find/find-namespaces-in-dir (File. root)))
  ([]
   (list-ns "./src/")))

(defn find-ns
  "Find namespace vars by a regex"
  [re]
  (let [nss (vec (filter #(re-find re (str %)) (list-ns)))]
    (printf "found %s ns\n" (count nss))
    nss
    ))

(defn find-test-ns
  "Find test namespace vars by a regex"
  [pattern]
  (let [re (cond
             (string? pattern) (re-pattern pattern)
             (= java.util.regex.Pattern (class pattern)) pattern
             :else (throw (ex-info "this is not a patternable thing" {:pattern pattern})))
        nss (vec (filter #(re-find re (str %)) (list-ns "./test/")))]
    (printf "found %s nss\n" (count nss))
    nss))

(def system-status (atom {}))

(defn safe-to-refresh? []
  (or (empty? @system-status)
      (= #{false} (-> @system-status vals set))))

(defn  refresh
  "Refresh changed namespaces"
  []
  (if (safe-to-refresh?)
    (ns.repl/refresh)
    ::system-running!))

(defn refresh-all
  "Refresh everything"
  []
  (if (safe-to-refresh?)
    (ns.repl/refresh-all)
    ::system-running!))

(defn start-system!
  "Given a namespace, usually some-service, do the following:
  - find some-service.user namespace (by convention)
  - refresh
  - require the user ns e.g. some-service.user
  - start  system, invoking somer-service.user/start
  Warning: best if the system is not running, or things will go south

  Example: (R/start-system! 'foo.user)"
  ([]
   ;; automagically guess the <app>.user namespace
   (let [an-ns (-> *ns*
                   str
                   (str/replace #"\..+" ".user")
                   symbol)]
     (require an-ns)
     (start-system! an-ns)))
  ([an-ns]
     (printf "!! Starting %s\n" an-ns)
     (if (get @system-status an-ns)
       (println "!! System possibly running" an-ns)
       (do
         (println "!! Refreshing and reloading " an-ns)
         (remove-ns an-ns)
         (refresh)
         (require [an-ns] :reload)
         (if-let [f (ns-resolve an-ns 'start)]
           (do
             (f)
             (swap! system-status (fn [s] (assoc s an-ns true)))))))))

(defn stop-system!
  "Given a namespace, usually some-service.user, stop the system. If not passed, stops currently running system"
  ([]
   (stop-system! (first (keys @system-status))))
  ([an-ns]
   (let [f (ns-resolve an-ns 'stop)]
     (f)
     (swap! system-status (fn [s] (assoc s an-ns false))))))

(defn sys
  "Pull out the system for passing around"
  []
  (var-get (ns-resolve (first (keys @system-status)) 'SYS)))

(defn c
  "Pul out a compont from a running system"
  [component-name]
  (let [sys (sys)]
    (get sys component-name)))

(defn t
  "Run tests via kaocha - either all or a list of vars"
  ([]
   (kaocha.repl/run :unit {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))
  ([ns-list]
   (apply kaocha.repl/run (conj ns-list {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))))

(defn t!
  "Run tests via kaocha, but refresh first - runs all tests or a list of vars"
  ([]
   (refresh)
   (kaocha.repl/run :unit {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))
  ([ns-list]
   (refresh)
   (apply kaocha.repl/run (conj ns-list {:config "/home/ubuntu/.emacs.d/etc/kaocha.edn"}))))

(defn clear-aliases
  "Reset aliases for given ns or current if no args given"
  ([]
  (clear-aliases *ns*))
  (
  [an-ns]
  (mapv #(ns-unalias an-ns %) (keys (ns-aliases an-ns)))))

(init!)

print number of found namespaces

print number of found namespaces


;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors. The use
;;   and distribution terms for this software are covered by the
;;   Eclipse Public License 1.0
;;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
;;   found in the file epl-v10.html at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be
;;   bound by the terms of this license.  You must not remove this
;;   notice, or any other, from this software.

(ns oxcart.pattern
  {:doc "Implements a number of pattern matching predicates and utility
        functions over the clojure.tools.analyzer.jvm AST structure."
   :added "0.0.1"
   :author "Reid McKenzie"}
  (:refer-clojure :exclude [fn?]))

;; TODO:
;;  Depending on benchmarking and API changes it may make sense to
;;  make core.match a dependency of this project rather than hard
;;  coding datastructure dependant paths and equality checks.

(defn def?
  "λ AST -> Boolean

  Indicates whether the top level form of the argument AST is a def form."
  [ast]
  (-> ast
      :op
      (= :def)))

(defn def->symbol
  "λ AST -> (Option Symbol)

  If the argument form was a def, returns the defined
  symbol. Otherwise the return value is garbage."
  [ast]
  (when (def? ast)
    (:name ast)))

(defn fn?
  "λ AST → Boolean

  Indicates whether the top level form of the argument AST is a fn."
  [ast]
  (-> ast :op (= :fn)))

(defn fn-method?
  "λ AST → Boolean

  Indicates whether the argument form is a fn-method."

  [ast]
  (-> ast :op (= :fn-method)))

(defn let?
  "λ AST → Boolean

  Indicates whether the argument form is a let."
  [ast]
  (-> ast :op (= :let)))

(defn binding?
  "λ AST → Boolean

  Indicates whether the argument form is a binding node."
  [ast]
  (-> ast :op (= :binding)))

(defn local?
  "λ AST → Boolean

  Indicates whether the argument form is a local node."
  [ast]
  (-> ast :op (= :local)))

(defn local->symbol
  "λ AST → (Option symbol)

  If the argument AST was a local node, then this operation returns
  the name field otherwise nil."
  [ast]
  (when (local? ast)
    (:name ast)))

(defn binding->symbol
  "λ AST → (Option Symbol)

  If the argument form was a binding, returns the bound local
  symbol."
  [ast]
  (when (binding? ast)
    (-> ast :name)))

(defn binding->value
  "λ AST → (Option AST)

  If the argument form was a binding, returns the bound value as an
  AST node."
  [ast]
  (when (binding? ast)
    (-> ast :init)))

(defn invoke?
  "λ AST → Boolean

  Indicates whether the argument top level form is an invocation."
  [ast]
  (-> ast :op (= :invoke)))

(defn invoke->fn
  "λ AST → (Option AST)

  If the argument AST was an invocation, returns the AST representing
  the invoked value."
  [ast]
  (when (invoke? ast)
    (-> ast :fn)))

(defn private?
  "λ AST → bool

  Indicates whether the AST node passed as an argument is flagged as
  private. Definitions may be public or private, all other
  values (constant expressions, function applications and soforth) are
  defined to be private."
  [form]
  (let [status (-> form :meta :form :private)]
    (if (def? form)
      (true? status)
      true)))

(defn public?
  "λ AST → bool

  Indicates whether the AST node passed as the first argument is
  flagged as public. Definitions are public by default unless marked
  private. All other values (constant expressions, function
  applications and soforth) are defined to be private."
  [form]
  (-> form private? not))

(defn dynamic?
  "λ AST → bool

  Indicates whether the AST node passed as the argument is flagged as
  dynamic. Dynamic status is not currently conditional on being a
  definition, however this behavior is subject to change."
  [form]
  (-> form :meta :form :dynamic true?))

(defn const?
  "λ AST → bool

  Indicates whether the AST node passed as the argument is flagged as
  const. If the node is both const and dynamic, it is not const. An
  error may be issued if this is ever the case as it represents a
  contradiction in terms."
  [form]
  (case (-> form :meta :form :const)
    (true nil) (not (dynamic? form))
    :else      false))

;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors. The use
;;   and distribution terms for this software are covered by the
;;   Eclipse Public License 1.0
;;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
;;   found in the file epl-v10.html at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be
;;   bound by the terms of this license.  You must not remove this
;;   notice, or any other, from this software.

(ns oxcart.pattern
  {:doc "Implements a number of pattern matching predicates and utility
        functions over the clojure.tools.analyzer.jvm AST structure."
   :added "0.0.1"
   :author "Reid McKenzie"}
  (:refer-clojure :exclude [fn?]))

;; TODO:
;;  Depending on benchmarking and API changes it may make sense to
;;  make core.match a dependency of this project rather than hard
;;  coding datastructure dependant paths and equality checks.

(defn def?
  "λ AST -> Boolean

  Indicates whether the top level form of the argument AST is a def form."
  [ast]
  (-> ast
      :op
      (= :def)))

(defn def->symbol
  "λ AST -> (Option Symbol)

  If the argument form was a def, returns the defined
  symbol. Otherwise the return value is garbage."
  [ast]
  (when (def? ast)
    (:name ast)))

(defn top-level?
  "λ AST → Boolean

  Indicates whether the argument AST is a top level form."
  [ast]
  (:top-level ast))

(defn fn?
  "λ AST → Boolean

  Indicates whether the top level form of the argument AST is a fn."
  [ast]
  (-> ast :op (= :fn)))

(defn fn-method?
  "λ AST → Boolean

  Indicates whether the argument form is a fn-method."

  [ast]
  (-> ast :op (= :fn-method)))

(defn let?
  "λ AST → Boolean

  Indicates whether the argument form is a let."
  [ast]
  (-> ast :op (= :let)))

(defn binding?
  "λ AST → Boolean

  Indicates whether the argument form is a binding node."
  [ast]
  (-> ast :op (= :binding)))

(defn local?
  "λ AST → Boolean

  Indicates whether the argument form is a local node."
  [ast]
  (-> ast :op (= :local)))

(defn local->symbol
  "λ AST → (Option symbol)

  If the argument AST was a local node, then this operation returns
  the name field otherwise nil."
  [ast]
  (when (local? ast)
    (:name ast)))

(defn binding->symbol
  "λ AST → (Option Symbol)

  If the argument form was a binding, returns the bound local
  symbol."
  [ast]
  (when (binding? ast)
    (-> ast :name)))

(defn binding->value
  "λ AST → (Option AST)

  If the argument form was a binding, returns the bound value as an
  AST node."
  [ast]
  (when (binding? ast)
    (-> ast :init)))

(defn invoke?
  "λ AST → Boolean

  Indicates whether the argument top level form is an invocation."
  [ast]
  (-> ast :op (= :invoke)))

(defn invoke->fn
  "λ AST → (Option AST)

  If the argument AST was an invocation, returns the AST representing
  the invoked value."
  [ast]
  (when (invoke? ast)
    (-> ast :fn)))

(defn private?
  "λ AST → bool

  Indicates whether the AST node passed as an argument is flagged as
  private. Definitions may be public or private, all other
  values (constant expressions, function applications and soforth) are
  defined to be private."
  [form]
  (let [status (-> form :meta :form :private)]
    (if (def? form)
      (true? status)
      true)))

(defn public?
  "λ AST → bool

  Indicates whether the AST node passed as the first argument is
  flagged as public. Definitions are public by default unless marked
  private. All other values (constant expressions, function
  applications and soforth) are defined to be private."
  [form]
  (-> form private? not))

(defn dynamic?
  "λ AST → bool

  Indicates whether the AST node passed as the argument is flagged as
  dynamic. Dynamic status is not currently conditional on being a
  definition, however this behavior is subject to change."
  [form]
  (-> form :meta :form :dynamic true?))

(defn const?
  "λ AST → bool

  Indicates whether the AST node passed as the argument is flagged as
  const. If the node is both const and dynamic, it is not const. An
  error may be issued if this is ever the case as it represents a
  contradiction in terms."
  [form]
  (case (-> form :meta :form :const)
    (true nil) (not (dynamic? form))
    :else      false))

Create top-level? pattern

Create top-level? pattern