(ns selmer.parser
  " Parsing and handling of compile-time vs.
  run-time. Avoiding unnecessary work by pre-processing
  the template structure and content and reacting to
  the runtime context map with a prepared data structure
  instead of a raw template. Anything other than a raw tag
  value injection is a runtime dispatch fn. Compile-time here
  means the first time we see a template *at runtime*, not the
  implementation's compile-time. "
  (:require [selmer.template-parser :refer [preprocess-template]]
            [selmer.filters :refer [filters]]
            [selmer.filter-parser :refer [compile-filter-body]]
            [selmer.tags :refer :all]
            [selmer.util :refer :all]
            [selmer.validator :refer [validation-error]]
            selmer.node)
  (:import [selmer.node INode TextNode FunctionNode]))

;; Ahead decl because some fns call into each other.

(declare parse parse-input parse-file tag-content)

;; Memoization atom for templates. If you pass a filepath instead
;; of a string, we'll use the last-modified timestamp to cache the
;; template. Works fine for active local development and production.

(defonce templates (atom {}))

;; Can be overridden by closure/argument 'cache
(defonce cache? (atom true))

(defn cache-on! []
  (reset! cache? true))

(defn cache-off! []
  (reset! cache? false))

(defn- append-slash
  "append '/' to the given string unless it already ends with a slash"
  [^String s]
  (if (or (nil? s)
          (.endsWith s "/"))
    s
    (str s "/")))

(defn- make-resource-path
  [path]
  (cond
    (nil? path)
      nil
    (instance? java.net.URL path)
      (append-slash (str path))
    :else
      (append-slash
       (try
         (str (java.net.URL. path))
         (catch java.net.MalformedURLException err
           (str "file:///" path))))))

(defn set-resource-path!
  "set custom location, where templates are being searched for. path
  may be a java.net.URL instance or a string. If it's a string, we
  first try to convert it to a java.net.URL instance and if it doesn't
  work it's interpreted as a path in the local filesystem."
  [path]
  (set-custom-resource-path! (make-resource-path path)))

(defn update-tag [tag-map tag tags]
  (assoc tag-map tag (concat (get tag-map tag) tags)))

(defn set-closing-tags! [& tags]
  (loop [[tag & tags] tags]
    (when tag
      (swap! selmer.tags/closing-tags update-tag tag tags)
      (recur tags))))

;; add-tag! is a hella nifty macro. Example use:
;; (add-tag! :joined (fn [args context-map] (clojure.string/join "," args)))
(defmacro add-tag!
  " tag name, fn handler, and maybe tags "
  [k handler & tags]
  `(do
     (set-closing-tags! ~k ~@tags)
     (swap! selmer.tags/expr-tags assoc ~k (tag-handler ~handler ~k ~@tags))))

(defn remove-tag!
  [k]
  (swap! expr-tags dissoc k)
  (swap! closing-tags dissoc k))

;; render-template renders at runtime, accepts
;; post-parsing vectors of INode elements.

(defn render-template [template context-map]
  " vector of ^selmer.node.INodes and a context map."
  (let [buf (StringBuilder.)]
    (doseq [^selmer.node.INode element template]
        (if-let [value (.render-node element context-map)]
          (.append buf value)
          (.append buf (*missing-value-formatter* (:tag (meta element)) context-map))))
    (.toString buf)))

(defn render [s context-map & [opts]]
  " render takes the string, the context-map and possibly also opts. "
  (render-template (parse parse-input (java.io.StringReader. s) opts) context-map))

;; Primary fn you interact with as a user, you pass a path that
;; exists somewhere in your class-path, typically something like
;; resources/templates/template_name.html. You also pass a context
;; map and potentially opts. Smart (last-modified timestamp)
;; auto-memoization of compiler output.

(defn render-file [filename context-map & [{:keys [cache custom-resource-path]
                                            :or  {cache @cache?
                                                  custom-resource-path *custom-resource-path*}
                                            :as opts}]]
  " Parses files if there isn't a memoized post-parse vector ready to go,
  renders post-parse vector with passed context-map regardless. Double-checks
  last-modified on files. Uses classpath for filename path "
  (binding [*custom-resource-path* custom-resource-path]
    (if-let [resource (resource-path filename)]
      (let [{:keys [template last-modified]} (get @templates resource)
            ;;for some resources, such as ones inside a jar, it's
            ;;not possible to check the last modified timestamp
            last-modified-time (if (or (nil? last-modified) (pos? last-modified))
                                 (resource-last-modified resource) -1)]
        (check-template-exists resource)
        (if (and cache last-modified (= last-modified last-modified-time))
          (render-template template context-map)
          (let [template (parse parse-file filename opts)]
            (swap! templates assoc resource {:template template
                                             :last-modified last-modified-time})
            (render-template template context-map))))
      (validation-error
       (str "resource-path for " filename " returned nil, typically means the file doesn't exist in your classpath.")
       nil nil nil))))

;; For a given tag, get the fn handler for the tag type,
;; pass it the arguments, tag-content, render-template fn,
;; and reader.

(defn expr-tag [{:keys [tag-name args] :as tag} rdr]
  (if-let [handler (tag-name @expr-tags)]
    (handler args tag-content render-template rdr)
    (exception "unrecognized tag: " tag-name " - did you forget to close a tag?")))

;; Same as a vanilla data tag with a value, but composes
;; the filter fns. Like, {{ data-var | upper | safe }}
;; (-> {:data-var "woohoo"} upper safe) => "WOOHOO"
;; Happens at compile-time.

(defn filter-tag [{:keys [tag-value]}]
  " Compile-time parser of var tag filters. "
  (compile-filter-body tag-value))

;; Generally either a filter tag, if tag, ifequal,
;; or for. filter-tags are conflated with vanilla tag

(defn parse-tag [{:keys [tag-type] :as tag} rdr]
  (with-meta
    (if (= :filter tag-type)
      (filter-tag tag)
      (expr-tag tag rdr))
    {:tag tag}))

;; Parses and detects tags which turn into
;; FunctionNode call-sites or TextNode content. open-tag? fn returns
;; true or false based on character lookahead to see if it's {{ or {%

(defn append-node [content tag ^StringBuilder buf rdr]
  (-> content
    (conj (TextNode. (.toString buf)))
    (conj (FunctionNode. (parse-tag tag rdr)))))

(defn update-tags [tag tags content args ^StringBuilder buf]
  (assoc tags tag
         {:args args
          :content (conj content (TextNode. (.toString buf)))}))

(defn tag-content [rdr start-tag & end-tags]
  (let [buf (StringBuilder.)]
    (loop [ch       (read-char rdr)
           tags     {}
           content  []
           cur-tag  start-tag
           end-tags end-tags]
      (cond
        (and (nil? ch) (not-empty end-tags))
        (exception "No closing tag found for " start-tag)
        (nil? ch)
        tags
        (open-tag? ch rdr)
        (let [{:keys [tag-name args] :as tag} (read-tag-info rdr)]
          (if-let [open-tag  (and tag-name (some #{tag-name} end-tags))]
              (let [tags     (update-tags cur-tag tags content args buf)
                    end-tags (next (drop-while #(not= tag-name %) end-tags))]
                (.setLength buf 0)
                (recur (when-not (empty? end-tags) (read-char rdr)) tags [] open-tag end-tags))
              (let [content (append-node content tag buf rdr)]
                (.setLength buf 0)
                (recur (read-char rdr) tags content cur-tag end-tags))))
        :else
        (do
          (.append buf ch)
          (recur (read-char rdr) tags content cur-tag end-tags))))))

(defn skip-short-comment-tag [template rdr]
  (loop [ch1 (read-char rdr)
         ch2 (read-char rdr)]
    (cond
      (nil? ch2)
      (exception "short-form comment tag was not closed")
      (and (= *short-comment-second* ch1) (= *tag-close* ch2))
      template
      :else (recur ch2 (read-char rdr)))))

;; Compile-time parsing of tags. Accumulates a transient vector
;; before returning the persistent vector of INodes (TextNode, FunctionNode)

(defn add-node [template buf rdr]
  (let [template (if-let [text (not-empty (.toString ^StringBuilder buf))]
                   (conj! template (TextNode. text))
                   template)]
    (.setLength ^StringBuilder buf 0)
    (conj! template (FunctionNode. (parse-tag (read-tag-info rdr) rdr)))))

(defn parse* [input]
  (with-open [rdr (clojure.java.io/reader input)]
      (let [buf      (StringBuilder.)]
        (loop [template (transient [])
               ch (read-char rdr)]
          (if ch
            (cond
              ;; We hit a tag so we append the buffer content to the template
              ;; and empty the buffer, then we proceed to parse the tag
              (and (open-tag? ch rdr) (some #{(peek-rdr rdr)} [*tag-second* *filter-open*]))
              (recur (add-node template buf rdr) (read-char rdr))

              ;; Short comment tags are dropped
              (open-short-comment? ch rdr)
              (recur (skip-short-comment-tag template rdr) (read-char rdr))

              ;; Default case, here we append the character and
              ;; read the next char
              :else
              (do
                (.append buf ch)
                (recur template (read-char rdr))))

            ;; Add the leftover content of the buffer and return the template
            (->> buf (.toString) (TextNode.) (conj! template) persistent!))))))

;; Primary compile-time parse routine. Work we don't want happening after
;; first template render. Vector output from parse* gets memoized by render-file.

(defn parse-input [input & [{:keys [custom-tags custom-filters]}]]
  (swap! expr-tags merge custom-tags)
  (swap! filters merge custom-filters)
  (parse* input))

;; File-aware parse wrapper.

(defn parse-file [file params]
  (-> file preprocess-template (java.io.StringReader.) (parse-input params)))

(defn parse [parse-fn input & [{:keys [tag-open tag-close filter-open filter-close tag-second short-comment-second]
                                :or   {tag-open             *tag-open*
                                       tag-close            *tag-close*
                                       filter-open          *filter-open*
                                       filter-close         *filter-close*
                                       tag-second           *tag-second*
                                       short-comment-second *short-comment-second*}
                                :as   params}]]
  (binding [*tag-open*             tag-open
            *tag-close*            tag-close
            *filter-open*          filter-open
            *filter-close*         filter-close
            *tag-second*           tag-second
            *short-comment-second* short-comment-second
            *tag-second-pattern*   (pattern tag-second)
            *filter-open-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*")
            *filter-close-pattern* (pattern "\\s*\\" filter-close "\\" tag-close)
            *filter-pattern*       (pattern "\\" tag-open "\\" filter-open "\\s*.*\\s*\\" filter-close "\\" tag-close)
            *tag-open-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*")
            *tag-close-pattern*    (pattern "\\s*\\" tag-second "\\"  tag-close)
            *tag-pattern*          (pattern "\\" tag-open "\\" tag-second "\\s*.*\\s*\\" tag-second "\\" tag-close)
            *include-pattern*      (pattern "\\" tag-open "\\" tag-second "\\s*include.*")
            *extends-pattern*      (pattern "\\" tag-open "\\" tag-second "\\s*extends.*")
            *block-pattern*        (pattern "\\" tag-open "\\" tag-second "\\s*block.*")
            *block-super-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*block.super\\s*\\" filter-close "\\" tag-close)
            *endblock-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*endblock.*")]
    (parse-fn input params)))

(ns selmer.parser
  " Parsing and handling of compile-time vs.
  run-time. Avoiding unnecessary work by pre-processing
  the template structure and content and reacting to
  the runtime context map with a prepared data structure
  instead of a raw template. Anything other than a raw tag
  value injection is a runtime dispatch fn. Compile-time here
  means the first time we see a template *at runtime*, not the
  implementation's compile-time. "
  (:require [selmer.template-parser :refer [preprocess-template]]
            [selmer.filters :refer [filters]]
            [selmer.filter-parser :refer [compile-filter-body]]
            [selmer.tags :refer :all]
            [selmer.util :refer :all]
            [selmer.validator :refer [validation-error]]
            selmer.node)
  (:import [selmer.node INode TextNode FunctionNode]))

;; Ahead decl because some fns call into each other.

(declare parse parse-input parse-file tag-content)

;; Memoization atom for templates. If you pass a filepath instead
;; of a string, we'll use the last-modified timestamp to cache the
;; template. Works fine for active local development and production.

(defonce templates (atom {}))

;; Can be overridden by closure/argument 'cache
(defonce cache? (atom true))

(defn cache-on! []
  (reset! cache? true))

(defn cache-off! []
  (reset! cache? false))

(defn- append-slash
  "append '/' to the given string unless it already ends with a slash"
  [^String s]
  (if (or (nil? s)
          (.endsWith s "/"))
    s
    (str s "/")))

(defn- make-resource-path
  [path]
  (cond
    (nil? path)
      nil
    (instance? java.net.URL path)
      (append-slash (str path))
    :else
      (append-slash
       (try
         (str (java.net.URL. path))
         (catch java.net.MalformedURLException err
           (str "file:///" path))))))

(defn set-resource-path!
  "set custom location, where templates are being searched for. path
  may be a java.net.URL instance or a string. If it's a string, we
  first try to convert it to a java.net.URL instance and if it doesn't
  work it's interpreted as a path in the local filesystem."
  [path]
  (set-custom-resource-path! (make-resource-path path)))

(defn update-tag [tag-map tag tags]
  (assoc tag-map tag (concat (get tag-map tag) tags)))

(defn set-closing-tags! [& tags]
  (loop [[tag & tags] tags]
    (when tag
      (swap! selmer.tags/closing-tags update-tag tag tags)
      (recur tags))))

;; add-tag! is a hella nifty macro. Example use:
;; (add-tag! :joined (fn [args context-map] (clojure.string/join "," args)))
(defmacro add-tag!
  " tag name, fn handler, and maybe tags "
  [k handler & tags]
  `(do
     (set-closing-tags! ~k ~@tags)
     (swap! selmer.tags/expr-tags assoc ~k (tag-handler ~handler ~k ~@tags))))

