(ns clj-simple-chart.core
  (:gen-class
    :extends javafx.application.Application)
  (:require [hiccup.core :as hiccup]
            [digest :as digest]
            [clojure.string :as string]
            [clj-simple-chart.ticks :as ticks]
            )
  (:import (javafx.application Application Platform)
           (java.util.concurrent CountDownLatch)
           (javafx.scene.web WebView)
           (javafx.scene.layout VBox)
           (javafx.scene Scene SnapshotParameters)
           (javafx.geometry Rectangle2D)
           (javafx.embed.swing SwingFXUtils)
           (javax.imageio ImageIO)
           (java.io File)
           (javafx.concurrent Worker$State)))

(defonce latch (CountDownLatch. 1))
(defonce webview (atom nil))
(defonce stage (atom nil))
(defonce engine (atom nil))

(defn -start [this internal-stage]
  (.setTitle internal-stage "SVG Output")
  (let [internal-webview (WebView.)
        internal-engine (.getEngine internal-webview)
        layout (VBox. 0.0)
        children (.getChildren layout)]
    (.loadContent internal-engine "about:blank")
    (.setAll children [internal-webview])
    (.setScene internal-stage (Scene. layout))
    (.show internal-stage)
    (swap! engine (fn [x] internal-engine))
    (swap! stage (fn [x] internal-stage))
    (swap! webview (fn [x] internal-webview)))
  (Platform/runLater (fn [] (.countDown latch))))

(defn launch []
  (.start (Thread. (fn [] (Application/launch clj_simple_chart.core (into-array String []))))))

(defn style [& info]
  {:style (.trim (apply str (map #(let [[kwd val] %]
                                    (str (name kwd) ":" val "; "))
                                 (apply hash-map info))))})

(defn get-worker-state []
  (let [res (atom nil)
        ll (CountDownLatch. 1)]
    (Platform/runLater
      (fn []
        (swap! res (fn [x] (.getState (.getLoadWorker @engine))))
        (.countDown ll)))
    (.await ll)
    @res))

(defn wait-for-worker []
  (let [state (get-worker-state)]
    (cond (= Worker$State/SUCCEEDED state) state
          (= Worker$State/FAILED state) state
          (= Worker$State/CANCELLED state) state
          :else (do (Thread/sleep 10) (recur)))))

(defn bootstrap []
  (if @engine
    nil
    (do
      (launch)
      (.await latch))))

(defn render-string [s]
  (Platform/runLater (fn [] (.loadContent @engine s "text/html")))
  (wait-for-worker))

(defn translate [x y]
  (str "translate(" x "," y ")"))

(defn export-to-file [filename t]
  (let [s (hiccup.core/html t)]
    (spit filename s)))

(defn render
  ([filename t]
   (export-to-file filename t)
   (render t)
   (Platform/runLater (fn [] (.setTitle @stage filename))))
  ([t]
   (let [body [:body (style
                       :margin "0 !important"
                       :padding "0 !important"
                       :overflow-x "hidden"
                       :overflow-y "hidden")]
         attrs (second t)
         width (:width attrs)
         height (:height attrs)
         s (hiccup.core/html (conj body t))]
     (bootstrap)
     (Platform/runLater (fn [] (.setPrefHeight @webview height)))
     (Platform/runLater (fn [] (.setPrefWidth @webview width)))
     (render-string s)
     (Platform/runLater (fn [] (.sizeToScene @stage)))
     (Platform/runLater (fn [] (.show @stage)))
     s)))

(defn render-to-file [filename t]
  (let [ll (CountDownLatch. 1)
        attrs (second t)
        width (:width attrs)
        height (:height attrs)]
    (render t)
    (Platform/runLater
      (fn []
        (let [snap (SnapshotParameters.)]
          (.setViewport snap (Rectangle2D. 0 0 width height))
          (let [image (.snapshot @webview snap nil)
                bufimage (SwingFXUtils/fromFXImage image nil)]
            (ImageIO/write bufimage "png" (File. filename))
            (println "\nwrote " filename "md5=" (digest/md5 (File. filename)))))))
    (Platform/runLater (fn [] (.countDown ll)))
    (.await ll)))

(defn exit []
  (println "exiting ...")
  (Platform/runLater (fn [] (.close @stage)))
  (Platform/exit))

(defn scale-linear
  [{domain :domain range :range :as all}]
  (->
    (fn [x]
      (let [domain-size (- (last domain) (first domain))
            domain-offset (- x (first domain))
            domain-relative (/ domain-offset domain-size)
            range-size (- (last range) (first range))
            range-output (+ (first range) (* domain-relative range-size))]
        range-output))
    (with-meta all)))

(defn number-of-decimals [scale]
  (let [domain (:domain (meta scale))
        domain-diff (Math/abs (apply - domain))]
    (cond (>= domain-diff 8) 0
          (>= domain-diff 1) 1
          :else 2)))

(defn scale-format [scale v]
  (format (str "%." (number-of-decimals scale) "f") v))

(defn left-y-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M-6," (apply max range) ".5 H0.5 V0.5 H-6")}]
     (map (fn [d] [:g {:transform (translate 0 (scale d))}
                   [:line {:stroke color :x2 -6 :y1 0.5 :y2 0.5}]
                   [:text {:x           -9
                           :text-anchor "end"
                           :fill        color
                           :dy          ".32em"
                           :y           0.5}
                    (fmt d)]]) tiks)]))

(defn right-y-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M6," (apply max range) ".5 H0.5 V0.5 H6")}]
     (map (fn [d] [:g {:transform (translate 0 (scale d))}
                   [:line {:stroke color :x2 6 :y1 0.5 :y2 0.5}]
                   [:text {:x           9
                           :text-anchor "start"
                           :fill        color
                           :dy          ".32em"
                           :y           0.5}
                    (fmt d)]]) tiks)]))

(defn bottom-x-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M0.5,6 V0.5 H" (apply max range) ".5 V6")}]
     (map (fn [d] [:g {:transform (translate (scale d) 0)}
                   [:line {:stroke color :x1 0.5 :x2 0.5 :y2 6}]
                   [:text {:x           0.5
                           :text-anchor "middle"
                           :fill        color
                           :dy          ".71em"
                           :y           9}
                    (fmt d)]]) tiks)]))

(defn top-x-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M0.5,-6 V0.5 H" (apply max range) ".5 V-6")}]
     (map (fn [d] [:g {:transform (translate (scale d) 0)}
                   [:line {:stroke color :x1 0.5 :x2 0.5 :y2 -6}]
                   [:text {:x           0.5
                           :text-anchor "middle"
                           :fill        color
                           :dy          "0em"
                           :y           -9}
                    (fmt d)]]) tiks)]))

(def width 470)
(def height 470)
(def margin {:top 50 :bottom 50 :left 60 :right 60})

(def y (scale-linear {:color "red" :domain [0 100] :range [height 0]}))
(def y2 (scale-linear {:color "blue" :domain [0 1.69] :range [height 0]}))
(def x (scale-linear {:color "green" :domain [0 100] :range [0 width]}))
(def x-top (scale-linear {:color "fuchsia" :domain [0 8] :range [0 width]}))

(defn path [points]
  (str "M"
       (string/join " L" points)))

(defn dotted-line [{fill :fill stroke :stroke} points]
  [:g
   [:path {:d (path (map (fn [[x y]] (str x "," y)) points))
           :fill "none"
           :stroke stroke
           :stroke-width 2}]
   (map (fn [[x y]]
          [:circle
           {:fill fill
            :stroke stroke
            :stroke-width 2
            :r 5
            :cx x
            :cy y}])
        points)])

(defn diagram
  []
  [:svg {:width  (+ (:left margin) (:right margin) width)
         :height (+ (:top margin) (:bottom margin) height)
         :xmlns  "http://www.w3.org/2000/svg"}
   [:g {:transform (translate (:left margin) (:top margin))}
    [:g (left-y-axis y)]
    [:g {:transform (translate width 0)} (right-y-axis y2)]
    [:g {:transform (translate 0 height)} (bottom-x-axis x)]
    [:g (top-x-axis x-top)]
    (dotted-line {:fill "yellow"
                  :stroke "black"}
                 (map (fn [d] [(x d) (y d)]) (range 0 100 10)))
    ]])

(ns clj-simple-chart.core
  (:gen-class
    :extends javafx.application.Application)
  (:require [hiccup.core :as hiccup]
            [digest :as digest]
            [clojure.string :as string]
            [clj-simple-chart.ticks :as ticks]
            )
  (:import (javafx.application Application Platform)
           (java.util.concurrent CountDownLatch)
           (javafx.scene.web WebView)
           (javafx.scene.layout VBox)
           (javafx.scene Scene SnapshotParameters)
           (javafx.geometry Rectangle2D)
           (javafx.embed.swing SwingFXUtils)
           (javax.imageio ImageIO)
           (java.io File)
           (javafx.concurrent Worker$State)))

(defonce latch (CountDownLatch. 1))
(defonce webview (atom nil))
(defonce stage (atom nil))
(defonce engine (atom nil))