(defn remove-tag!
  [k]
  (swap! expr-tags dissoc k)
  (swap! closing-tags dissoc k))

;; render-template renders at runtime, accepts
;; post-parsing vectors of INode elements.

(defn render-template [template context-map]
  " vector of ^selmer.node.INodes and a context map."
  (let [buf (StringBuilder.)]
    (doseq [^selmer.node.INode element template]
        (if-let [value (.render-node element context-map)]
          (.append buf value)
          (.append buf (*missing-value-formatter* (:tag (meta element)) context-map))))
    (.toString buf)))

(defn render [s context-map & [opts]]
  " render takes the string, the context-map and possibly also opts. "
  (render-template (parse parse-input (java.io.StringReader. s) opts) context-map))

;; Primary fn you interact with as a user, you pass a path that
;; exists somewhere in your class-path, typically something like
;; resources/templates/template_name.html. You also pass a context
;; map and potentially opts. Smart (last-modified timestamp)
;; auto-memoization of compiler output.

(defn render-file [filename-or-URL context-map & [{:keys [cache custom-resource-path]
                                            :or  {cache @cache?
                                                  custom-resource-path *custom-resource-path*}
                                            :as opts}]]
  " Parses files if there isn't a memoized post-parse vector ready to go,
  renders post-parse vector with passed context-map regardless. Double-checks
  last-modified on files. Uses classpath for filename-or-URL path "
  (binding [*custom-resource-path* custom-resource-path]
    (if-let [resource (resource-path filename-or-URL)]
      (let [{:keys [template last-modified]} (get @templates resource)
            ;;for some resources, such as ones inside a jar, it's
            ;;not possible to check the last modified timestamp
            last-modified-time (if (or (nil? last-modified) (pos? last-modified))
                                 (resource-last-modified resource) -1)]
        (check-template-exists resource)
        (if (and cache last-modified (= last-modified last-modified-time))
          (render-template template context-map)
          (let [template (parse parse-file filename-or-URL opts)]
            (swap! templates assoc resource {:template template
                                             :last-modified last-modified-time})
            (render-template template context-map))))
      (validation-error
       (str "resource-path for " filename-or-URL " returned nil, typically means the file doesn't exist in your classpath.")
       nil nil nil))))

;; For a given tag, get the fn handler for the tag type,
;; pass it the arguments, tag-content, render-template fn,
;; and reader.

(defn expr-tag [{:keys [tag-name args] :as tag} rdr]
  (if-let [handler (tag-name @expr-tags)]
    (handler args tag-content render-template rdr)
    (exception "unrecognized tag: " tag-name " - did you forget to close a tag?")))

;; Same as a vanilla data tag with a value, but composes
;; the filter fns. Like, {{ data-var | upper | safe }}
;; (-> {:data-var "woohoo"} upper safe) => "WOOHOO"
;; Happens at compile-time.

(defn filter-tag [{:keys [tag-value]}]
  " Compile-time parser of var tag filters. "
  (compile-filter-body tag-value))

;; Generally either a filter tag, if tag, ifequal,
;; or for. filter-tags are conflated with vanilla tag

(defn parse-tag [{:keys [tag-type] :as tag} rdr]
  (with-meta
    (if (= :filter tag-type)
      (filter-tag tag)
      (expr-tag tag rdr))
    {:tag tag}))

;; Parses and detects tags which turn into
;; FunctionNode call-sites or TextNode content. open-tag? fn returns
;; true or false based on character lookahead to see if it's {{ or {%

(defn append-node [content tag ^StringBuilder buf rdr]
  (-> content
    (conj (TextNode. (.toString buf)))
    (conj (FunctionNode. (parse-tag tag rdr)))))

(defn update-tags [tag tags content args ^StringBuilder buf]
  (assoc tags tag
         {:args args
          :content (conj content (TextNode. (.toString buf)))}))

(defn tag-content [rdr start-tag & end-tags]
  (let [buf (StringBuilder.)]
    (loop [ch       (read-char rdr)
           tags     {}
           content  []
           cur-tag  start-tag
           end-tags end-tags]
      (cond
        (and (nil? ch) (not-empty end-tags))
        (exception "No closing tag found for " start-tag)
        (nil? ch)
        tags
        (open-tag? ch rdr)
        (let [{:keys [tag-name args] :as tag} (read-tag-info rdr)]
          (if-let [open-tag  (and tag-name (some #{tag-name} end-tags))]
              (let [tags     (update-tags cur-tag tags content args buf)
                    end-tags (next (drop-while #(not= tag-name %) end-tags))]
                (.setLength buf 0)
                (recur (when-not (empty? end-tags) (read-char rdr)) tags [] open-tag end-tags))
              (let [content (append-node content tag buf rdr)]
                (.setLength buf 0)
                (recur (read-char rdr) tags content cur-tag end-tags))))
        :else
        (do
          (.append buf ch)
          (recur (read-char rdr) tags content cur-tag end-tags))))))

(defn skip-short-comment-tag [template rdr]
  (loop [ch1 (read-char rdr)
         ch2 (read-char rdr)]
    (cond
      (nil? ch2)
      (exception "short-form comment tag was not closed")
      (and (= *short-comment-second* ch1) (= *tag-close* ch2))
      template
      :else (recur ch2 (read-char rdr)))))

;; Compile-time parsing of tags. Accumulates a transient vector
;; before returning the persistent vector of INodes (TextNode, FunctionNode)

(defn add-node [template buf rdr]
  (let [template (if-let [text (not-empty (.toString ^StringBuilder buf))]
                   (conj! template (TextNode. text))
                   template)]
    (.setLength ^StringBuilder buf 0)
    (conj! template (FunctionNode. (parse-tag (read-tag-info rdr) rdr)))))

(defn parse* [input]
  (with-open [rdr (clojure.java.io/reader input)]
      (let [buf      (StringBuilder.)]
        (loop [template (transient [])
               ch (read-char rdr)]
          (if ch
            (cond
              ;; We hit a tag so we append the buffer content to the template
              ;; and empty the buffer, then we proceed to parse the tag
              (and (open-tag? ch rdr) (some #{(peek-rdr rdr)} [*tag-second* *filter-open*]))
              (recur (add-node template buf rdr) (read-char rdr))

              ;; Short comment tags are dropped
              (open-short-comment? ch rdr)
              (recur (skip-short-comment-tag template rdr) (read-char rdr))

              ;; Default case, here we append the character and
              ;; read the next char
              :else
              (do
                (.append buf ch)
                (recur template (read-char rdr))))

            ;; Add the leftover content of the buffer and return the template
            (->> buf (.toString) (TextNode.) (conj! template) persistent!))))))

;; Primary compile-time parse routine. Work we don't want happening after
;; first template render. Vector output from parse* gets memoized by render-file.

(defn parse-input [input & [{:keys [custom-tags custom-filters]}]]
  (swap! expr-tags merge custom-tags)
  (swap! filters merge custom-filters)
  (parse* input))

;; File-aware parse wrapper.

(defn parse-file [file params]
  (-> file preprocess-template (java.io.StringReader.) (parse-input params)))

(defn parse [parse-fn input & [{:keys [tag-open tag-close filter-open filter-close tag-second short-comment-second]
                                :or   {tag-open             *tag-open*
                                       tag-close            *tag-close*
                                       filter-open          *filter-open*
                                       filter-close         *filter-close*
                                       tag-second           *tag-second*
                                       short-comment-second *short-comment-second*}
                                :as   params}]]
  (binding [*tag-open*             tag-open
            *tag-close*            tag-close
            *filter-open*          filter-open
            *filter-close*         filter-close
            *tag-second*           tag-second
            *short-comment-second* short-comment-second
            *tag-second-pattern*   (pattern tag-second)
            *filter-open-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*")
            *filter-close-pattern* (pattern "\\s*\\" filter-close "\\" tag-close)
            *filter-pattern*       (pattern "\\" tag-open "\\" filter-open "\\s*.*\\s*\\" filter-close "\\" tag-close)
            *tag-open-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*")
            *tag-close-pattern*    (pattern "\\s*\\" tag-second "\\"  tag-close)
            *tag-pattern*          (pattern "\\" tag-open "\\" tag-second "\\s*.*\\s*\\" tag-second "\\" tag-close)
            *include-pattern*      (pattern "\\" tag-open "\\" tag-second "\\s*include.*")
            *extends-pattern*      (pattern "\\" tag-open "\\" tag-second "\\s*extends.*")
            *block-pattern*        (pattern "\\" tag-open "\\" tag-second "\\s*block.*")
            *block-super-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*block.super\\s*\\" filter-close "\\" tag-close)
            *endblock-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*endblock.*")]
    (parse-fn input params)))

Rename render-file's filename arg to filename-or-URL (#154)


(ns ^{:doc "Which version of Clojure am I running in?"}
  such.versions)

(def ^:private minor (:minor *clojure-version*))

(defmacro when=1-4 [& body]
  (when (=  minor 4)
    `(do ~@body)))

(defmacro when<=1-5 [& body]
  (when (<= minor 5)
    `(do ~@body)))

(defmacro when>=1-5 [& body]
  (when (>= minor 5)
    `(do ~@body)))

(defmacro when>=1-6 [& body]
  (when (>= minor 6)
    `(do ~@body)))

(defmacro when>=1-7 [& body]
  (when (>= minor 7)
    `(do ~@body)))

Add `when>=1-7`

Add `when>=1-7`


(ns ^{:doc "Which version of Clojure am I running in?"}
  such.versions)

(def ^:private minor (:minor *clojure-version*))

(defmacro when=1-4 [& body]
  (when (=  minor 4)
    `(do ~@body)))

(defmacro when<=1-5 [& body]
  (when (<= minor 5)
    `(do ~@body)))

(defmacro when>=1-5 [& body]
  (when (>= minor 5)
    `(do ~@body)))

(defmacro when>=1-6 [& body]
  (when (>= minor 6)
    `(do ~@body)))

(defmacro when>=1-7 [& body]
  (when (>= minor 7)
    `(do ~@body)))

(ns ^{:doc "Which version of Clojure am I running in?"}
  such.versions)

(def ^:private minor (:minor *clojure-version*))

(defmacro when<=1-5 [& body]
  (when (<= minor 5)
    `(do ~@body)))

(defmacro when>=1-5 [& body]
  (when (>= minor 5)
    `(do ~@body)))

(defmacro when>=1-6 [& body]
  (when (>= minor 6)
    `(do ~@body)))

(defmacro when=1-6 [& body]
  (when (= minor 6)
    `(do ~@body)))

(defmacro when>=1-7 [& body]
  (when (>= minor 7)
    `(do ~@body)))

(defmacro when=1-7 [& body]
  (when (= minor 7)
    `(do ~@body)))

(defmacro when>=1-8 [& body]
  (when (>= minor 8)
    `(do ~@body)))

(defmacro when=1-8 [& body]
  (when (= minor 8)
    `(do ~@body)))

Add more version tests.

Add more version tests.


(ns cljs-repl-web.code-mirror.core
  (:require [reagent.core :as reagent :refer [atom]]
            [re-frame.core :refer [subscribe dispatch]]
            [cljs-repl-web.code-mirror.handlers :as handlers]
            [cljs-repl-web.code-mirror.subs :as subs]
            [cljs-repl-web.code-mirror.editor :as editor]
            [cljs-repl-web.code-mirror.common :as common]
            [cljs-repl-web.code-mirror.replumb :as replumb]
            [cljs-repl-web.code-mirror.utils :as utils]))

;;; many parts are taken from jaredly's reepl
;;; https://github.com/jaredly/reepl

(defn make-handlers []
  {:add-input    #(dispatch [:add-console-input :cljs-console %1 %2])
   :add-result   #(dispatch [:add-console-result :cljs-console %1 %2])
   :go-up        #(dispatch [:console-go-up :cljs-console %])
   :go-down      #(dispatch [:console-go-down :cljs-console %])
   :clear-items  #(dispatch [:clear-console-items :cljs-console %])
   :set-text     #(dispatch [:console-set-text :cljs-console %1])
   :add-log      #(dispatch [:add-console-log :cljs-console %])})

(defn display-repl-item
  [item]
  (if-let [text (:text item)]
    [:div.cm-console-item
     {:on-click #(do (dispatch [:console-set-text :cljs-console text])
                     (dispatch [:focus-console-editor :cljs-console]))}
     [utils/colored-text (str (:ns item) "=> " text)]]

    (if (= :error (:type item))
      [:div.cm-console-item.error-cm-console-item
       {:on-click #(dispatch [:focus-console-editor :cljs-console])}
       (.-message (:value item))]
      [:div.cm-console-item
       {:on-click #(dispatch [:focus-console-editor :cljs-console])}
       (:value item)])))

(defn repl-items [items]
  (into [:div] (map display-repl-item items)))

(defn console []
  (let [execute #(replumb/run-repl %1 {} %2)
        {:keys [add-input
                add-result
                go-up
                go-down
                clear-items
                set-text
                add-log]} (make-handlers)

        items (subscribe [:get-console-items :cljs-console])
        text  (subscribe [:get-console-current-text :cljs-console])

        submit (fn [text]
                 (let [text (.trim text)]
                   (when (< 0 (count text))
                     (set-text text)
                     (add-input text (replumb/current-ns))
                     (execute text #(add-result (not %1) %2))
                     ;; todo - rethink better?
                     (when-let [example @(subscribe [:get-next-example :cljs-console])]
                       (set-text example)
                       (dispatch [:delete-first-example :cljs-console])))))]

    (reagent/create-class
     {:reagent-render
      (fn []
        [:div.cm-console
         {:on-click #(dispatch [:focus-console-editor :cljs-console])}
         [repl-items @items]
         [editor/editor
          text
          (merge
           editor/default-cm-opts
           {:on-up go-up
            :on-down go-down
            :on-change set-text
            :on-eval submit
            :get-prompt replumb/get-prompt
            :should-eval (fn [source _ _]
                           (not (replumb/multiline? source)))})]])
      :component-did-update
      (fn [this]
        (common/scroll-to-el-bottom (.-parentElement (reagent/dom-node this))))})))

(ns cljs-repl-web.code-mirror.core
  (:require [reagent.core :as reagent :refer [atom]]
            [re-frame.core :refer [subscribe dispatch]]
            [cljs-repl-web.code-mirror.handlers :as handlers]
            [cljs-repl-web.code-mirror.subs :as subs]
            [cljs-repl-web.code-mirror.editor :as editor]
            [cljs-repl-web.code-mirror.common :as common]
            [cljs-repl-web.code-mirror.replumb :as replumb]
            [cljs-repl-web.code-mirror.utils :as utils]))

;;; many parts are taken from jaredly's reepl
;;; https://github.com/jaredly/reepl

(defn make-handlers []
  {:add-input    #(dispatch [:add-console-input :cljs-console %1 %2])
   :add-result   #(dispatch [:add-console-result :cljs-console %1 %2])
   :go-up        #(dispatch [:console-go-up :cljs-console %])
   :go-down      #(dispatch [:console-go-down :cljs-console %])
   :clear-items  #(dispatch [:clear-console-items :cljs-console %])
   :set-text     #(dispatch [:console-set-text :cljs-console %1])
   :add-log      #(dispatch [:add-console-log :cljs-console %])})

(defn display-output-item
  ([value]
   (display-output-item value false))
  ([value error?]
   (println value ", " error?)
   [:div
    {:on-click #(dispatch [:focus-console-editor :cljs-console])
     :class (str "cm-console-item" (when error? " error-cm-console-item"))}
    value]))

(defn display-repl-item
  [item]
  (if-let [text (:text item)]
    [:div.cm-console-item
     {:on-click #(do (dispatch [:console-set-text :cljs-console text])
                     (dispatch [:focus-console-editor :cljs-console]))}
     [utils/colored-text (str (:ns item) "=> " text)]]

    (if (= :error (:type item))
      (display-output-item (.-message (:value item)) true)
      (display-output-item (:value item)))))

(defn repl-items [items]
  (into [:div] (map display-repl-item items)))

(defn console []
  (let [execute #(replumb/run-repl %1 {} %2)
        {:keys [add-input
                add-result
                go-up
                go-down
                clear-items
                set-text
                add-log]} (make-handlers)

        items (subscribe [:get-console-items :cljs-console])
        text  (subscribe [:get-console-current-text :cljs-console])

        submit (fn [text]
                 (let [text (.trim text)]
                   (when (< 0 (count text))
                     (set-text text)
                     (add-input text (replumb/current-ns))
                     (execute text #(add-result (not %1) %2))
                     ;; todo - rethink better?
                     (when-let [example @(subscribe [:get-next-example :cljs-console])]
                       (set-text example)
                       (dispatch [:delete-first-example :cljs-console])))))]

    (reagent/create-class
     {:reagent-render
      (fn []
        [:div.cm-console
         {:on-click #(dispatch [:focus-console-editor :cljs-console])}
         [repl-items @items]
         [editor/editor
          text
          (merge
           editor/default-cm-opts
           {:on-up go-up
            :on-down go-down
            :on-change set-text
            :on-eval submit
            :get-prompt replumb/get-prompt
            :should-eval (fn [source _ _]
                           (not (replumb/multiline? source)))})]])
      :component-did-update
      (fn [this]
        (common/scroll-to-el-bottom (.-parentElement (reagent/dom-node this))))})))

Refactor items' displaying

Refactor items' displaying


(ns com.wsscode.fulcro.db-helpers
  #?(:cljs (:require-macros [com.wsscode.fulcro.db-helpers]))
  (:require [com.wsscode.pathom.core]
            [clojure.spec.alpha :as s]
            [fulcro.client.mutations :as mutations]
            [fulcro.client.primitives :as fp]
            [fulcro.client.data-fetch :as fetch]
            [clojure.set :as set]))

(defn- om-ident? [x]
  (and (vector? x)
       (= 2 (count x))
       (keyword? (first x))))

(defn query-component
  "Run a query against a component with ident. If you provide a path on
  focus-path, only that path will be queried, and the result will be pulled
  from the edge of the path."
  ([this]
   (let [component (fp/react-type this)
         ref       (fp/get-ident this)
         state     (-> this fp/get-reconciler fp/app-state deref)
         query     (fp/get-query component)]
     (fp/db->tree query (get-in state ref) state)))
  ([this focus-path]
   (let [component (fp/react-type this)
         ref       (fp/get-ident this)
         state     (-> this fp/get-reconciler fp/app-state deref)
         query     (fp/focus-query (fp/get-query component) focus-path)]
     (-> (fp/db->tree query (get-in state ref) state)
         (get-in focus-path)))))

(defn swap-entity! [{:keys [state ref]} & args]
  "Swap something, starts on the current ref path."
  (apply swap! state update-in ref args))

(defn resolve-path [state path]
  "Walks a db path, when find an ident it resets the path to that ident. Use to realize paths of relations."
  (loop [[h & t] path
         new-path []]
    (if h
      (let [np (conj new-path h)
            c  (get-in state np)]
        (if (om-ident? c)
          (recur t c)
          (recur t (conj new-path h))))
      new-path)))

(defn swap-in! [{:keys [state ref]} path & args]
  "Like swap! but starts at the ref from enviroment. You can use the path to
   navigate into references, those will be resolved and the final target will
   receive the update event."
  (let [path (resolve-path @state (into ref path))]
    (if (and path (get-in @state path))
      (apply swap! state update-in path args)
      @state)))

(defn merge-entity [state x data & named-parameters]
  "Starting from a denormalized entity map, normalizes using class x.
   It assumes the entity is going to be normalized too, then get all
   normalized data and merge back into the app state and idents."
  (let [idents     (-> (fp/tree->db
                         (reify
                           fp/IQuery
                           (query [_] [{::root (fp/get-query x)}]))
                         {::root data} true)
                       (dissoc ::root ::fp/tables))
        root-ident (fp/ident x data)
        state      (merge-with (partial merge-with merge) state idents)]
    (if (seq named-parameters)
      (apply fp/integrate-ident state root-ident named-parameters)
      state)))

(defn create-entity! [{:keys [state ref]} x data & named-parameters]
  (let [named-parameters (->> (partition 2 named-parameters)
                              (map (fn [[op path]] [op (conj ref path)]))
                              (apply concat))
        data'            (if (-> data meta ::initialized)
                           data
                           (fp/get-initial-state x data))
        data''           (if (empty? data') data data')]
    (apply swap! state merge-entity x data'' named-parameters)))

(defn- dissoc-in [m path]
  (cond-> m
    (get-in m (butlast path))
    (update-in (butlast path) dissoc (last path))))

(defn deep-remove-ref [state ref]
  "Remove a ref and all linked refs from it."
  (let [item   (get-in state ref)
        idents (into []
                     (comp (keep (fn [v]
                                   (cond
                                     (om-ident? v)
                                     [v]

                                     (and (vector? v)
                                          (every? om-ident? v))
                                     v)))
                           cat)
                     (vals item))]
    (reduce
      (fn [s i] (deep-remove-ref s i))
      (dissoc-in state ref)
      idents)))

(defn remove-edge! [{:keys [state ref]} field]
  "Remove edge data from a node. This will remove the ref and all associated data with it (recursive)."
  (let [children (get-in @state (conj ref field))]
    (cond
      (om-ident? children)
      (swap! state (comp #(update-in % ref dissoc field)
                         #(deep-remove-ref % children)))

      (seq children)
      (swap! state (comp #(assoc-in % (conj ref field) [])
                         #(reduce deep-remove-ref % children))))))

(defn init-state
  "Starting from an ident and query, scan the DB initializing the components. This should be used to initialize data
  loaded from the network with fulcro fetch, this will recursively traverse using query information and merge the
  initial state with the current data (data load from the server takes priority)."
  ([state x ident]
   (let [initial  (fp/get-initial-state x nil)
         children (-> x fp/get-query fp/query->ast :children)
         data     (fp/db->tree (fp/get-query x) (get-in state ident) state)]
     (reduce
       (fn [s {:keys [type component key]}]
         (if (and (= :join type) component)
           (let [value (get-in state (conj ident key))]
             (cond
               (om-ident? value)
               (init-state s component value)

               (vector? value)
               (reduce
                 (fn [s ident]
                   (if (om-ident? ident)
                     (init-state s component ident)
                     s))
                 s
                 value)

               :else
               s))
           s))
       (merge-entity state x (merge initial data))
       children))))

(defn vec-remove-index [i v]
  "Remove an item from a vector via index."
  (->> (concat (subvec v 0 i)
               (subvec v (inc i) (count v)))
       (vec)))

(defn clean-keys
  "Set given keys to empty on current ref."
  [env keys]
  (let [empty-map (zipmap keys (repeat ""))]
    (swap-entity! env merge empty-map)))

(mutations/defmutation init-loaded-state [{:keys [ref component]}]
  (action [env]
    (let [{:keys [state]} env]
      (swap! state init-state component ref))))

(defn transform-remote [env ast]
  (let [ast (if (true? ast) (:ast env) ast)]
    (if-let [component (some-> ast :query meta :component)]
      (swap-entity! env assoc-in [::mutation-response :component] component))
    (-> ast
        (cond-> (:query ast) (update :query vary-meta dissoc :component))
        (mutations/with-target (conj (:ref env) ::mutation-response-swap)))))

(defn gen-pessimistic-mutation [sym arglist forms]
  (let [sym       sym
        ok-sym    (with-meta (symbol (str sym "-ok")) (meta sym))
        error-sym (with-meta (symbol (str sym "-error")) (meta sym))
        {[pre]     'pre-action
         [action]  'action
         [error]   'error-action
         [refresh] 'refresh
         remotes   nil} (group-by (fn [x] (#{'action 'error-action 'pre-action 'refresh} (first x))) forms)
        env       (gensym "env")
        refresh   (if refresh [refresh])
        remotes   (->> remotes
                       (mapv (fn [[s args & forms]]
                               (list s [env]
                                 `(let [~(first args) ~env]
                                    (transform-remote ~env (do ~@forms)))))))
        action    (or action '(action [_] nil))
        pre'      (some-> pre vec (assoc 0 'action) (->> (apply list)))
        initial   (if pre (into [pre'] remotes) remotes)]
    `(do
       (mutations/defmutation ~sym ~arglist ~@initial)
       (mutations/defmutation ~ok-sym ~arglist ~action ~@refresh)
       ~(if error `(mutations/defmutation ~error-sym ~arglist ~(-> error next (conj 'action)))))))

#?(:clj
   (defmacro defpmutation
     "Defines a pessimistic mutation. This is adapted to work with the pessimist mutation
     system for Shuffle. This works similar to the normal `defmutation`, but instead of
     doing the optimistic update right after the action, it delays to when the response
     is success from the remote. If the remote fails, the UI change is not going to be
     applied."
     [sym arglist & forms]
     (gen-pessimistic-mutation sym arglist forms)))

#?(:clj
   (s/fdef defpmutation
     :args (s/cat :sym symbol? :args vector? :forms (s/+ list?))))

(defn fetch-error
  "Get the error data for a given attribute."
  [this k]
  (get-in (fp/props this) [:com.wsscode.pathom.core/errors k]))

(defn error-type
  "Get the error type directly."
  [this k]
  (get-in (fp/props this) [:com.wsscode.pathom.core/errors k :abrams.diplomat.api/error-type]))

(defn mutation-response
  ([this]
   (if (fp/component? this)
     (mutation-response (-> this fp/get-reconciler fp/app-state deref) (fp/props this))
     (-> this ::mutation-response)))
  ([state props]
   (let [response (-> props ::mutation-response)]
     (if (fulcro.util/ident? response) (get-in state response) response))))

(defn mutation-loading? [this]
  (let [props (cond-> this (fp/component? this) fp/props)]
    (-> props ::mutation-response (fetch/loading?))))

(defn mutation-error?
  ([this]
   (-> (mutation-response this) (contains? :abrams.controllers.graph/error)))
  ([state props]
   (-> (mutation-response state props) (contains? :abrams.controllers.graph/error))))

(defn get-mutation [env k p]
  (if-let [m (get (methods mutations/mutate) k)]
    (m env k p)))

(defn call-mutation-action [env k p]
  (if-let [h (-> (get-mutation env k p) :action)]
    (h)))

(s/def ::mutation-response (s/keys))

(mutations/defmutation start-mutation [_]
  (action [env]
    (swap-entity! env assoc ::mutation-response {:fulcro.client.impl.data-fetch/type :loading})
    nil))

(mutations/defmutation mutation-network-error [{::keys [ref] :as p}]
  (action [env]
    (swap-entity! (assoc env :ref ref) assoc ::mutation-response
      (-> p
          (dissoc ::ref)
          (assoc :abrams.controllers.graph/error "Network error"
                 :abrams.diplomat.api/error-type ::network-error)))
    nil))

(mutations/defmutation finish-mutation [{:keys [ok-mutation error-mutation input]}]
  (action [env]
    (let [{:keys [state ref reconciler]} env
          {::keys [mutation-response mutation-response-swap] :as props} (get-in @state ref)]
      (if (mutation-error? @state (set/rename-keys props {::mutation-response-swap ::mutation-response}))
        (do
          (swap-entity! env assoc ::mutation-response mutation-response-swap)
          (call-mutation-action env error-mutation input))
        (do
          (if (:component mutation-response)
            (fp/merge-component! reconciler (:component mutation-response) mutation-response-swap))

          (if (mutation-loading? props) (swap-entity! env dissoc ::mutation-response))

          (call-mutation-action env ok-mutation input)))
      (swap-entity! env dissoc ::mutation-response-swap))))

(defn pmutate! [this mutation params]
  (let [ok-mutation    (symbol (str mutation "-ok"))
        error-mutation (symbol (str mutation "-error"))]
    (fp/ptransact! this `[(start-mutation {})
                          ~(list mutation params)
                          (fulcro.client.data-fetch/fallback {:action mutation-network-error
                                                              ::ref   ~(fp/get-ident this)})
                          (finish-mutation ~{:ok-mutation    ok-mutation
                                             :error-mutation error-mutation
                                             :input          params})])))

(def non-values #{:com.wsscode.pathom.core/reader-error :fulcro.client.primitives/not-found "  Error  "})

(defn content
  "There are special values on the DB that are not valid values. Here you give x, and
  if x is a special value (usually error reporting) it will return nil. Otherwise x
  is returned."
  [x] (if (non-values x) nil x))

(mutations/defmutation multi-mutation [mutations]
  (action [env]
    (doseq [[sym params] mutations
            :when (symbol? sym)]
      ((:action (mutations/mutate env sym params))))))

(ns com.wsscode.fulcro.db-helpers
  #?(:cljs (:require-macros [com.wsscode.fulcro.db-helpers]))
  (:require [com.wsscode.pathom.core]
            [clojure.spec.alpha :as s]
            [fulcro.client.mutations :as mutations]
            [fulcro.client.primitives :as fp]
            [fulcro.client.data-fetch :as fetch]
            [clojure.set :as set]))

(defn- om-ident? [x]
  (and (vector? x)
       (= 2 (count x))
       (keyword? (first x))))

(defn query-component
  "Run a query against a component with ident. If you provide a path on
  focus-path, only that path will be queried, and the result will be pulled
  from the edge of the path."
  ([this]
   (let [component (fp/react-type this)
         ref       (fp/get-ident this)
         state     (-> this fp/get-reconciler fp/app-state deref)
         query     (fp/get-query component)]
     (fp/db->tree query (get-in state ref) state)))
  ([this focus-path]
   (let [component (fp/react-type this)
         ref       (fp/get-ident this)
         state     (-> this fp/get-reconciler fp/app-state deref)
         query     (fp/focus-query (fp/get-query component) focus-path)]
     (-> (fp/db->tree query (get-in state ref) state)
         (get-in focus-path)))))

(defn swap-entity! [{:keys [state ref]} & args]
  "Swap something, starts on the current ref path."
  (apply swap! state update-in ref args))

(defn resolve-path [state path]
  "Walks a db path, when find an ident it resets the path to that ident. Use to realize paths of relations."
  (loop [[h & t] path
         new-path []]
    (if h
      (let [np (conj new-path h)
            c  (get-in state np)]
        (if (om-ident? c)
          (recur t c)
          (recur t (conj new-path h))))
      new-path)))

(defn swap-in! [{:keys [state ref]} path & args]
  "Like swap! but starts at the ref from enviroment. You can use the path to
   navigate into references, those will be resolved and the final target will
   receive the update event."
  (let [path (resolve-path @state (into ref path))]
    (if (and path (get-in @state path))
      (apply swap! state update-in path args)
      @state)))

(defn merge-entity [state x data & named-parameters]
  "Starting from a denormalized entity map, normalizes using class x.
   It assumes the entity is going to be normalized too, then get all
   normalized data and merge back into the app state and idents."
  (let [idents     (-> (fp/tree->db
                         (reify
                           fp/IQuery
                           (query [_] [{::root (fp/get-query x)}]))
                         {::root data} true)
                       (dissoc ::root ::fp/tables))
        root-ident (fp/ident x data)
        state      (merge-with (partial merge-with merge) state idents)]
    (if (seq named-parameters)
      (apply fp/integrate-ident state root-ident named-parameters)
      state)))

(defn create-entity! [{:keys [state ref]} x data & named-parameters]
  (let [named-parameters (->> (partition 2 named-parameters)
                              (map (fn [[op path]] [op (conj ref path)]))
                              (apply concat))
        data'            (if (-> data meta ::initialized)
                           data
                           (fp/get-initial-state x data))
        data''           (if (empty? data') data data')]
    (apply swap! state merge-entity x data'' named-parameters)))

(defn- dissoc-in [m path]
  (cond-> m
    (get-in m (butlast path))
    (update-in (butlast path) dissoc (last path))))

(defn deep-remove-ref [state ref]
  "Remove a ref and all linked refs from it."
  (let [item   (get-in state ref)
        idents (into []
                     (comp (keep (fn [v]
                                   (cond
                                     (om-ident? v)
                                     [v]

                                     (and (vector? v)
                                          (every? om-ident? v))
                                     v)))
                           cat)
                     (vals item))]
    (reduce
      (fn [s i] (deep-remove-ref s i))
      (dissoc-in state ref)
      idents)))

(defn remove-edge! [{:keys [state ref]} field]
  "Remove edge data from a node. This will remove the ref and all associated data with it (recursive)."
  (let [children (get-in @state (conj ref field))]
    (cond
      (om-ident? children)
      (swap! state (comp #(update-in % ref dissoc field)
                         #(deep-remove-ref % children)))

      (seq children)
      (swap! state (comp #(assoc-in % (conj ref field) [])
                         #(reduce deep-remove-ref % children))))))

(defn init-state
  "Starting from an ident and query, scan the DB initializing the components. This should be used to initialize data
  loaded from the network with fulcro fetch, this will recursively traverse using query information and merge the
  initial state with the current data (data load from the server takes priority)."
  ([state x ident]
   (let [initial  (fp/get-initial-state x nil)
         children (-> x fp/get-query fp/query->ast :children)
         data     (fp/db->tree (fp/get-query x) (get-in state ident) state)]
     (reduce
       (fn [s {:keys [type component key]}]
         (if (and (= :join type) component)
           (let [value (get-in state (conj ident key))]
             (cond
               (om-ident? value)
               (init-state s component value)

               (vector? value)
               (reduce
                 (fn [s ident]
                   (if (om-ident? ident)
                     (init-state s component ident)
                     s))
                 s
                 value)

               :else
               s))
           s))
       (merge-entity state x (merge initial data))
       children))))

(defn vec-remove-index [i v]
  "Remove an item from a vector via index."
  (->> (concat (subvec v 0 i)
               (subvec v (inc i) (count v)))
       (vec)))

(defn clean-keys
  "Set given keys to empty on current ref."
  [env keys]
  (let [empty-map (zipmap keys (repeat ""))]
    (swap-entity! env merge empty-map)))

(mutations/defmutation init-loaded-state [{:keys [ref component]}]
  (action [env]
    (let [{:keys [state]} env]
      (swap! state init-state component ref))))

(defn transform-remote [env ast]
  (let [ast (if (true? ast) (:ast env) ast)]
    (if-let [component (some-> ast :query meta :component)]
      (swap-entity! env assoc-in [::mutation-response :component] component))
    (-> ast
        (cond-> (:query ast) (update :query vary-meta dissoc :component))
        (mutations/with-target (conj (:ref env) ::mutation-response-swap)))))

(defn gen-pessimistic-mutation [sym arglist forms]
  (let [sym       sym
        ok-sym    (with-meta (symbol (str sym "-ok")) (meta sym))
        error-sym (with-meta (symbol (str sym "-error")) (meta sym))
        {[pre]     'pre-action
         [action]  'action
         [error]   'error-action
         [refresh] 'refresh
         remotes   nil} (group-by (fn [x] (#{'action 'error-action 'pre-action 'refresh} (first x))) forms)
        env       (gensym "env")
        refresh   (if refresh [refresh])
        remotes   (->> remotes
                       (mapv (fn [[s args & forms]]
                               (list s [env]
                                 `(let [~(first args) ~env]
                                    (transform-remote ~env (do ~@forms)))))))
        action    (or action '(action [_] nil))
        pre'      (some-> pre vec (assoc 0 'action) (->> (apply list)))
        initial   (if pre (into [pre'] remotes) remotes)]
    `(do
       (mutations/defmutation ~sym ~arglist ~@initial)
       (mutations/defmutation ~ok-sym ~arglist ~action ~@refresh)
       ~(if error `(mutations/defmutation ~error-sym ~arglist ~(-> error next (conj 'action)))))))

#?(:clj
   (defmacro defpmutation
     "Defines a pessimistic mutation. This is adapted to work with the pessimist mutation
     system for Shuffle. This works similar to the normal `defmutation`, but instead of
     doing the optimistic update right after the action, it delays to when the response
     is success from the remote. If the remote fails, the UI change is not going to be
     applied."
     [sym arglist & forms]
     (gen-pessimistic-mutation sym arglist forms)))

#?(:clj
   (s/fdef defpmutation
     :args (s/cat :sym symbol? :args vector? :forms (s/+ list?))))

(defn fetch-error
  "Get the error data for a given attribute."
  [this k]
  (get-in (fp/props this) [:com.wsscode.pathom.core/errors k]))

(defn mutation-response
  ([this]
   (if (fp/component? this)
     (mutation-response (-> this fp/get-reconciler fp/app-state deref) (fp/props this))
     (-> this ::mutation-response)))
  ([state props]
   (let [response (-> props ::mutation-response)]
     (if (fulcro.util/ident? response) (get-in state response) response))))

(defn mutation-loading? [this]
  (let [props (cond-> this (fp/component? this) fp/props)]
    (-> props ::mutation-response (fetch/loading?))))

(defn mutation-error?
  ([this]
   (-> (mutation-response this) (contains? :com.wsscode.pathom.core/mutation-errors)))
  ([state props]
   (-> (mutation-response state props) (contains? :com.wsscode.pathom.core/mutation-errors))))

(defn get-mutation [env k p]
  (if-let [m (get (methods mutations/mutate) k)]
    (m env k p)))

(defn call-mutation-action [env k p]
  (if-let [h (-> (get-mutation env k p) :action)]
    (h)))

(s/def ::mutation-response (s/keys))

(mutations/defmutation start-mutation [_]
  (action [env]
    (swap-entity! env assoc ::mutation-response {:fulcro.client.impl.data-fetch/type :loading})
    nil))

(mutations/defmutation mutation-network-error [{::keys [ref] :as p}]
  (action [env]
    (swap-entity! (assoc env :ref ref) assoc ::mutation-response
      (-> p
          (dissoc ::ref)
          (assoc ::fp/error "Network error")))
    nil))

(mutations/defmutation finish-mutation [{:keys [ok-mutation error-mutation input]}]
  (action [env]
    (let [{:keys [state ref reconciler]} env
          {::keys [mutation-response mutation-response-swap] :as props} (get-in @state ref)]
      (if (mutation-error? @state (set/rename-keys props {::mutation-response-swap ::mutation-response}))
        (do
          (swap-entity! env assoc ::mutation-response mutation-response-swap)
          (call-mutation-action env error-mutation input))
        (do
          (if (:component mutation-response)
            (fp/merge-component! reconciler (:component mutation-response) mutation-response-swap))

          (if (mutation-loading? props) (swap-entity! env dissoc ::mutation-response))

          (call-mutation-action env ok-mutation input)))
      (swap-entity! env dissoc ::mutation-response-swap))))

(defn pmutate! [this mutation params]
  (let [ok-mutation    (symbol (str mutation "-ok"))
        error-mutation (symbol (str mutation "-error"))]
    (fp/ptransact! this `[(start-mutation {})
                          ~(list mutation params)
                          (fulcro.client.data-fetch/fallback {:action mutation-network-error
                                                              ::ref   ~(fp/get-ident this)})
                          (finish-mutation ~{:ok-mutation    ok-mutation
                                             :error-mutation error-mutation
                                             :input          params})])))

(def non-values #{:com.wsscode.pathom.core/reader-error :fulcro.client.primitives/not-found "  Error  "})

(defn content
  "There are special values on the DB that are not valid values. Here you give x, and
  if x is a special value (usually error reporting) it will return nil. Otherwise x
  is returned."
  [x] (if (non-values x) nil x))

(mutations/defmutation multi-mutation [mutations]
  (action [env]
    (doseq [[sym params] mutations
            :when (symbol? sym)]
      ((:action (mutations/mutate env sym params))))))

Remove abrams related stuff from db helpers


(ns triboard.ai.ai
  (:require
    [triboard.ai.scores :as scores]
    [triboard.logic.constants :as cst]
    [triboard.logic.board :as board]
    [triboard.logic.move :as move]
    [triboard.logic.turn :as turn]
    [triboard.utils :as utils]
    ))

;; -----------------------------------------
;; Private
;; -----------------------------------------

(defn- neighbouring-walls
  [board point]
  (eduction
    (filter #(= :wall (board/get-cell-at board % :wall)))
    (utils/coord-neighbors point)))

(defn- compute-cell-strength
  "Compute a cell strength based on the number of walls it has"
  {:pre [(coord? point)]}
  [board point]
  (let [wall-nb (count (neighbouring-walls board point))]
    (+ 1 (* wall-nb wall-nb 0.25))))

(defn- compute-cells-strength
  "Adds to a given turn the strength of each of its cells"
  [board]
  (into {}
    (map (fn [point] [point (compute-cell-strength board point)]))
    cst/all-positions))

(defn- move-strength
  "Compute the strength of a move, based on the converted cells"
  [get-cells-strength player [point converted]]
  {:pre [(move/conversions? converted)]}
  (reduce
    #(scores/update-delta get-cells-strength %1 %2)
    scores/null-delta
    (conj converted
      (move/empty-cell-conversion player point))
    ))

(defn- worst-immediate-loss ;; TODO - It should consider what the other player could win
  "Return the next worse lost turn move for 'looser' if 'player' plays"
  {:pre [(player? player) (player? looser)]}
  [cells-strength turn player looser]
  (let [all-moves (turn/get-moves-of turn player)]
    (transduce
      (map #(get (move-strength cells-strength player %) looser))
      max all-moves)))

;; -----------------------------------------
;; Public API
;; -----------------------------------------

(defn best-move
  "[SIMPLISTIC] Return the best move for a player based on:
   * The immediate gain
   * The worse immediate lost afterwards"
  {:pre [(player? player)]}
  [turn player]
  (let [cells-strength (compute-cells-strength (turn/get-board turn))
        moves (turn/get-moves-of turn player)
        others (remove #{player} cst/players)]
    (first
      (utils/fast-max-key
        (fn [[m converted :as move]]
          (let [new-turn (turn/play-move turn m)
                diff-score (get (move-strength cells-strength player move) player)
                losses (map #(worst-immediate-loss cells-strength new-turn % player) others)]
            (- diff-score (apply max losses))))
        moves))
    ))

(ns triboard.ai.ai
  (:require
    [triboard.ai.scores :as scores]
    [triboard.logic.constants :as cst]
    [triboard.logic.board :as board]
    [triboard.logic.move :as move]
    [triboard.logic.turn :as turn]
    [triboard.utils :as utils]
    ))

;; -----------------------------------------
;; Private
;; -----------------------------------------

(defn- neighbouring-walls
  [board point]
  (eduction
    (filter #(= :wall (board/get-cell-at board % :wall)))
    (utils/coord-neighbors point)))

(defn- compute-cell-strength
  "Compute a cell strength based on the number of walls it has"
  {:pre [(coord? point)]}
  [board point]
  (let [wall-nb (count (neighbouring-walls board point))]
    (+ 1 (* wall-nb wall-nb 0.25))))

(defn- compute-cells-strength
  "Adds to a given turn the strength of each of its cells"
  [board]
  (into {}
    (map (fn [point] [point (compute-cell-strength board point)]))
    cst/all-positions))

(defn- move-strength
  "Compute the strength of a move, based on the converted cells"
  [get-cells-strength player [point converted]]
  {:pre [(move/conversions? converted)]}
  (reduce
    #(scores/update-delta get-cells-strength %1 %2)
    scores/null-delta
    (conj converted
      (move/empty-cell-conversion player point))
    ))

(defn- worst-immediate-loss ;; TODO - It should consider what the other player could win
  "Return the next worse lost turn move for 'looser' if 'player' plays"
  {:pre [(player? player) (player? looser)]}
  [cells-strength turn player looser]
  (let [all-moves (turn/get-moves-of turn player)]
    (transduce
      (map #(get (move-strength cells-strength player %) looser))
      min
      all-moves)))

;; -----------------------------------------
;; Public API
;; -----------------------------------------

(defn best-move
  "[SIMPLISTIC] Return the best move for a player based on:
   * The immediate gain
   * The worse immediate lost afterwards"
  {:pre [(player? player)]}
  [turn player]
  (let [cells-strength (compute-cells-strength (turn/get-board turn))
        moves (turn/get-moves-of turn player)
        others (remove #{player} cst/players)]
    (first
      (utils/fast-max-key
        (fn [[m converted :as move]]
          (let [new-turn (turn/play-move turn m)
                new-diff (get (move-strength cells-strength player move) player)
                next-diff (map #(worst-immediate-loss cells-strength new-turn % player) others)]
            (+ new-diff (apply min next-diff))))
        moves))
    ))

fix the ai following the refactor

fix the ai following the refactor


(ns parkour.conf
  (:refer-clojure :exclude [assoc! get])
  (:require [clojure.string :as str]
            [clojure.reflect :as reflect]
            [parkour.util :refer [returning]])
  (:import [java.io Writer]
           [java.util List Map Set]
           [org.apache.hadoop.conf Configuration Configurable]
           [org.apache.hadoop.fs Path]
           [org.apache.hadoop.mapreduce Job JobContext]))

(def ^:dynamic ^:private ^Configuration *default*
  "Base configuration, used as template for fresh configurations."
  (Configuration.))

(defmulti ^:private configuration*
  "Internal implementation multimethod for extracting a `Configuration`."
  type)

(defmulti ^:private conf-set*
  "Internal implementation multimethod for setting value in Hadoop config."
  (fn [_ _ val] (type val)))

(defmulti ^:private conf-coerce
  "Internal implementation multimethod for converting value to one
which may be set as Hadoop config value."
  type)

(defn configuration
  "Extract or produce a Hadoop `Configuration`.  If provided a `conf`
argument, coerce it to be a `Configuration` which if possible shares
mutable state with that original argument.  If not, return a fresh
configuration copied from the current default."
  {:tag `Configuration}
  ([] (Configuration. *default*))
  ([conf] (configuration* conf)))

(def ^{:tag `Configuration} iguration
  "Alias for `configuration`."
  configuration)

(def ^{:tag `Configuration} ig
  "Alias for `configuration`."
  configuration)

(defn clone
  "Return new Hadoop `Configuration`, cloning `conf`."
  {:tag `Configuration}
  [conf] (Configuration. (configuration conf)))

(defmacro with-default
  "Set new default configuration `conf` within the dynamic scope of
the `body` expressions."
  [conf & body]
  `(binding [*default* (clone ~conf)]
     ~@body))

(defn get
  "Get string value of `conf` parameter `key`"
  {:tag `String}
  ([conf key] (.get (configuration conf) key))
  ([conf key default] (.get (configuration conf) key default)))

(defn get-boolean
  "Get boolean value of `conf` parameter `key`."
  ^Boolean [conf key default] (.getBoolean (configuration conf) key default))

(defn get-int
  "Get int value of `conf` parameter `key`."
  ^Integer [conf key default] (.getInt (configuration conf) key default))

(defn get-long
  "Get long value of `conf` parameter `key`."
  ^Long [conf key default] (.getLong (configuration conf) key default))

(defn get-float
  "Get float value of `conf` parameter `key`."
  ^Float [conf key default] (.getFloat (configuration conf) key default))

(defn get-class
  "Get class value of `conf` parameter `key`."
  ^Class [conf key default] (.getClass (configuration conf) key default))

(defn assoc!
  "Set `conf` parameter `key` to `val`."
  {:tag `Configuration}
  ([conf] conf)
  ([conf key val]
     (returning conf
       (conf-set* (configuration conf) (name key) (conf-coerce val))))
  ([conf key val & kvs]
     (let [conf (assoc! conf key val)]
       (if (empty? kvs)
         conf
         (recur conf (first kvs) (second kvs) (nnext kvs))))))

(def ^{:tag `Configuration} set!
  "Alias for `assoc!`."
  assoc!)

(defn merge!
  "Merge `coll` of key-value pairs into Hadoop configuration `conf`."
  {:tag `Configuration}
  [conf coll]
  (apply assoc! conf (apply concat coll)))

(defmethod configuration* Configuration [conf] conf)
(defmethod configuration* Configurable
  [cable] (.getConf ^Configurable cable))
(defmethod configuration* JobContext
  [context] (.getConfiguration ^JobContext context))
(defmethod configuration* Job [job] (.getConfiguration ^Job job))
(defmethod configuration* Map [map] (merge! (configuration) map))
(defmethod configuration* :default [_] nil)

(defmacro ^:private def-conf-set*
  [[conf key val] & pairs]
  (let [conf (vary-meta conf assoc :tag `Configuration)
        key (vary-meta key assoc :tag `String)]
    `(do ~@(map (fn [[type form]]
                  (let [val (vary-meta val assoc :tag type)]
                    `(defmethod conf-set* ~type ~[conf key val]
                       ~form)))
                (partition 2 pairs)))))

(def ^:private unset-method?
  (->> Configuration reflect/type-reflect :members
       (some #(= 'unset (:name %)))))

(defmacro ^:private conf-unset
  [conf key] (if unset-method? `(. ~conf unset ~key)))

(def-conf-set* [conf key val]
  nil     (conf-unset conf key)
  String  (.set conf key val)
  Integer (.setInt conf key (int val))
  Long    (.setLong conf key (long val))
  Float   (.setFloat conf key (float val))
  Double  (.setFloat conf key (float val))
  Boolean (.setBoolean conf key (boolean val)))

(defmethod conf-coerce :default [val] val)
(defmethod conf-coerce Path [val] (str val))
(defmethod conf-coerce Class [val] (.getName ^Class val))
(defmethod conf-coerce List [val] (str/join "," (map conf-coerce val)))
(defmethod conf-coerce Set [val] (str/join "," (map conf-coerce val)))
(defmethod conf-coerce Map [val]
  (let [kv-str (fn [[k v]] (str (conf-coerce k) "=" (conf-coerce v)))]
    (str/join "," (map kv-str val))))

(defn diff
  "Map of updates from `conf` to `conf'`."
  ([conf'] (diff *default* conf'))
  ([conf conf']
     (let [conf (configuration conf), conf' (configuration conf')]
       (reduce (fn [diff key]
                 (let [val (get conf key), val' (get conf' key)]
                   (if (= val val')
                     diff
                     (assoc diff key val'))))
               {} (distinct (mapcat keys [conf conf']))))))

(defn copy!
  "Copy all configuration from `conf'` to `conf`."
  [conf conf'] (merge! conf (diff conf conf')))

(defmethod print-method Configuration
  [conf ^Writer w]
  (.write w "#hadoop.conf/configuration ")
  (print-method (diff conf) w))

(ns parkour.conf
  (:refer-clojure :exclude [assoc! get])
  (:require [clojure.string :as str]
            [clojure.reflect :as reflect]
            [parkour.util :refer [returning]])
  (:import [java.io Writer]
           [java.util List Map Set]
           [org.apache.hadoop.conf Configuration Configurable]
           [org.apache.hadoop.fs Path]
           [org.apache.hadoop.mapreduce Job JobContext]))

(def ^:dynamic ^:private ^Configuration *default*
  "Base configuration, used as template for fresh configurations."
  (Configuration.))

(defmulti ^:private configuration*
  "Internal implementation multimethod for extracting a `Configuration`."
  type)

(defmulti ^:private conf-set*
  "Internal implementation multimethod for setting value in Hadoop config."
  (fn [_ _ val] (type val)))

(defmulti ^:private conf-coerce
  "Internal implementation multimethod for converting value to one
which may be set as Hadoop config value."
  type)

(defn configuration
  "Extract or produce a Hadoop `Configuration`.  If provided a `conf`
argument, coerce it to be a `Configuration` which if possible shares
mutable state with that original argument.  If not, return a fresh
configuration copied from the current default."
  {:tag `Configuration}
  ([] (Configuration. *default*))
  ([conf] (configuration* conf)))

(def ^{:tag `Configuration} iguration
  "Alias for `configuration`."
  configuration)

(def ^{:tag `Configuration} ig
  "Alias for `configuration`."
  configuration)

(defn clone
  "Return new Hadoop `Configuration`, cloning `conf`."
  {:tag `Configuration}
  [conf] (Configuration. (configuration conf)))

(defmacro with-default
  "Set new default configuration `conf` within the dynamic scope of
the `body` expressions."
  [conf & body]
  `(binding [*default* (clone ~conf)]
     ~@body))

(defn get
  "Get string value of `conf` parameter `key`"
  {:tag `String}
  ([conf key] (.get (configuration conf) key))
  ([conf key default] (.get (configuration conf) key default)))

(defn get-boolean
  "Get boolean value of `conf` parameter `key`."
  ^Boolean [conf key default] (.getBoolean (configuration conf) key default))

(defn get-int
  "Get int value of `conf` parameter `key`."
  ^Integer [conf key default] (.getInt (configuration conf) key default))

(defn get-long
  "Get long value of `conf` parameter `key`."
  ^Long [conf key default] (.getLong (configuration conf) key default))

(defn get-float
  "Get float value of `conf` parameter `key`."
  ^Float [conf key default] (.getFloat (configuration conf) key default))

(defn get-class
  "Get class value of `conf` parameter `key`."
  ^Class [conf key default] (.getClass (configuration conf) key default))

(defn get-vector
  "Get string-vector value of `conf` parameter `key`."
  [conf key default] (or (some-> (get conf key) (str/split #",")) default))

(defn assoc!
  "Set `conf` parameter `key` to `val`."
  {:tag `Configuration}
  ([conf] conf)
  ([conf key val]
     (returning conf
       (conf-set* (configuration conf) (name key) (conf-coerce val))))
  ([conf key val & kvs]
     (let [conf (assoc! conf key val)]
       (if (empty? kvs)
         conf
         (recur conf (first kvs) (second kvs) (nnext kvs))))))

(def ^{:tag `Configuration} set!
  "Alias for `assoc!`."
  assoc!)

(defn merge!
  "Merge `coll` of key-value pairs into Hadoop configuration `conf`."
  {:tag `Configuration}
  [conf coll]
  (apply assoc! conf (apply concat coll)))

(defmethod configuration* Configuration [conf] conf)
(defmethod configuration* Configurable
  [cable] (.getConf ^Configurable cable))
(defmethod configuration* JobContext
  [context] (.getConfiguration ^JobContext context))
(defmethod configuration* Job [job] (.getConfiguration ^Job job))
(defmethod configuration* Map [map] (merge! (configuration) map))
(defmethod configuration* :default [_] nil)

(defmacro ^:private def-conf-set*
  [[conf key val] & pairs]
  (let [conf (vary-meta conf assoc :tag `Configuration)
        key (vary-meta key assoc :tag `String)]
    `(do ~@(map (fn [[type form]]
                  (let [val (vary-meta val assoc :tag type)]
                    `(defmethod conf-set* ~type ~[conf key val]
                       ~form)))
                (partition 2 pairs)))))

(def ^:private unset-method?
  (->> Configuration reflect/type-reflect :members
       (some #(= 'unset (:name %)))))

(defmacro ^:private conf-unset
  [conf key] (if unset-method? `(. ~conf unset ~key)))

(def-conf-set* [conf key val]
  nil     (conf-unset conf key)
  String  (.set conf key val)
  Integer (.setInt conf key (int val))
  Long    (.setLong conf key (long val))
  Float   (.setFloat conf key (float val))
  Double  (.setFloat conf key (float val))
  Boolean (.setBoolean conf key (boolean val)))

(defmethod conf-coerce :default [val] val)
(defmethod conf-coerce Path [val] (str val))
(defmethod conf-coerce Class [val] (.getName ^Class val))
(defmethod conf-coerce List [val] (str/join "," (map conf-coerce val)))
(defmethod conf-coerce Set [val] (str/join "," (map conf-coerce val)))
(defmethod conf-coerce Map [val]
  (let [kv-str (fn [[k v]] (str (conf-coerce k) "=" (conf-coerce v)))]
    (str/join "," (map kv-str val))))

(defn diff
  "Map of updates from `conf` to `conf'`."
  ([conf'] (diff *default* conf'))
  ([conf conf']
     (let [conf (configuration conf), conf' (configuration conf')]
       (reduce (fn [diff key]
                 (let [val (get conf key), val' (get conf' key)]
                   (if (= val val')
                     diff
                     (assoc diff key val'))))
               {} (distinct (mapcat keys [conf conf']))))))

(defn copy!
  "Copy all configuration from `conf'` to `conf`."
  [conf conf'] (merge! conf (diff conf conf')))

(defmethod print-method Configuration
  [conf ^Writer w]
  (.write w "#hadoop.conf/configuration ")
  (print-method (diff conf) w))

Add accessor inverse of conf coercion for vectors.


(ns com.brainbot.real-fs
  (:require
   [clojure.string :as string])
  (:require [nio2.dir-seq])
  (:import [java.io File IOException FileNotFoundException]
           [java.nio.file Files Path LinkOption Paths]

           [java.nio.file.attribute UserPrincipal GroupPrincipal AclEntryType AclEntryPermission AclFileAttributeView PosixFilePermissions PosixFilePermission BasicFileAttributes PosixFileAttributes])

  (:require [com.brainbot.vfs :as vfs]))

(def ^:private is-windows
  (= "\\" File/separator))

(def ^:private no-follow-links
  (into-array [LinkOption/NOFOLLOW_LINKS]))

(defn- get-path
  [path & args]
  (Paths/get path (into-array String args)))

(defn- read-attributes
  [path]
  (Files/readAttributes (get-path path) PosixFileAttributes no-follow-links))

(defn- type-from-attribute
  [attr]
  (cond
    (.isDirectory attr)
      :directory
    (.isRegularFile attr)
      :file
    (.isSymbolicLink attr)
      :symbolic-link
    :else
      :other))

(defn- acl-from-posix-perm
  [owner-name group-name others-name perm]
  (reverse
   (drop-while  ;; drop deny rules from the end of the acl
    (complement :allow)
    (map (fn [name rperm]
           {:allow (contains? perm rperm)
            :sid name})
         [others-name group-name owner-name]
         [PosixFilePermission/OTHERS_READ
          PosixFilePermission/GROUP_READ
          PosixFilePermission/OWNER_READ]))))

(defn- acl-from-attribute
  [attr]
  (let [perm (.permissions attr)
        owner-name (str "USER:" (.getName (.owner attr)))
        group-name (str "GROUP:" (.getName (.group attr)))]
    (acl-from-posix-perm owner-name group-name "GROUP:AUTHENTICATED_USERS" perm)))

(defn- raw-windows-acls
  [path]
  (-> path
      get-path
      (Files/getFileAttributeView AclFileAttributeView (into-array LinkOption []))
      .getAcl
      seq))

(defn- convert-raw-windows-sid
  [sid]
  (let [name (.getName sid)]
    (cond
      (instance? UserPrincipal sid)
        (str "USER:" name)
      (instance? GroupPrincipal sid)
        (str "GROUP:" name))))

(defn- convert-raw-windows-ace
  [ace]
  (if (contains? (.permissions ace) AclEntryPermission/READ_DATA)
    {:allow (= AclEntryType/ALLOW (.type ace))
     :sid (convert-raw-windows-sid (.principal ace))}))

(defn- windows-acl-from-path
  [path]
  (remove nil? (map convert-raw-windows-ace (raw-windows-acls path))))

(defn- posix-acl-from-path
  [path]
  (acl-from-attribute (read-attributes path)))

(defrecord RealFilesystem [root]
  vfs/Filesystem
  (get-permissions [fs entry]
    (let [fp (string/join "/" [(:root fs) entry])]
      (if is-windows
        (windows-acl-from-path fp)
        (posix-acl-from-path fp))))

  (stat [fs entry]
    (let [fp (string/join "/" [(:root fs) entry])
          attr (read-attributes fp)
          ct (fn [t] (/ (.toMillis t) 1000))]
      {:type (type-from-attribute attr)
       :size (.size attr)
       :mtime (ct (.lastModifiedTime attr))}))

  (join [fs parts]
    (string/join "/" parts))

  (listdir [fs dir]
    (let [fp (string/join "/" [(:root fs) dir])
          up (get-path fp)]
      (map #(-> % .getFileName str)
           (nio2.dir-seq/dir-seq up)))))

(defn filesystem-from-inisection
  [section]
  (let [path (section "path")]
    (when-not path
      (throw (Exception. "no path specified in section")))
    (RealFilesystem. path)))

(ns com.brainbot.real-fs
  (:require
   [clojure.string :as string])
  (:require [nio2.dir-seq])
  (:import [java.io File IOException FileNotFoundException]
           [java.nio.file Files Path LinkOption Paths]

           [java.nio.file.attribute UserPrincipal GroupPrincipal AclEntryType AclEntryPermission AclFileAttributeView PosixFilePermissions PosixFilePermission BasicFileAttributes PosixFileAttributes])

  (:require [com.brainbot.vfs :as vfs]))

(def ^:private is-windows
  (= "\\" File/separator))

(def ^:private no-follow-links
  (into-array [LinkOption/NOFOLLOW_LINKS]))

(defn- get-path
  [path & args]
  (Paths/get path (into-array String args)))

(defn- read-attributes
  [path]
  (Files/readAttributes (get-path path) PosixFileAttributes no-follow-links))

(defn- type-from-attribute
  [attr]
  (cond
    (.isDirectory attr)
      :directory
    (.isRegularFile attr)
      :file
    (.isSymbolicLink attr)
      :symbolic-link
    :else
      :other))

(defn- acl-from-posix-perm
  [owner-name group-name others-name perm]
  (reverse
   (drop-while  ;; drop deny rules from the end of the acl
    (complement :allow)
    (map (fn [name rperm]
           {:allow (contains? perm rperm)
            :sid name})
         [others-name group-name owner-name]
         [PosixFilePermission/OTHERS_READ
          PosixFilePermission/GROUP_READ
          PosixFilePermission/OWNER_READ]))))

(defn- acl-from-attribute
  [attr]
  (let [perm (.permissions attr)
        owner-name (str "USER:" (.getName (.owner attr)))
        group-name (str "GROUP:" (.getName (.group attr)))]
    (acl-from-posix-perm owner-name group-name "GROUP:AUTHENTICATED_USERS" perm)))

(defn- raw-windows-acls
  [path]
  (-> path
      get-path
      (Files/getFileAttributeView AclFileAttributeView (into-array LinkOption []))
      .getAcl
      seq))

(defn- convert-raw-windows-sid
  [sid]
  (let [name (.getName sid)]
    (cond
      (instance? UserPrincipal sid)
        (str "USER:" name)
      (instance? GroupPrincipal sid)
        (str "GROUP:" name))))

(defn- convert-raw-windows-ace
  [ace]
  (if (contains? (.permissions ace) AclEntryPermission/READ_DATA)
    {:allow (= AclEntryType/ALLOW (.type ace))
     :sid (convert-raw-windows-sid (.principal ace))}))

(defn- windows-acl-from-path
  [path]
  (remove nil? (map convert-raw-windows-ace (raw-windows-acls path))))

(defn- posix-acl-from-path
  [path]
  (acl-from-attribute (read-attributes path)))

(defn- collapse-consecutive-slash
  [s]
  (string/replace s #"/+" "/"))

(defn- trim-slash
  [s]
  (string/replace s #"^/+|/+$" ""))

(defn- normalize-path
  [path]
  (let [tmp (-> path
              collapse-consecutive-slash
              trim-slash)]
    (if (= "" tmp)
      "/"
      tmp)))

(defrecord RealFilesystem [root]
  vfs/Filesystem
  (get-permissions [fs entry]
    (let [fp (string/join "/" [(:root fs) entry])]
      (if is-windows
        (windows-acl-from-path fp)
        (posix-acl-from-path fp))))

  (stat [fs entry]
    (let [fp (string/join "/" [(:root fs) entry])
          attr (read-attributes fp)
          ct (fn [t] (/ (.toMillis t) 1000))]
      {:type (type-from-attribute attr)
       :size (.size attr)
       :mtime (ct (.lastModifiedTime attr))}))

  (join [fs parts]
    (normalize-path (string/join "/" parts)))

  (listdir [fs dir]
    (let [fp (string/join "/" [(:root fs) dir])
          up (get-path fp)]
      (map #(-> % .getFileName str)
           (nio2.dir-seq/dir-seq up)))))

(defn filesystem-from-inisection
  [section]
  (let [path (section "path")]
    (when-not path
      (throw (Exception. "no path specified in section")))
    (RealFilesystem. path)))

normalize path in realfs

normalize path in realfs


(ns wombats.game.player-stats)

(defn- add-player-scores
  [stats players]
  (reduce
   (fn [stats-acc [uuid {:keys [stats user wombat player]}]]
     (let [score (:stats/score stats)
           user (:user/github-username user)
           wombat (:wombat/name wombat)
           color (:player/color player)]
       (assoc stats-acc uuid {:score score
                              :username user
                              :wombat-name wombat
                              :color color})))
   stats players))

(defn- add-player-hp
  [stats arena]
  (let [player-ids (set (keys stats))]
    (reduce
     (fn [stats-acc cell]
       (let [cell-uuid (get-in cell [:contents :uuid])]
         (if (contains? player-ids cell-uuid)
           (assoc-in stats-acc [cell-uuid :hp] (get-in cell [:contents :hp]))
           stats-acc)))
     stats (flatten arena))))

(defn get-player-stats
  "Returns stats from game-state"
  [game-state]
  (-> {}
      (add-player-scores (:players game-state))
      (add-player-hp (get-in game-state [:frame
                                         :frame/arena]))
      vals))

(ns wombats.game.player-stats)

(defn- add-player-scores
  [stats players]
  (reduce
   (fn [stats-acc [uuid {:keys [stats user wombat player]}]]
     (let [score (:stats/score stats)
           user (:user/github-username user)
           wombat (:wombat/name wombat)
           color (:player/color player)]
       (assoc stats-acc uuid {:score score
                              :username user
                              :wombat-name wombat
                              :color color})))
   stats players))

(defn- add-player-hp
  [stats arena wombat-hp]
  (let [player-ids (set (keys stats))]
    (reduce
     (fn [stats-acc cell]
       (let [cell-uuid (get-in cell [:contents :uuid])]
         (if (contains? player-ids cell-uuid)
           (let [hp (get-in cell [:contents :hp])
                 percent (* (double (/ hp wombat-hp)) 100)]
             (assoc-in stats-acc [cell-uuid :hp] percent))
           stats-acc)))
     stats (flatten arena))))

(defn get-player-stats
  "Returns stats from game-state"
  [{:keys [players frame arena-config]}]
  (-> {}
      (add-player-scores players)
      (add-player-hp (:frame/arena frame)
                     (:arena/wombat-hp arena-config))
      vals))

send back percent for hp

send back percent for hp


(ns clj-ns-browser.test.core
  (:use [clj-ns-browser.core])
  (:use [clojure.test]))

(deftest replace-me ;; FIXME: write
  (is false "No tests have been written."))

(ns clj-ns-browser.test.core
  (:require [clj-ns-browser.browser :as b]
            [clj-ns-browser.utils :as u])
  (:use [clj-ns-browser.core])
  (:use [clojure.test]))

(deftest slash-symbol-fixup-checks
  (is (= "Function"
         (:object-type-str (b/better-get-docs-map "clojure.core//"))))
  (is (= #'clojure.core// (u/resolve-fqname "clojure.core//")))
  (is (= #'clojure.core// (u/resolve-fqname "clojure.core" "/")))
  (is (= "clojure.core//" (u/fqname 'clojure.core//)))
  (is (= "clojure.core//" (u/fqname '/)))
  (is (= "clojure.core//"
         (re-find #"^clojure\.core//"
                  (u/render-one-doc-text "clojure.core//" "Doc"))))
  )

Add some unit tests to verify some corner cases for the symbol clojure.core//

It shows up as a special case just about everywhere.