(defn -start [this internal-stage]
  (.setTitle internal-stage "SVG Output")
  (let [internal-webview (WebView.)
        internal-engine (.getEngine internal-webview)
        layout (VBox. 0.0)
        children (.getChildren layout)]
    (.loadContent internal-engine "about:blank")
    (.setAll children [internal-webview])
    (.setScene internal-stage (Scene. layout))
    (.show internal-stage)
    (swap! engine (fn [x] internal-engine))
    (swap! stage (fn [x] internal-stage))
    (swap! webview (fn [x] internal-webview)))
  (Platform/runLater (fn [] (.countDown latch))))

(defn launch []
  (.start (Thread. (fn [] (Application/launch clj_simple_chart.core (into-array String []))))))

(defn style [& info]
  {:style (.trim (apply str (map #(let [[kwd val] %]
                                    (str (name kwd) ":" val "; "))
                                 (apply hash-map info))))})

(defn get-worker-state []
  (let [res (atom nil)
        ll (CountDownLatch. 1)]
    (Platform/runLater
      (fn []
        (swap! res (fn [x] (.getState (.getLoadWorker @engine))))
        (.countDown ll)))
    (.await ll)
    @res))

(defn wait-for-worker []
  (let [state (get-worker-state)]
    (cond (= Worker$State/SUCCEEDED state) state
          (= Worker$State/FAILED state) state
          (= Worker$State/CANCELLED state) state
          :else (do (Thread/sleep 10) (recur)))))

(defn bootstrap []
  (if @engine
    nil
    (do
      (launch)
      (.await latch))))

(defn render-string [s]
  (Platform/runLater (fn [] (.loadContent @engine s "text/html")))
  (wait-for-worker))

(defn translate [x y]
  (str "translate(" x "," y ")"))

(defn export-to-file [filename t]
  (let [s (hiccup.core/html t)]
    (spit filename s)))

(defn render
  ([filename t]
   (export-to-file filename t)
   (render t)
   (Platform/runLater (fn [] (.setTitle @stage filename))))
  ([t]
   (let [body [:body (style
                       :margin "0 !important"
                       :padding "0 !important"
                       :overflow-x "hidden"
                       :overflow-y "hidden")]
         attrs (second t)
         width (:width attrs)
         height (:height attrs)
         s (hiccup.core/html (conj body t))]
     (bootstrap)
     (Platform/runLater (fn [] (.setPrefHeight @webview height)))
     (Platform/runLater (fn [] (.setPrefWidth @webview width)))
     (render-string s)
     (Platform/runLater (fn [] (.sizeToScene @stage)))
     (Platform/runLater (fn [] (.show @stage)))
     s)))

(defn render-to-file [filename t]
  (let [ll (CountDownLatch. 1)
        attrs (second t)
        width (:width attrs)
        height (:height attrs)]
    (render t)
    (Platform/runLater
      (fn []
        (let [snap (SnapshotParameters.)]
          (.setViewport snap (Rectangle2D. 0 0 width height))
          (let [image (.snapshot @webview snap nil)
                bufimage (SwingFXUtils/fromFXImage image nil)]
            (ImageIO/write bufimage "png" (File. filename))
            (println "\nwrote " filename "md5=" (digest/md5 (File. filename)))))))
    (Platform/runLater (fn [] (.countDown ll)))
    (.await ll)))

(defn exit []
  (println "exiting ...")
  (Platform/runLater (fn [] (.close @stage)))
  (Platform/exit))

(defn scale-linear
  [{domain :domain range :range :as all}]
  (->
    (fn [x]
      (let [domain-size (- (last domain) (first domain))
            domain-offset (- x (first domain))
            domain-relative (/ domain-offset domain-size)
            range-size (- (last range) (first range))
            range-output (+ (first range) (* domain-relative range-size))]
        range-output))
    (with-meta all)))

(defn number-of-decimals [scale]
  (let [domain (:domain (meta scale))
        domain-diff (Math/abs (apply - domain))]
    (cond (>= domain-diff 8) 0
          (>= domain-diff 1) 1
          :else 2)))

(defn scale-format [scale v]
  (format (str "%." (number-of-decimals scale) "f") v))

(defn left-y-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M-6," (apply max range) ".5 H0.5 V0.5 H-6")}]
     (map (fn [d] [:g {:transform (translate 0 (scale d))}
                   [:line {:stroke color :x2 -6 :y1 0.5 :y2 0.5}]
                   [:text {:x           -9
                           :text-anchor "end"
                           :fill        color
                           :dy          ".32em"
                           :y           0.5}
                    (fmt d)]]) tiks)]))

(defn right-y-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M6," (apply max range) ".5 H0.5 V0.5 H6")}]
     (map (fn [d] [:g {:transform (translate 0 (scale d))}
                   [:line {:stroke color :x2 6 :y1 0.5 :y2 0.5}]
                   [:text {:x           9
                           :text-anchor "start"
                           :fill        color
                           :dy          ".32em"
                           :y           0.5}
                    (fmt d)]]) tiks)]))

(defn bottom-x-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M0.5,6 V0.5 H" (apply max range) ".5 V6")}]
     (map (fn [d] [:g {:transform (translate (scale d) 0)}
                   [:line {:stroke color :x1 0.5 :x2 0.5 :y2 6}]
                   [:text {:x           0.5
                           :text-anchor "middle"
                           :fill        color
                           :dy          ".71em"
                           :y           9}
                    (fmt d)]]) tiks)]))

(defn top-x-axis [scale]
  (let [domain (:domain (meta scale))
        color (get (meta scale) :color "#000")
        range (:range (meta scale))
        fmt (partial scale-format scale)
        tiks (apply ticks/ticks domain)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M0.5,-6 V0.5 H" (apply max range) ".5 V-6")}]
     (map (fn [d] [:g {:transform (translate (scale d) 0)}
                   [:line {:stroke color :x1 0.5 :x2 0.5 :y2 -6}]
                   [:text {:x           0.5
                           :text-anchor "middle"
                           :fill        color
                           :dy          "0em"
                           :y           -9}
                    (fmt d)]]) tiks)]))

(def width 470)
(def height 470)
(def margin {:top 50 :bottom 50 :left 60 :right 60})

(def y (scale-linear {:color "red" :domain [0 100] :range [height 0]}))
(def y2 (scale-linear {:color "blue" :domain [0 1.69] :range [height 0]}))
(def x (scale-linear {:color "green" :domain [0 100] :range [0 width]}))
(def x-top (scale-linear {:color "fuchsia" :domain [0 8] :range [0 width]}))

(defn path [points]
  (str "M"
       (string/join " L" points)))

(defn line
  ([points]
   (line {:fill "none" :stroke "#000" :stroke-width 1} points))
  ([props points]
   [:path (assoc props :d (path (map (fn [[x y]] (str x "," y)) points)))]))

(defn dotted-line [{fill :fill stroke :stroke} points]
  [:g
   (line {:fill "none" :stroke stroke :stroke-width 2} points)
   (map (fn [[x y]]
          [:circle
           {:fill fill
            :stroke stroke
            :stroke-width 2
            :r 5
            :cx x
            :cy y}])
        points)])

(defn diagram
  []
  [:svg {:width  (+ (:left margin) (:right margin) width)
         :height (+ (:top margin) (:bottom margin) height)
         :xmlns  "http://www.w3.org/2000/svg"}
   [:g {:transform (translate (:left margin) (:top margin))}
    [:g (left-y-axis y)]
    [:g {:transform (translate width 0)} (right-y-axis y2)]
    [:g {:transform (translate 0 height)} (bottom-x-axis x)]
    [:g (top-x-axis x-top)]
    (dotted-line {:fill "yellow"
                  :stroke "black"}
                 (map (fn [d] [(x d) (y d)]) (range 0 100 10)))
    ]])

Add line functionalityˆˆ

Add line functionalityˆˆ


(ns discuss.utils.common
  (:require [om.core :as om :include-macros true]
            [clojure.walk :refer [keywordize-keys]]
            [cognitect.transit :as transit]
            [discuss.config :as config]
            [goog.fx.dom :as fx]))

(defn prefix-name
  "Create unique id for DOM elements."
  [name]
  (str config/project "-" name))

(defonce app-state
  (atom {:discussion {}
         :issues     {}
         :items      {}
         :layout     {:title     "discuss"
                      :intro     "The current discussion is about:"
                      :template  :discussion
                      :add?      false
                      :add-text  "Let me enter my reason!"
                      :add-type  nil
                      :loading?  false
                      :reference ""
                      :error?    false
                      :error-msg nil}
         :debug      {:last-api ""}
         :user       {:nickname   "kangaroo"
                      :token      "razupaltuff"
                      :csrf       nil
                      :statement  ""
                      :selection  nil
                      :logged-in? false}
         :clipboard  {:selections nil
                      :current    nil}
         :sidebar    {:show? true}
         }))

;; Get
(defn get-cursor
  "Return a cursor to the corresponding key in the app-state."
  [key]
  (om/ref-cursor (key (om/root-cursor app-state))))

(defn get-nickname
  "Return the user's nickname, with whom she logged in."
  []
  (get-in @app-state [:user :nickname]))

(defn get-token
  "Return the user's token for discussion system."
  []
  (get-in @app-state [:user :token]))

(defn get-issues
  "Returns list of dictionaries with all available issues."
  []
  (get-in @app-state [:issues :all]))

(defn get-bubbles
  "Return message bubbles from DBAS."
  []
  (get-in @app-state [:discussion :bubbles]))

(defn get-add-text
  "Return message for adding new statements."
  []
  (get-in @app-state [:layout :add-text]))

(defn get-add-premise-text
  "Return text for adding new premise."
  []
  (get-in @app-state [:discussion :add_premise_text]))

;; Booleans
(defn logged-in?
  "Return true if user is logged in."
  []
  (get-in @app-state [:user :logged-in?]))

;; State changing
(defn update-state-item!
  "Get the cursor for given key and select a field to apply the function to it."
  [col key f]
  (om/transact! (get-cursor col) key f))

(defn update-state-map!
  "Get the cursor for given key and update it with the new collection of data."
  [key col]
  (let [state (get-cursor key)]
    (om/transact! state (fn [] col))))

;;;; CSRF Token
(defn get-csrf
  "Return the user's csrf token for discussion system."
  []
  (get-in @app-state [:user :csrf]))

(defn set-csrf!
  "Set the newly received CSRF token."
  [csrf]
  (update-state-item! :user :csrf (fn [_] csrf)))

(defn loading?
  "Return boolean if app is currently loading content. Provide a boolean to change the app-state."
  ([]
   (get-in @app-state [:layout :loading?]))
  ([bool]
   (update-state-item! :layout :loading? (fn [_] bool))))

(defn update-all-states!
  "Update item list with the data provided by the API.

  ** Needs optimizations **"
  [response]
  (let [res (keywordize-keys response)
        items (:items res)
        discussion (:discussion res)
        issues (:issues res)]
    (loading? false)
    (update-state-map! :items items)
    (update-state-map! :discussion discussion)
    (update-state-map! :issues issues)
    (update-state-item! :debug :response (fn [_] res))))

;; Show error messages
(defn error?
  "Return boolean indicating if there are errors or not. Provide a boolean to change the app-state."
  ([]
   (get-in @app-state [:layout :error?]))
  ([bool]
   (update-state-item! :layout :error? (fn [_] bool))))

(defn error-msg!
  "Set error message."
  [msg]
  (when (pos? (count msg))
    (error? true))
  (update-state-item! :layout :error-msg (fn [_] msg)))

(defn no-error!
  "Macro to remove all error warnings."
  []
  (error? false)
  (error-msg! nil))

(defn get-error
  "Return error message."
  []
  (get-in @app-state [:layout :error-msg]))

;; Change views
(defn change-view!
  "Switch to a different view."
  [view]
  (update-state-item! :layout :template (fn [_] view)))

(defn show-add-form
  "Shows a form to enable user-added content."
  []
  (when (logged-in?)
    (update-state-item! :layout :add? (fn [_] true))))

(defn hide-add-form
  "Hide the user form."
  []
  (update-state-item! :layout :add? (fn [_] false)))

;; Mouse interaction
(defn get-selection
  "Return the stored selection of the user."
  []
  (get-in @app-state [:user :selection]))

(defn save-mouse-position
  "Store mouse position."
  [[x y]]
  (update-state-item! :user :mouse-x (fn [_] x))
  (update-state-item! :user :mouse-y (fn [_] y)))

;;;; Other
(defn get-value-by-id
  "Return value of element matching the id."
  [id]
  (let [element (.getElementById js/document (prefix-name id))]
    (when element (.-value element))))

(defn log
  "Print argument as JS object to be accessible from the console."
  [arg]
  (.log js/console arg))

(defn substring?
  "Evaluates if a substring is contained in the given string."
  [sub st]
  (not= (.indexOf st sub) -1))

(defn str->int
  "Convert String to Integer."
  [s]
  (js/parseInt s))

;;;; CSS modifications
(defn toggle-class
  "Toggle CSS class of provided DOM element. A third paramenter as boolean can be provided to
   force removing or adding the class."
  ([dom-element class]
   (.classList/toggle dom-element class))
  ([dom-element class bool]
   (.classList/toggle dom-element class bool)))

(defn remove-class
  "Remove a specific class of a DOM element."
  [dom-element class]
  (toggle-class dom-element class false))

(defn add-class
  "Add a specific class to a DOM element."
  [dom-element class]
  (toggle-class dom-element class true))

;;;; CLJS to JS
(defn clj->json
  "Convert CLJS to valid JSON."
  [col]
  (.stringify js/JSON (clj->js col)))

(defn json->clj
  "Use cognitec's transit reader for json to convert it to proper Clojure datastructures."
  [response]
  (let [r (transit/reader :json)]
    (keywordize-keys (transit/read r response))))

(ns discuss.utils.common
  (:require [om.core :as om :include-macros true]
            [clojure.walk :refer [keywordize-keys]]
            [cognitect.transit :as transit]
            [discuss.config :as config]
            [goog.fx.dom :as fx]))

(defn prefix-name
  "Create unique id for DOM elements."
  [name]
  (str config/project "-" name))

(defonce app-state
  (atom {:discussion {}
         :issues     {}
         :items      {}
         :layout     {:title     "discuss"
                      :intro     "The current discussion is about:"
                      :template  :discussion
                      :add?      false
                      :add-text  "Let me enter my reason!"
                      :add-type  nil
                      :loading?  false
                      :reference ""
                      :error?    false
                      :error-msg nil}
         :debug      {:last-api ""}
         :user       {:nickname   "kangaroo"
                      :token      "razupaltuff"
                      :csrf       nil
                      :statement  ""
                      :selection  nil
                      :logged-in? false}
         :clipboard  {:selections nil
                      :current    nil}
         :sidebar    {:show? true}
         }))

(defn str->int
  "Convert String to Integer."
  [s]
  (let [converted (js/parseInt s)]
    (when-not (js/isNaN converted)
      converted)))

;; Get
(defn get-cursor
  "Return a cursor to the corresponding key in the app-state."
  [key]
  (om/ref-cursor (key (om/root-cursor app-state))))

(defn get-nickname
  "Return the user's nickname, with whom she logged in."
  []
  (get-in @app-state [:user :nickname]))

(defn get-token
  "Return the user's token for discussion system."
  []
  (get-in @app-state [:user :token]))

(defn get-issues
  "Returns list of dictionaries with all available issues."
  []
  (get-in @app-state [:issues :all]))

(defn get-issue
  "Return specific issue, matching by id."
  [issue]
  (first (filter #(= (str->int (:uid %)) issue) (get-issues))))

(defn get-bubbles
  "Return message bubbles from DBAS."
  []
  (get-in @app-state [:discussion :bubbles]))

(defn get-add-text
  "Return message for adding new statements."
  []
  (get-in @app-state [:layout :add-text]))

(defn get-add-premise-text
  "Return text for adding new premise."
  []
  (get-in @app-state [:discussion :add_premise_text]))

;; Booleans
(defn logged-in?
  "Return true if user is logged in."
  []
  (get-in @app-state [:user :logged-in?]))

;; State changing
(defn update-state-item!
  "Get the cursor for given key and select a field to apply the function to it."
  [col key f]
  (om/transact! (get-cursor col) key f))

(defn update-state-map!
  "Get the cursor for given key and update it with the new collection of data."
  [key col]
  (let [state (get-cursor key)]
    (om/transact! state (fn [] col))))

;;;; CSRF Token
(defn get-csrf
  "Return the user's csrf token for discussion system."
  []
  (get-in @app-state [:user :csrf]))

(defn set-csrf!
  "Set the newly received CSRF token."
  [csrf]
  (update-state-item! :user :csrf (fn [_] csrf)))

(defn loading?
  "Return boolean if app is currently loading content. Provide a boolean to change the app-state."
  ([]
   (get-in @app-state [:layout :loading?]))
  ([bool]
   (update-state-item! :layout :loading? (fn [_] bool))))

(defn update-all-states!
  "Update item list with the data provided by the API.

  ** Needs optimizations **"
  [response]
  (let [res (keywordize-keys response)
        items (:items res)
        discussion (:discussion res)
        issues (:issues res)]
    (loading? false)
    (update-state-map! :items items)
    (update-state-map! :discussion discussion)
    (update-state-map! :issues issues)
    (update-state-item! :debug :response (fn [_] res))))

;; Show error messages
(defn error?
  "Return boolean indicating if there are errors or not. Provide a boolean to change the app-state."
  ([]
   (get-in @app-state [:layout :error?]))
  ([bool]
   (update-state-item! :layout :error? (fn [_] bool))))

(defn error-msg!
  "Set error message."
  [msg]
  (when (pos? (count msg))
    (error? true))
  (update-state-item! :layout :error-msg (fn [_] msg)))

(defn no-error!
  "Macro to remove all error warnings."
  []
  (error? false)
  (error-msg! nil))

(defn get-error
  "Return error message."
  []
  (get-in @app-state [:layout :error-msg]))

;; Change views
(defn change-view!
  "Switch to a different view."
  [view]
  (update-state-item! :layout :template (fn [_] view)))

(defn show-add-form
  "Shows a form to enable user-added content."
  []
  (when (logged-in?)
    (update-state-item! :layout :add? (fn [_] true))))

(defn hide-add-form
  "Hide the user form."
  []
  (update-state-item! :layout :add? (fn [_] false)))

;; Mouse interaction
(defn get-selection
  "Return the stored selection of the user."
  []
  (get-in @app-state [:user :selection]))

(defn save-mouse-position
  "Store mouse position."
  [[x y]]
  (update-state-item! :user :mouse-x (fn [_] x))
  (update-state-item! :user :mouse-y (fn [_] y)))

;;;; Other
(defn get-value-by-id
  "Return value of element matching the id."
  [id]
  (let [element (.getElementById js/document (prefix-name id))]
    (when element (.-value element))))

(defn log
  "Print argument as JS object to be accessible from the console."
  [arg]
  (.log js/console arg))

(defn substring?
  "Evaluates if a substring is contained in the given string."
  [sub st]
  (not= (.indexOf st sub) -1))

;;;; CSS modifications
(defn toggle-class
  "Toggle CSS class of provided DOM element. A third paramenter as boolean can be provided to
   force removing or adding the class."
  ([dom-element class]
   (.classList/toggle dom-element class))
  ([dom-element class bool]
   (.classList/toggle dom-element class bool)))

(defn remove-class
  "Remove a specific class of a DOM element."
  [dom-element class]
  (toggle-class dom-element class false))

(defn add-class
  "Add a specific class to a DOM element."
  [dom-element class]
  (toggle-class dom-element class true))

;;;; CLJS to JS
(defn clj->json
  "Convert CLJS to valid JSON."
  [col]
  (.stringify js/JSON (clj->js col)))

(defn json->clj
  "Use cognitec's transit reader for json to convert it to proper Clojure datastructures."
  [response]
  (let [r (transit/reader :json)]
    (keywordize-keys (transit/read r response))))

Add fn get-issue

Add fn get-issue


(ns onyx-dashboard.components.deployment
  (:require [om.core :as om :include-macros true]
            [om-tools.dom :as dom :include-macros true]
            [om-tools.core :refer-macros [defcomponent]]
            [om-bootstrap.panel :as p]
            [om-bootstrap.button :as b]
            [om-bootstrap.table :as t]
            [om-bootstrap.grid :as g]
            [shoreleave.browser.blob :as blob]
            [onyx-dashboard.components.ui-elements :refer [section-header-collapsible]]
            [cljs.core.async :as async :refer [put!]]
            [cljsjs.moment]
            [cljs.core.async :as async :refer [<! >! put! chan]])
  (:require-macros [cljs.core.async.macros :as asyncm :refer [go-loop]]))

(defcomponent peer-table [peers owner]
  (render [_]
          (if (empty? peers)
            (dom/div "No peers are currently running")
            (t/table {:striped? true :bordered? false :condensed? true :hover? true}
                     (dom/thead (dom/tr (dom/th "ID")))
                     (dom/tbody
                       (for [peer-id peers]
                         (dom/tr {:class "peer-entry"}
                                 (dom/td (str peer-id)))))))))

(defcomponent deployment-indicator [{:keys [deployment last-entry]} owner]
  (render [_]
          (let [crashed? (= :crashed (:status (:status deployment)))
                onyx-logo-rotation (mod (* (:message-id last-entry)
                                           10)
                                        360)
                rotation-css (str "rotate(" onyx-logo-rotation "deg)")]
            (dom/div
              (p/panel
                {:header (dom/div {} (dom/h4 {:class "unselectable"} "Dashboard Status"))
                 :bs-style (if (or crashed? (not (:up-to-date? deployment)))  "danger" "primary")}
                (dom/div
                  (if crashed?
                    (dom/div "Log replay crashed. Cluster probably died if the dashboard is using the same version of Onyx."
                             (dom/pre {}
                                      (:error (:status deployment)))))
                  (dom/div
                    (dom/img {:style {:-ms-transform rotation-css
                                      :-webkit-transform rotation-css
                                      :transform rotation-css
                                      :margin-right "10px"}
                              :src "/img/high-res.png" :height 25 :width 25})
                    (if-let [entry-time (:created-at last-entry)]
                      (str "Dashboard last updated " (.fromNow (js/moment (str (js/Date. entry-time)))))))))))))

(defcomponent deployment-peers [deployment owner]
  (render [_]
          (p/panel
            {:header (om/build section-header-collapsible {:text "Deployment Peers"} {})
             :collapsible? true
             :bs-style "primary"}
            (if (and (:id deployment)
                     (:up? deployment))
              (om/build peer-table (:peers deployment) {})
              (dom/div "Deployment has no pulse.")))))

(defn strip-catalog [catalog task-rename]
  (mapv (fn [entry]
          (-> entry
              (update-in [:onyx/name] task-rename)
              (select-keys [:onyx/name :onyx/type :onyx/ident
                            :onyx/medium :onyx/consumption
                            :onyx/batch-size])))
          catalog))

(defn replace-in-workflow [workflow translation]
  (mapv (fn [[from to]]
          [(translation from) (translation to)])
        workflow))

(defn workflow->task-rename-map [workflow]
  (zipmap (distinct (flatten workflow))
          (map (comp keyword str) (range))))

(defn publicise-jobs [jobs]
  (mapv (fn [{:keys [workflow catalog] :as job}]
          (let [task-rename (workflow->task-rename-map workflow)]
            (-> job
                (dissoc :pretty-workflow
                        :pretty-catalog
                        :tracking-id)
                (update-in [:workflow] replace-in-workflow task-rename)
                (update-in [:catalog] strip-catalog task-rename))))
        (vals jobs)))

(defn entries->log-dump [entries]
  (vec (sort-by :message-id (vals entries))))

(defn serialize [v]
  (vector (pr-str v)))

(defcomponent download-with-filename
  "Gross hack to enable blobs to be saved with a particular filename.
  Unfortunately, the only way to provide a filename is with a link that gets clicked.
  window.open on the blob object-url doens't currently work"
  [{:keys [data filename]} owner {:keys [parent-ch]}]
  (did-mount [_]
             (.click (om/get-node owner))
             (put! parent-ch :done))
  (render [_]
          (dom/a {:href (blob/object-url!
                          (blob/blob (serialize data)
                                     "application/octet-stream"))
                  :download filename}
                 "Save")))

(defcomponent deployment-log-dump [{:keys [entries jobs id status] :as deployment} owner]
  (init-state [_]
              {:download-type nil :download-ch (chan)})
  (will-mount [_]
              (go-loop []
                       (let [msg (<! (om/get-state owner :download-ch))]
                         (if (= msg :done)
                           (om/set-state! owner :download-type nil)))))
  (render-state [_ {:keys [download-type download-ch]}]
                (dom/div
                  (case download-type
                    :raw-dump (om/build download-with-filename
                                        {:data {:deployment-status status
                                                :jobs jobs
                                                :log (entries->log-dump entries)}
                                         :filename (str "dump_" id "_raw.edn")}
                                        {:opts {:parent-ch download-ch}})
                    :stripped-dump (om/build download-with-filename
                                             {:data {:deployment-status status
                                                     :jobs (publicise-jobs jobs)
                                                     :log (entries->log-dump entries)}
                                              :filename (str "dump_" id "_stripped.edn")}
                                             {:opts {:parent-ch download-ch}})
                    (dom/div))
                  (p/panel
                    {:header "Deployment Log Dump"
                     :collapsible? true
                     :bs-style "primary"}
                    (t/table {:striped? true :bordered? false :condensed? true :hover? true}
                             (dom/thead (dom/tr (dom/th "Type") (dom/th)))
                             (dom/tbody
                               (dom/tr
                                 (dom/td "Raw")
                                 (dom/td
                                   (dom/a {:on-click (fn [_] (om/set-state! owner :download-type :raw-dump))}
                                          "Save")))
                               (dom/tr
                                 (dom/td "Stripped of catalog parameterisations")
                                 (dom/td
                                   (dom/a {:on-click (fn [_] (om/set-state! owner :download-type :stripped-dump))}
                                          "Save")))))
                    "WARNING: We make a best effort attempt to strip catalog parameterisation and task names. "
                    "If these may include private information, please inspect the :jobs value "
                    "in the dump before making it public."))))

(defcomponent select-deployment [{:keys [deployments deployment]} owner]
  (render [_]
          (dom/div {:class "btn-group btn-group-justified" :role "group"}
                   (apply (partial b/dropdown {:bs-style "default"
                                               :title (or (:id deployment) "Select Deployment")})
                          (for [[id info] (reverse (sort-by (comp :created-at val)
                                                            deployments))]
                            (b/menu-item {:key id
                                          :on-select (fn [_]
                                                       (put! (om/get-shared owner :api-ch)
                                                             [:track-deployment id]))}
                                         id))))))

(ns onyx-dashboard.components.deployment
  (:require [om.core :as om :include-macros true]
            [om-tools.dom :as dom :include-macros true]
            [om-tools.core :refer-macros [defcomponent]]
            [om-bootstrap.panel :as p]
            [om-bootstrap.button :as b]
            [om-bootstrap.table :as t]
            [om-bootstrap.grid :as g]
            [shoreleave.browser.blob :as blob]
            [onyx-dashboard.components.ui-elements :refer [section-header-collapsible]]
            [cljs.core.async :as async :refer [put!]]
            [cljsjs.moment]
            [cljs.core.async :as async :refer [<! >! put! chan]])
  (:require-macros [cljs.core.async.macros :as asyncm :refer [go-loop]]))

(defcomponent peer-table [peers owner]
  (render [_]
          (if (empty? peers)
            (dom/div "No peers are currently running")
            (t/table {:striped? true :bordered? false :condensed? true :hover? true}
                     (dom/thead (dom/tr (dom/th "ID")))
                     (dom/tbody
                       (for [peer-id peers]
                         (dom/tr {:class "peer-entry"}
                                 (dom/td (str peer-id)))))))))

(defcomponent deployment-indicator [{:keys [deployment last-entry]} owner]
  (render [_]
          (let [crashed? (= :crashed (:status (:status deployment)))
                onyx-logo-rotation (mod (* (:message-id last-entry)
                                           10)
                                        360)
                rotation-css (str "rotate(" onyx-logo-rotation "deg)")]
            (dom/div
              (p/panel
                {:header (dom/div {} (dom/h4 {:class "unselectable"} "Dashboard Status"))
                 :bs-style (if (or crashed? (not (:up-to-date? deployment)))  "danger" "primary")}
                (dom/div
                  (if crashed?
                    (dom/div "Log replay crashed. Cluster probably crashed, assuming the dashboard is using the same version of Onyx."
                             (dom/pre {}
                                      (:error (:status deployment)))))
                  (dom/div
                    (dom/img {:style {:-ms-transform rotation-css
                                      :-webkit-transform rotation-css
                                      :transform rotation-css
                                      :margin-right "10px"}
                              :src "/img/high-res.png" :height 25 :width 25})
                    (if-let [entry-time (:created-at last-entry)]
                      (str "Dashboard last updated " (.fromNow (js/moment (str (js/Date. entry-time)))))))))))))

(defcomponent deployment-peers [deployment owner]
  (render [_]
          (p/panel
            {:header (om/build section-header-collapsible {:text "Deployment Peers"} {})
             :collapsible? true
             :bs-style "primary"}
            (if (and (:id deployment)
                     (:up? deployment))
              (om/build peer-table (:peers deployment) {})
              (dom/div "Deployment has no pulse.")))))

(defn strip-catalog [catalog task-rename]
  (mapv (fn [entry]
          (-> entry
              (update-in [:onyx/name] task-rename)
              (select-keys [:onyx/name :onyx/type :onyx/ident
                            :onyx/medium :onyx/consumption
                            :onyx/batch-size])))
          catalog))

(defn replace-in-workflow [workflow translation]
  (mapv (fn [[from to]]
          [(translation from) (translation to)])
        workflow))

(defn workflow->task-rename-map [workflow]
  (zipmap (distinct (flatten workflow))
          (map (comp keyword str) (range))))

(defn publicise-jobs [jobs]
  (mapv (fn [{:keys [workflow catalog] :as job}]
          (let [task-rename (workflow->task-rename-map workflow)]
            (-> job
                (dissoc :pretty-workflow
                        :pretty-catalog
                        :tracking-id)
                (update-in [:workflow] replace-in-workflow task-rename)
                (update-in [:catalog] strip-catalog task-rename))))
        (vals jobs)))

(defn entries->log-dump [entries]
  (vec (sort-by :message-id (vals entries))))

(defn serialize [v]
  (vector (pr-str v)))

(defcomponent download-with-filename
  "Gross hack to enable blobs to be saved with a particular filename.
  Unfortunately, the only way to provide a filename is with a link that gets clicked.
  window.open on the blob object-url doens't currently work"
  [{:keys [data filename]} owner {:keys [parent-ch]}]
  (did-mount [_]
             (.click (om/get-node owner))
             (put! parent-ch :done))
  (render [_]
          (dom/a {:href (blob/object-url!
                          (blob/blob (serialize data)
                                     "application/octet-stream"))
                  :download filename}
                 "Save")))

(defcomponent deployment-log-dump [{:keys [entries jobs id status] :as deployment} owner]
  (init-state [_]
              {:download-type nil :download-ch (chan)})
  (will-mount [_]
              (go-loop []
                       (let [msg (<! (om/get-state owner :download-ch))]
                         (if (= msg :done)
                           (om/set-state! owner :download-type nil)))))
  (render-state [_ {:keys [download-type download-ch]}]
                (dom/div
                  (case download-type
                    :raw-dump (om/build download-with-filename
                                        {:data {:deployment-status status
                                                :jobs jobs
                                                :log (entries->log-dump entries)}
                                         :filename (str "dump_" id "_raw.edn")}
                                        {:opts {:parent-ch download-ch}})
                    :stripped-dump (om/build download-with-filename
                                             {:data {:deployment-status status
                                                     :jobs (publicise-jobs jobs)
                                                     :log (entries->log-dump entries)}
                                              :filename (str "dump_" id "_stripped.edn")}
                                             {:opts {:parent-ch download-ch}})
                    (dom/div))
                  (p/panel
                    {:header "Deployment Log Dump"
                     :collapsible? true
                     :bs-style "primary"}
                    (t/table {:striped? true :bordered? false :condensed? true :hover? true}
                             (dom/thead (dom/tr (dom/th "Type") (dom/th)))
                             (dom/tbody
                               (dom/tr
                                 (dom/td "Raw")
                                 (dom/td
                                   (dom/a {:on-click (fn [_] (om/set-state! owner :download-type :raw-dump))}
                                          "Save")))
                               (dom/tr
                                 (dom/td "Stripped of catalog parameterisations")
                                 (dom/td
                                   (dom/a {:on-click (fn [_] (om/set-state! owner :download-type :stripped-dump))}
                                          "Save")))))
                    "WARNING: We make a best effort attempt to strip catalog parameterisation and task names. "
                    "If these may include private information, please inspect the :jobs value "
                    "in the dump before making it public."))))

(defcomponent select-deployment [{:keys [deployments deployment]} owner]
  (render [_]
          (dom/div {:class "btn-group btn-group-justified" :role "group"}
                   (apply (partial b/dropdown {:bs-style "default"
                                               :title (or (:id deployment) "Select Deployment")})
                          (for [[id info] (reverse (sort-by (comp :created-at val)
                                                            deployments))]
                            (b/menu-item {:key id
                                          :on-select (fn [_]
                                                       (put! (om/get-shared owner :api-ch)
                                                             [:track-deployment id]))}
                                         id))))))

Clarify crashed log entry application.

Clarify crashed log entry application.


(ns ns-to-markdown
  "The purpose of this is to generate markdown documentation from the re-frame.core ns as input
   to the mkdocs-based documentation site build. We use markdown because that delegates site
   navigation, syntax highlighting and other useful features to the mkdocs build, making the
   output of this script very simple. It also means there is seamless integration between the
   generated api documentation, and the rest of the documentation site. All the styling is the same
   and links work as expected etc.

   It is run as part of the GitHub Actions docs workflow at
   https://github.com/day8/re-frame/blob/78ca09785e2adf9eea11f1e4bff2477d193f4b46/.github/workflows/docs-workflow.yml#L15

   The page that results from this is http://day8.github.io/re-frame/api-re-frame.core/

   Usage: clojure -m ns-to-markdown ../src/re_frame/core.cljc > api-re-frame.core.md

   Run as a script with the Clojure CLI. Expects the first arg to be a path to a ClojureScript
   namespace. Reads the single namespace found in that file using the ClojureScript analyzer,
   extracting public var metadata such as function names, arglists and docstrings. Subsequently
   writes it out as markdown to stdout suitable for piping to a markdown file as per usage example."
  (:require
    [clojure.java.io :as io]
    [cljs.analyzer]
    [cljs.analyzer.api]
    [clojure.string :as string]))

(defn multimethod?
  [var]
  (= (:tag var) 'cljs.core/MultiFn))

(defn var-type
  [opts]
  (cond
    (:macro opts)           :macro
    (:protocol-symbol opts) :protocol
    (multimethod? opts)     :multimethod
    :else                   :var))

(defn remove-quote
  [arglists]
  (if (and (list? arglists) (= (first arglists) 'quote))
    (second arglists)
    arglists))

(defn unindent
  [doc]
  (->> (string/split-lines doc)
       (map #(string/replace % #"^\s{0,2}" ""))
       (string/join "\n")))

(defn read-var
  [[_ var]]
  (-> var
      (select-keys [:name :line :arglists :doc :dynamic :added :deprecated])
      (update :arglists remove-quote)
      (update :doc unindent)
      (assoc :type (var-type var))))

(defn read-publics
  [state ns-name]
  (let [vars (cljs.analyzer.api/ns-publics state ns-name)]
    (->> vars
         (remove :protocol)
         (remove :anonymous)
         (map read-var))))

(defn analyze-file
  [file]
  (let [state (cljs.analyzer.api/empty-state)]
    (binding [cljs.analyzer/*analyze-deps* false]
      (cljs.analyzer.api/no-warn
        (cljs.analyzer.api/analyze-file state file {})))
    state))

(defn read-file
  [path]
  (try
    (let [source  (io/file path)
          ns-name (:ns (cljs.analyzer.api/parse-ns source))
          state   (analyze-file source)]
      (-> (cljs.analyzer.api/find-ns state ns-name)
          (select-keys [:name :doc])
          (assoc :publics (read-publics state ns-name))))
    (catch Exception e
      (println e))))

(defn ns->markdown
  [m]
  (format "# %s\n\n" (:name m)))

(defn arglist->markdown
  [arglist]
  (if (zero? (count arglist))
    ""
    (str " " (string/join " " arglist))))

(defn arglists->markdown
  [name-without-ns arglists]
  (reduce
    (fn [markdown arglist]
      (str markdown "\n" (format "`#!clj (%s%s)`\n" name-without-ns (arglist->markdown arglist))))
    ""
    arglists))

(defn var->markdown
  [var]
  (let [name-without-ns (name (:name var))]
    (format "## %s\n%s\n\n%s\n\n"
            name-without-ns
            (arglists->markdown name-without-ns (:arglists var))
            (:doc var))))

(defn -main
  [& args]
  (let [ns-data (read-file (first args))]
    (println (str (ns->markdown ns-data)
                  (reduce str "" (map var->markdown  (:publics ns-data)))))))

(ns ns-to-markdown
  "This script is used to generate the API documentation for the namespace `re-frame.core`. It reads the
   source code in that namespace, extracts the docstrings (markdown) and produces a markdown-formatted
   file suitable for providing to `mkdocs` which builds the re-frame website.

   It is used within the GitHub Actions docs workflow at:
   https://github.com/day8/re-frame/blob/78ca09785e2adf9eea11f1e4bff2477d193f4b46/.github/workflows/docs-workflow.yml#L15

   The page it outputs can be seen here: http://day8.github.io/re-frame/api-re-frame.core/

   Usage: clojure -m ns-to-markdown ../src/re_frame/core.cljc > api-re-frame.core.md

   Run as a script with the Clojure CLI. Expects the first arg to be a path to a ClojureScript
   namespace. Reads the single namespace found in that file using the ClojureScript analyzer,
   extracting public var metadata such as function names, arglists and docstrings. Subsequently
   writes it out as markdown to stdout suitable for piping to a markdown file."
  (:require
    [clojure.java.io :as io]
    [cljs.analyzer]
    [cljs.analyzer.api]
    [clojure.string :as string]))

(defn multimethod?
  [var]
  (= (:tag var) 'cljs.core/MultiFn))

(defn var-type
  [opts]
  (cond
    (:macro opts)           :macro
    (:protocol-symbol opts) :protocol
    (multimethod? opts)     :multimethod
    :else                   :var))

(defn remove-quote
  [arglists]
  (if (and (list? arglists) (= (first arglists) 'quote))
    (second arglists)
    arglists))

(defn unindent
  [doc]
  (->> (string/split-lines doc)
       (map #(string/replace % #"^\s{0,2}" ""))
       (string/join "\n")))

(defn read-var
  [[_ var]]
  (-> var
      (select-keys [:name :line :arglists :doc :dynamic :added :deprecated])
      (update :arglists remove-quote)
      (update :doc unindent)
      (assoc :type (var-type var))))

(defn read-publics
  [state ns-name]
  (let [vars (cljs.analyzer.api/ns-publics state ns-name)]
    (->> vars
         (remove :protocol)
         (remove :anonymous)
         (map read-var))))

(defn analyze-file
  [file]
  (let [state (cljs.analyzer.api/empty-state)]
    (binding [cljs.analyzer/*analyze-deps* false]
      (cljs.analyzer.api/no-warn
        (cljs.analyzer.api/analyze-file state file {})))
    state))

(defn read-file
  [path]
  (try
    (let [source  (io/file path)
          ns-name (:ns (cljs.analyzer.api/parse-ns source))
          state   (analyze-file source)]
      (-> (cljs.analyzer.api/find-ns state ns-name)
          (select-keys [:name :doc])
          (assoc :publics (read-publics state ns-name))))
    (catch Exception e
      (println e))))

(defn ns->markdown
  [m]
  (format "# %s\n\n" (:name m)))

(defn arglist->markdown
  [arglist]
  (if (zero? (count arglist))
    ""
    (str " " (string/join " " arglist))))

(defn arglists->markdown
  [name-without-ns arglists]
  (reduce
    (fn [markdown arglist]
      (str markdown "\n" (format "`#!clj (%s%s)`\n" name-without-ns (arglist->markdown arglist))))
    ""
    arglists))

(defn var->markdown
  [var]
  (let [name-without-ns (name (:name var))]
    (format "## %s\n%s\n\n%s\n\n"
            name-without-ns
            (arglists->markdown name-without-ns (:arglists var))
            (:doc var))))

(defn -main
  [& args]
  (let [ns-data (read-file (first args))]
    (println (str (ns->markdown ns-data)
                  (reduce str "" (map var->markdown  (:publics ns-data)))))))

Update ns_to_markdown.clj

Update ns_to_markdown.clj


(ns clojush.instructions.genome
  (:use [clojush pushstate globals random]
        clojush.instructions.common))

(define-registered genome_pop (with-meta (popper :genome) {:stack-types [:genome]}))
(define-registered genome_dup (with-meta (duper :genome) {:stack-types [:genome]}))
(define-registered genome_swap (with-meta (swapper :genome) {:stack-types [:genome]}))
(define-registered genome_rot (with-meta (rotter :genome) {:stack-types [:genome]}))
(define-registered genome_flush (with-meta (flusher :genome) {:stack-types [:genome]}))
(define-registered genome_eq (with-meta (eqer :genome) {:stack-types [:genome :boolean]}))
(define-registered genome_stackdepth (with-meta (stackdepther :genome) {:stack-types [:genome :integer]}))
(define-registered genome_yank (with-meta (yanker :genome) {:stack-types [:genome :integer]}))
(define-registered genome_yankdup (with-meta (yankduper :genome) {:stack-types [:genome :integer]}))
(define-registered genome_shove (with-meta (shover :genome) {:stack-types [:genome :integer]}))
(define-registered genome_empty (with-meta (emptyer :genome) {:stack-types [:genome :boolean]}))

(define-registered
  genome_gene_dup
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state)))
             (< (count (first (:genome state)))
                (/ @global-max-points 2)))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take (inc index) genome)
                                (drop index genome))
                        :genome)))
      state)))

(define-registered
  genome_gene_randomize
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (list (random-plush-instruction-map
                                        @global-atom-generators
                                        {:epigenetic-markers @global-epigenetic-markers
                                         :close-parens-probabilities @global-close-parens-probabilities
                                         :silent-instruction-probability @global-silent-instruction-probability}))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_gene_delete
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_rotate
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            distance (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (drop distance genome)
                                (take distance genome))
                        :genome)))
      state)))

(define-registered
  genome_gene_copy
  ^{:stack-types [:genome :integer]}
  ;; copies from the second genome to the first
  ;; index is into source -- if destination is too short it will be added to end
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (rest (:genome state))))
             (not (empty? (stack-ref :genome 1 state))))
      (let [source (stack-ref :genome 1 state)
            destination (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count source))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (seq (assoc (vec destination)
                                    (min index (count destination))
                                    (nth source index)))
                        :genome)))
      state)))

(define-registered
  genome_gene_copy_range
  ^{:stack-types [:genome :integer]}
  ;; copies from the second genome to the first
  ;; indices are into source -- if destination is too short they will be added to end
  (fn [state]
    (if (and (not (empty? (rest (:integer state))))
             (not (empty? (rest (:genome state))))
             (not (empty? (stack-ref :genome 1 state))))
      (let [source (stack-ref :genome 1 state)
            destination (stack-ref :genome 0 state)
            indices [(mod (stack-ref :integer 0 state) (count source))
                     (mod (stack-ref :integer 1 state) (count source))]
            low-index (apply min indices)
            high-index (apply max indices)]
        (->> (pop-item :integer state)
          (pop-item :integer)
          (pop-item :genome)
          (push-item (seq (loop [i low-index
                                 result (vec destination)]
                            (if (> i high-index)
                              result
                              (recur (inc i)
                                     (assoc result
                                            (min i (count destination))
                                            (nth source i))))))
                     :genome)))
      state)))

(define-registered
  genome_toggle_silent
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :silent (not (:silent g)))))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_silence
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :silent true)))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_unsilence
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :silent false)))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_close_inc
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :close (inc (:close g)))))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_close_dec
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :close (max 0 (dec (:close g))))))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_new
  ^{:stack-types [:genome]}
  (fn [state]
    (push-item () :genome state)))

(define-registered
  genome_parent1
  ^{:stack-types [:genome]}
  (fn [state]
    (push-item (:parent1-genome state) :genome state)))

(define-registered
  genome_parent2
  ^{:stack-types [:genome]}
  (fn [state]
    (push-item (:parent2-genome state) :genome state)))

(define-registered
  autoconstructive_integer_rand
  ;; pushes a constant integer, but is replaced with integer_rand during
  ;; nondetermistic autoconstruction
  ^{:stack-types [:genome :integer]} (fn [state] (push-item 0 :integer state)))

(define-registered
  autoconstructive_boolean_rand
  ;; pushes false, but is replaced with boolean_rand during
  ;; nondetermistic autoconstruction
  ^{:stack-types [:genome :boolean]} (fn [state] (push-item false :boolean state)))

(ns clojush.instructions.genome
  (:use [clojush pushstate globals random]
        clojush.instructions.common))

(define-registered genome_pop (with-meta (popper :genome) {:stack-types [:genome]}))
(define-registered genome_dup (with-meta (duper :genome) {:stack-types [:genome]}))
(define-registered genome_swap (with-meta (swapper :genome) {:stack-types [:genome]}))
(define-registered genome_rot (with-meta (rotter :genome) {:stack-types [:genome]}))
(define-registered genome_flush (with-meta (flusher :genome) {:stack-types [:genome]}))
(define-registered genome_eq (with-meta (eqer :genome) {:stack-types [:genome :boolean]}))
(define-registered genome_stackdepth (with-meta (stackdepther :genome) {:stack-types [:genome :integer]}))
(define-registered genome_yank (with-meta (yanker :genome) {:stack-types [:genome :integer]}))
(define-registered genome_yankdup (with-meta (yankduper :genome) {:stack-types [:genome :integer]}))
(define-registered genome_shove (with-meta (shover :genome) {:stack-types [:genome :integer]}))
(define-registered genome_empty (with-meta (emptyer :genome) {:stack-types [:genome :boolean]}))

(define-registered
  genome_gene_dup
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state)))
             (< (count (first (:genome state)))
                (/ @global-max-points 2)))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take (inc index) genome)
                                (drop index genome))
                        :genome)))
      state)))

(define-registered
  genome_gene_randomize
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (list (random-plush-instruction-map
                                        @global-atom-generators
                                        true
                                        {:epigenetic-markers @global-epigenetic-markers
                                         :close-parens-probabilities @global-close-parens-probabilities
                                         :silent-instruction-probability @global-silent-instruction-probability}))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_gene_delete
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_rotate
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            distance (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (drop distance genome)
                                (take distance genome))
                        :genome)))
      state)))

(define-registered
  genome_gene_copy
  ^{:stack-types [:genome :integer]}
  ;; copies from the second genome to the first
  ;; index is into source -- if destination is too short it will be added to end
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (rest (:genome state))))
             (not (empty? (stack-ref :genome 1 state))))
      (let [source (stack-ref :genome 1 state)
            destination (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count source))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (seq (assoc (vec destination)
                                    (min index (count destination))
                                    (nth source index)))
                        :genome)))
      state)))

(define-registered
  genome_gene_copy_range
  ^{:stack-types [:genome :integer]}
  ;; copies from the second genome to the first
  ;; indices are into source -- if destination is too short they will be added to end
  (fn [state]
    (if (and (not (empty? (rest (:integer state))))
             (not (empty? (rest (:genome state))))
             (not (empty? (stack-ref :genome 1 state))))
      (let [source (stack-ref :genome 1 state)
            destination (stack-ref :genome 0 state)
            indices [(mod (stack-ref :integer 0 state) (count source))
                     (mod (stack-ref :integer 1 state) (count source))]
            low-index (apply min indices)
            high-index (apply max indices)]
        (->> (pop-item :integer state)
          (pop-item :integer)
          (pop-item :genome)
          (push-item (seq (loop [i low-index
                                 result (vec destination)]
                            (if (> i high-index)
                              result
                              (recur (inc i)
                                     (assoc result
                                            (min i (count destination))
                                            (nth source i))))))
                     :genome)))
      state)))

(define-registered
  genome_toggle_silent
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :silent (not (:silent g)))))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_silence
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :silent true)))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_unsilence
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :silent false)))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_close_inc
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :close (inc (:close g)))))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_close_dec
  ^{:stack-types [:genome :integer]}
  (fn [state]
    (if (and (not (empty? (:integer state)))
             (not (empty? (:genome state)))
             (not (empty? (stack-ref :genome 0 state))))
      (let [genome (stack-ref :genome 0 state)
            index (mod (stack-ref :integer 0 state) (count genome))]
        (->> (pop-item :integer state)
             (pop-item :genome)
             (push-item (concat (take index genome)
                                (let [g (nth genome index)]
                                  (list (assoc g :close (max 0 (dec (:close g))))))
                                (drop (inc index) genome))
                        :genome)))
      state)))

(define-registered
  genome_new
  ^{:stack-types [:genome]}
  (fn [state]
    (push-item () :genome state)))

(define-registered
  genome_parent1
  ^{:stack-types [:genome]}
  (fn [state]
    (push-item (:parent1-genome state) :genome state)))

(define-registered
  genome_parent2
  ^{:stack-types [:genome]}
  (fn [state]
    (push-item (:parent2-genome state) :genome state)))

(define-registered
  autoconstructive_integer_rand
  ;; pushes a constant integer, but is replaced with integer_rand during
  ;; nondetermistic autoconstruction
  ^{:stack-types [:genome :integer]} (fn [state] (push-item 0 :integer state)))

(define-registered
  autoconstructive_boolean_rand
  ;; pushes false, but is replaced with boolean_rand during
  ;; nondetermistic autoconstruction
  ^{:stack-types [:genome :boolean]} (fn [state] (push-item false :boolean state)))

Update call to random-plush-instruction-map in genome_gene_randomize

This commit is not tested.


(ns babel.italiano.benchmark
  (:refer-clojure :exclude [get-in])
  (:require [babel.italiano.grammar :refer [small medium np-grammar]]
            [babel.italiano.lexicon :refer [lexicon]]
            [babel.italiano.morphology :as morph :refer [analyze-regular fo replace-patterns]]
            [babel.italiano.morphology.nouns :as nouns]
            [babel.italiano.morphology.verbs :as verbs]
            [babel.italiano.workbook :refer [analyze generate generate-all parse]]
            [babel.parse :as parse]
            #?(:cljs [cljs.test :refer-macros [deftest is]])
            #?(:clj [clojure.tools.logging :as log])
            #?(:cljs [babel.logjs :as log])
            [clojure.string :as string]
            [dag_unify.core :refer [get-in strip-refs]]))

(defn exception [error-string]
  #?(:clj
     (throw (Exception. error-string)))
  #?(:cljs
     (throw (js/Error. error-string))))

(defn run-benchmark [times]
  (count (take (Integer/parseInt times)
               (repeatedly #(let [debug (println "starting generation..")
                                  expr (time (generate {:comp {:synsem {:agr {:person :3rd}}}
                                                        :synsem {:cat :verb}}))]
                              (println (str "generated: " (fo expr)))
                              (println (str "starting parsing.."))
                              (let [parsed (time (take 1 (parse (fo expr))))]
                                (if (empty? parsed)
                                  (throw (exception (str "could not parse: " (fo expr)))))
                                (println (str "parsed: " (fo (first parsed))))
                                (println "")))))))
(defn -main [times]
  (run-benchmark times))

(ns babel.italiano.benchmark
  (:refer-clojure :exclude [get-in])
  (:require [babel.italiano.grammar :refer [small medium np-grammar]]
            [babel.italiano.lexicon :refer [lexicon]]
            [babel.italiano.morphology :as morph :refer [analyze-regular fo replace-patterns]]
            [babel.italiano.morphology.nouns :as nouns]
            [babel.italiano.morphology.verbs :as verbs]
            [babel.italiano.workbook :refer [analyze generate generate-all parse]]
            [babel.parse :as parse]
            #?(:cljs [cljs.test :refer-macros [deftest is]])
            #?(:clj [clojure.tools.logging :as log])
            #?(:cljs [babel.logjs :as log])
            [clojure.string :as string]
            [dag_unify.core :refer [get-in strip-refs]]))

(defn exception [error-string]
  #?(:clj
     (throw (Exception. error-string)))
  #?(:cljs
     (throw (js/Error. error-string))))

(defn run-benchmark [times]
  (count (take (Integer/parseInt times)
               (repeatedly #(let [debug (println "starting generation..")
                                  expr (time (generate {:comp {:synsem {:agr {:person :3rd}}}
                                                        :synsem {:cat :verb}}))]
                              (println (str "generated: " (fo expr)))
                              (println (str "starting parsing.."))
                              (let [parsed (time (take 1 (parse (fo expr))))]
                                (if (empty? parsed)
                                  (throw (exception (str "could not parse: " (fo expr) " with semantics:"
                                                         (strip-refs (get-in expr [:synsem :sem]))))))

                                (println (str "parsed: " (fo (first parsed))))
                                (println "")))))))
(defn -main [times]
  (run-benchmark times))

diagnostics: print semantics of generated expression if parsing fails for surface of expression


(ns braid.core.server.handler
  (:require
   [braid.core.server.routes.api.private :refer [api-private-routes]]
   [braid.core.server.routes.api.public :refer [api-public-routes]]
   [braid.base.server.http-api-routes :as modules]
   [braid.core.server.routes.client :refer [desktop-client-routes mobile-client-routes]]
   [braid.base.server.http-client-routes :refer [resource-routes]]
   [braid.core.server.routes.socket :refer [sync-routes]]
   [compojure.core :refer [routes context]]
   [environ.core :refer [env]]
   [ring.middleware.cors :refer [wrap-cors]]
   [ring.middleware.defaults :refer [wrap-defaults api-defaults secure-site-defaults site-defaults]]
   [ring.middleware.format :refer [wrap-restful-format]]
   [ring.middleware.edn :refer [wrap-edn-params]]))

(def session-max-age (* 60 60 24 365))

; NOT using config here, b/c it won't have started when this runs
(if (env :redis-uri)
  (do
    (require 'taoensso.carmine.ring)
    (def ^:dynamic *redis-conf* {:pool {}
                                 :spec {:uri (env :redis-uri)}})
    (let [carmine-store (ns-resolve 'taoensso.carmine.ring 'carmine-store)]
      (def session-store
        (carmine-store '*redis-conf* {:expiration-secs session-max-age
                                      :key-prefix "braid"}))))
  (do
    (require 'ring.middleware.session.cookie)
    (let [cookie-store (ns-resolve 'ring.middleware.session.cookie 'cookie-store)]
      (def session-store (cookie-store)))))

(defn assoc-cookie-conf [defaults]
  (-> defaults
      (assoc-in [:session :cookie-name] "braid")
      (assoc-in [:session :cookie-attrs :secure] (cond
                                                   (env :http-only)
                                                   false
                                                   (= (env :environment) "prod")
                                                   true
                                                   :else
                                                   false))
      (assoc-in [:session :cookie-attrs :max-age] session-max-age)
      (assoc-in [:session :store] session-store)))

(defn assoc-csrf-conf [defaults]
  (-> defaults
      (assoc-in [:security :anti-forgery] true)))

(def static-site-defaults
  {:params {:urlencoded true
            :multipart  true
            :nested     true
            :keywordize true}
   :responses {:not-modified-responses true
               :absolute-redirects     true
               :content-types          true
               :default-charset        "utf-8"}})

(def mobile-client-app
  (-> (routes
        resource-routes
        mobile-client-routes)
      (wrap-defaults (-> static-site-defaults
                         assoc-cookie-conf))))

(def desktop-client-app
  (-> (routes
        resource-routes
        desktop-client-routes)
      (wrap-defaults (-> static-site-defaults
                         assoc-cookie-conf))))

(def api-server-app
  (-> (routes
        modules/raw-handlers

        (-> api-public-routes
            (wrap-defaults (-> site-defaults
                               (assoc-in [:security :anti-forgery] false)
                               assoc-cookie-conf)))

        (-> modules/public-handler
            (wrap-defaults (-> site-defaults
                               (assoc-in [:security :anti-forgery] false)))
            (wrap-restful-format :formats [:edn :transit-json]))

        (-> sync-routes
            (wrap-defaults (-> api-defaults
                               assoc-cookie-conf
                               assoc-csrf-conf)))

       (-> api-private-routes
            (wrap-defaults (-> api-defaults
                               assoc-cookie-conf
                               assoc-csrf-conf)))

       ;; this needs to be last, because the middleware will return
       ;; 401 if not authorized & hence not fall-through to other
       ;; routes
       (-> modules/private-handler
           (wrap-defaults (-> site-defaults
                              assoc-cookie-conf
                              assoc-csrf-conf))
           (wrap-restful-format :formats [:edn :transit-json])))
      (wrap-cors :access-control-allow-origin (->>
                                                [(when-let [site (env :site-url)]
                                                   (re-pattern (java.util.regex.Pattern/quote site)))
                                                 (when-let [mobile-site (env :mobile-site-url)]
                                                   (re-pattern (java.util.regex.Pattern/quote mobile-site)))
                                                 #"http://localhost:\d+"]
                                                  (remove nil?))
                 :access-control-allow-credentials true
                 :access-control-allow-methods [:get :put :post :delete])
      wrap-edn-params))

(ns braid.core.server.handler
  (:require
   [braid.core.server.routes.api.private :refer [api-private-routes]]
   [braid.core.server.routes.api.public :refer [api-public-routes]]
   [braid.base.server.http-api-routes :as modules]
   [braid.core.server.routes.client :refer [desktop-client-routes mobile-client-routes]]
   [braid.base.server.http-client-routes :refer [resource-routes]]
   [braid.core.server.routes.socket :refer [sync-routes]]
   [compojure.core :refer [routes context]]
   [environ.core :refer [env]]
   [ring.middleware.cors :refer [wrap-cors]]
   [ring.middleware.defaults :refer [wrap-defaults api-defaults secure-site-defaults site-defaults]]
   [ring.middleware.format :refer [wrap-restful-format]]
   [ring.middleware.edn :refer [wrap-edn-params]]
   [taoensso.timbre :as timbre]))

(def session-max-age (* 60 60 24 365))

;; NOT using config here, b/c it won't have started when this runs
(if (env :redis-uri)
  (do
    (require 'taoensso.carmine.ring)
    (def ^:dynamic *redis-conf* {:pool {}
                                 :spec {:uri (env :redis-uri)}})
    (let [carmine-store (ns-resolve 'taoensso.carmine.ring 'carmine-store)]
      (def session-store
        (carmine-store '*redis-conf* {:expiration-secs session-max-age
                                      :key-prefix "braid"}))))
  (do
    (require 'ring.middleware.session.cookie)
    (let [cookie-store (ns-resolve 'ring.middleware.session.cookie 'cookie-store)]
      (def session-store (cookie-store)))))

(defn assoc-cookie-conf [defaults]
  (-> defaults
      (assoc-in [:session :cookie-name] "braid")
      (assoc-in [:session :cookie-attrs :secure] (cond
                                                   (env :http-only)
                                                   false
                                                   (= (env :environment) "prod")
                                                   true
                                                   :else
                                                   false))
      (assoc-in [:session :cookie-attrs :max-age] session-max-age)
      (assoc-in [:session :store] session-store)))

(defn assoc-csrf-conf [defaults]
  (-> defaults
      (assoc-in [:security :anti-forgery] true)))

(def static-site-defaults
  {:params {:urlencoded true
            :multipart  true
            :nested     true
            :keywordize true}
   :responses {:not-modified-responses true
               :absolute-redirects     true
               :content-types          true
               :default-charset        "utf-8"}})

(defn- wrap-log-requests
  [handler]
  (fn [{uri :uri method :request-method :as request}]
    (let [t0 (System/currentTimeMillis)
          {:keys [status] :as response} (handler request)]
      (timbre/debugf "[%s +%4dms] %8.8s %s" status (- (System/currentTimeMillis) t0) method uri)
      response)))

(def mobile-client-app
  (-> (routes
       resource-routes
       mobile-client-routes)
      (wrap-defaults (-> static-site-defaults
                         assoc-cookie-conf))
      wrap-log-requests))

(def desktop-client-app
  (-> (routes
       resource-routes
       desktop-client-routes)
      (wrap-defaults (-> static-site-defaults
                         assoc-cookie-conf))
      wrap-log-requests))

(def api-server-app
  (-> (routes
        modules/raw-handlers

        (-> api-public-routes
            (wrap-defaults (-> site-defaults
                               (assoc-in [:security :anti-forgery] false)
                               assoc-cookie-conf)))

        (-> modules/public-handler
            (wrap-defaults (-> site-defaults
                               (assoc-in [:security :anti-forgery] false)))
            (wrap-restful-format :formats [:edn :transit-json]))

        (-> sync-routes
            (wrap-defaults (-> api-defaults
                               assoc-cookie-conf
                               assoc-csrf-conf)))

       (-> api-private-routes
            (wrap-defaults (-> api-defaults
                               assoc-cookie-conf
                               assoc-csrf-conf)))

       ;; this needs to be last, because the middleware will return
       ;; 401 if not authorized & hence not fall-through to other
       ;; routes
       (-> modules/private-handler
           (wrap-defaults (-> site-defaults
                              assoc-cookie-conf
                              assoc-csrf-conf))
           (wrap-restful-format :formats [:edn :transit-json])))
      (wrap-cors :access-control-allow-origin (->>
                                                [(when-let [site (env :site-url)]
                                                   (re-pattern (java.util.regex.Pattern/quote site)))
                                                 (when-let [mobile-site (env :mobile-site-url)]
                                                   (re-pattern (java.util.regex.Pattern/quote mobile-site)))
                                                 #"http://localhost:\d+"]
                                                  (remove nil?))
                 :access-control-allow-credentials true
                 :access-control-allow-methods [:get :put :post :delete])
      wrap-edn-params
      wrap-log-requests))

Add debug logging of HTTP requests

Add debug logging of HTTP requests