(ns conexp.fca.applications.wikidata
  (:require [conexp.fca.contexts :refer [attributes objects
                                         make-context incidence-relation]]
            [conexp.fca.implications :refer [make-implication premise
                                             conclusion tautology?]]
            [conexp.fca.fast :refer :all]
            [conexp.io.contexts :refer :all]
            [clojure.java.io :as io]
            [clojure.string :as str]
            [clojure.set :refer :all]
            [clj-http.client :as client]
            [clojure.data.json :as json])
  (:import org.apache.http.impl.client.HttpClientBuilder))

(def ^:dynamic *sparql-endpoint*
  "Wikidata SPARQL query endpoint URI"
  "https://query.wikidata.org/bigdata/namespace/wdq/sparql")

(def ^:dynamic *tool-banner*
  "tool banner to send with SPARQL queries"
  "#TOOL:conexp-clj, https://github.com/tomhanika/conexp-clj")

(def ^:dynamic *max-entities-per-query*
  "maximum number of entities requested in a single query (entities
  will be split over multiple queries if above this threshold)" 500)

(def ^:dynamic *query-delay*
  "delay between two queries, in milliseconds"
  500)

(defn- disable-cookies [^HttpClientBuilder builder
                        request]
  "helper to disable cookie management in HTTP requests"
  (.disableCookieManagement builder))

(defn sparql-query
  "retrieve the result of SPARQL query qry from the Wikidata query service *sparql-endpoint*"
  [qry]
  (client/get
   *sparql-endpoint*
   {:accept :json
    :query-params {"query"
                   (str *tool-banner*
                        "\n"
                        qry)}
    :http-builder-fns [disable-cookies]}))

(defmacro with-sparql-bindings
  "execute body with bindings bound to the results of query"
  [query & body]
  (let [v (gensym "v")]
    `(as-> ~query ~v
       (sparql-query ~v)
       (get ~v :body)
       (json/read-str ~v)
       (let [{{bindings "bindings"} "results"} ~v]
         ~@body))))

(defn- entity-add-sparql-prefix
  "prefix an entity-id for use with the Wikidata query service"
  [entity-id]
   (str "wd:" (str entity-id)))

(defn- entity-id-from-uri
  "retrieve an entity id from a Wikidata entity URI"
  [uri]
  (let [slash (str/last-index-of uri "/")]
    (subs uri (+ 1 slash))))

(defn- label-query-for-entities
  "construct a query that retrieves labels for a list of entities, in a given language (default english)"
  [entities & {:keys [lang] :or {lang "en"}}]
  (str "SELECT ?entity ?label WHERE { VALUES ?entity {"
       (str/join " "
                            (map entity-add-sparql-prefix entities))
       "} ?entity rdfs:label ?label FILTER(LANG(?label)=\""
       lang
       "\") }"))

(defn- extract-entity-label-from-json
  "extract entity label result from the JSON data returned by the Wikidata query service"
  [{{entity "value"} "entity"
    {label "value"
     lang "xml:lang"} "label"}]
  (let [entity-id (entity-id-from-uri entity)]
    {entity-id {:entity entity-id
                :label label
                :lang lang}}))

(defn- find-labels-for-some-entities
  "retrieve labels for all entities"
  [entities & {:keys [lang delay] :or {lang "en"}}]
  (if delay
    (Thread/sleep delay))
  (with-sparql-bindings
    (label-query-for-entities entities :lang lang)
    (apply merge
           (map extract-entity-label-from-json bindings))))

(defn find-labels-for-entities
  "retrieve labels for all entities"
  [entities & {:keys [lang] :or {lang "en"}}]
  (apply merge
   (map (fn [ents] (find-labels-for-some-entities ents :delay *query-delay*))
        (partition *max-entities-per-query*
                   *max-entities-per-query*
                   [] entities))))

(defn format-label
  "retrieve a nicely formatted label for an entity id"
  [labels needle]
  (let [{label :label} (get labels needle "[no label found]")]
    (str label
         " ("
         needle
         ")")))

(defn find-labels-for-context
  "find labels for all objects and attributes in the context ctx"
  [ctx]
  (let [objs (objects ctx)
        atts (attributes ctx)
        labels (find-labels-for-entities (union objs atts))
        lookup (fn [needle] (format-label labels needle))
        translate (fn [& [names]] (map lookup names))]
    (make-context (map lookup objs)
                  (map lookup atts)
                  (map translate (incidence-relation ctx)))))

(defn- id-from-label
  "find the entity id from the label"
  [label]
  (subs label
        (+ 1
           (str/last-index-of label "("))
        (str/last-index-of label ")")))

(defn- unlabel-implication
  "turn an implication on labels into an implication on ids"
  [implication]
  (make-implication
   (map id-from-label (premise implication))
   (map id-from-label (conclusion implication))))

(defn- pattern-for-premise
  "generate a graph pattern matching a premise"
  [premise]
  (let [to-clause (fn [property]
                    (str "wdt:"
                         property
                         " []"))]
    (str "?entity "
         (str/join
          ";\n    "
          (map to-clause premise))
         " .")))

(defn- pattern-for-conclusion
  "generate a graph pattern not matching the given conclusion"
  [conclusion]
  (str "{ FILTER NOT EXISTS { ?entity wdt:"
       conclusion
       " [] . } }"))

(defn counterexample-query-for-implication
  "generate a query to check for counterexamples to the implication"
  [implication & {:keys [amount limit ask-only]}]
  {:pre [(if ask-only
           (not (or amount limit))
           true)
         (if limit
           (and (integer? limit)
                (< 0 limit))
           true)]}
  (let [impl (unlabel-implication implication)
        body (premise impl)
        head (conclusion impl)]
    (str
     (if ask-only
       "ASK "
       "SELECT ")
     (if amount
       "(COUNT(?entity) AS ?entities)"
       (when-not ask-only
               "?entity"))
     " WHERE {\n  "
     (pattern-for-premise body)
     "\n  "
     (str/join
      " UNION\n  "
      (map pattern-for-conclusion
           head))
     "}"
     (when limit
       (str " LIMIT " limit)))))

(defmacro tautology-or-counterexample
  [implication & body]
  `(if (tautology? ~implication)
     nil
     ~@body))

(defn counterexample?
  "check whether there is a counterexample to the given implication"
  [implication]
  (tautology-or-counterexample
   implication
   (-> implication
       (counterexample-query-for-implication :ask-only true)
       (sparql-query)
       (get :body)
       (json/read-str)
       (get "boolean"))))

(defn counterexample
  "find a counterexample to the given implication, or nil if there is none"
  [implication]
  (tautology-or-counterexample
   implication
   (with-sparql-bindings
     (counterexample-query-for-implication implication :limit 1)
     (let [[{entity "entity"}] bindings]
       entity))))

(defn counterexamples
  "find all counterexample to the given implication, or nil if there is none"
  [implication]
  (tautology-or-counterexample
   implication
   (with-sparql-bindings
     (counterexample-query-for-implication implication)
     (map (fn [{entity "entity"}]
            entity)
          bindings))))

(defn number-of-counterexamples
  "find the number of all counterexamples to the given implication"
  [implication]
  (if (tautology? implication)
    0
    (with-sparql-bindings
      (counterexample-query-for-implication implication :amount true)
      (let [[{{value "value"} "entities"}] bindings]
        (if value
          (read-string value)
          0)))))

(ns conexp.fca.applications.wikidata
  (:require [conexp.fca.contexts :refer [attributes objects
                                         make-context incidence-relation]]
            [conexp.fca.implications :refer [make-implication premise
                                             conclusion tautology?]]
            [conexp.fca.fast :refer :all]
            [conexp.io.contexts :refer :all]
            [clojure.java.io :as io]
            [clojure.string :as str]
            [clojure.set :refer :all]
            [clj-http.client :as client]
            [clojure.data.json :as json])
  (:import org.apache.http.impl.client.HttpClientBuilder))

(def ^:dynamic *sparql-endpoint*
  "Wikidata SPARQL query endpoint URI"
  "https://query.wikidata.org/bigdata/namespace/wdq/sparql")

(def ^:dynamic *tool-banner*
  "tool banner to send with SPARQL queries"
  "#TOOL:conexp-clj, https://github.com/tomhanika/conexp-clj")

(def ^:dynamic *max-entities-per-query*
  "maximum number of entities requested in a single query (entities
  will be split over multiple queries if above this threshold)" 500)

(def ^:dynamic *query-delay*
  "delay between two queries, in milliseconds"
  500)

(defn- disable-cookies [^HttpClientBuilder builder
                        request]
  "helper to disable cookie management in HTTP requests"
  (.disableCookieManagement builder))

(defn sparql-query
  "retrieve the result of SPARQL query qry from the Wikidata query service *sparql-endpoint*"
  [qry]
  (client/get
   *sparql-endpoint*
   {:accept :json
    :query-params {"query"
                   (str *tool-banner*
                        "\n"
                        qry)}
    :http-builder-fns [disable-cookies]}))

(defmacro with-sparql-bindings
  "execute body with bindings bound to the results of query"
  [query & body]
  (let [v (gensym "v")]
    `(as-> ~query ~v
       (sparql-query ~v)
       (get ~v :body)
       (json/read-str ~v)
       (let [{{~'bindings "bindings"} "results"} ~v]
         ~@body))))

(defn- entity-add-sparql-prefix
  "prefix an entity-id for use with the Wikidata query service"
  [entity-id]
   (str "wd:" (str entity-id)))

(defn- entity-id-from-uri
  "retrieve an entity id from a Wikidata entity URI"
  [uri]
  (let [slash (str/last-index-of uri "/")]
    (subs uri (+ 1 slash))))

(defn- label-query-for-entities
  "construct a query that retrieves labels for a list of entities, in a given language (default english)"
  [entities & {:keys [lang] :or {lang "en"}}]
  (str "SELECT ?entity ?label WHERE { VALUES ?entity {"
       (str/join " "
                            (map entity-add-sparql-prefix entities))
       "} ?entity rdfs:label ?label FILTER(LANG(?label)=\""
       lang
       "\") }"))

(defn- extract-entity-label-from-json
  "extract entity label result from the JSON data returned by the Wikidata query service"
  [{{entity "value"} "entity"
    {label "value"
     lang "xml:lang"} "label"}]
  (let [entity-id (entity-id-from-uri entity)]
    {entity-id {:entity entity-id
                :label label
                :lang lang}}))

(defn- find-labels-for-some-entities
  "retrieve labels for all entities"
  [entities & {:keys [lang delay] :or {lang "en"}}]
  (if delay
    (Thread/sleep delay))
  (with-sparql-bindings
    (label-query-for-entities entities :lang lang)
    (apply merge
           (map extract-entity-label-from-json bindings))))

(defn find-labels-for-entities
  "retrieve labels for all entities"
  [entities & {:keys [lang] :or {lang "en"}}]
  (apply merge
   (map (fn [ents] (find-labels-for-some-entities ents :delay *query-delay*))
        (partition *max-entities-per-query*
                   *max-entities-per-query*
                   [] entities))))

(defn format-label
  "retrieve a nicely formatted label for an entity id"
  [labels needle]
  (let [{label :label} (get labels needle "[no label found]")]
    (str label
         " ("
         needle
         ")")))

(defn find-labels-for-context
  "find labels for all objects and attributes in the context ctx"
  [ctx]
  (let [objs (objects ctx)
        atts (attributes ctx)
        labels (find-labels-for-entities (union objs atts))
        lookup (fn [needle] (format-label labels needle))
        translate (fn [& [names]] (map lookup names))]
    (make-context (map lookup objs)
                  (map lookup atts)
                  (map translate (incidence-relation ctx)))))

(defn- id-from-label
  "find the entity id from the label"
  [label]
  (subs label
        (+ 1
           (str/last-index-of label "("))
        (str/last-index-of label ")")))

(defn- unlabel-implication
  "turn an implication on labels into an implication on ids"
  [implication]
  (make-implication
   (map id-from-label (premise implication))
   (map id-from-label (conclusion implication))))

(defn- pattern-for-premise
  "generate a graph pattern matching a premise"
  [premise]
  (let [to-clause (fn [property]
                    (str "wdt:"
                         property
                         " []"))]
    (str "?entity "
         (str/join
          ";\n    "
          (map to-clause premise))
         " .")))

(defn- pattern-for-conclusion
  "generate a graph pattern not matching the given conclusion"
  [conclusion]
  (str "{ FILTER NOT EXISTS { ?entity wdt:"
       conclusion
       " [] . } }"))

(defn counterexample-query-for-implication
  "generate a query to check for counterexamples to the implication"
  [implication & {:keys [amount limit ask-only]}]
  {:pre [(if ask-only
           (not (or amount limit))
           true)
         (if limit
           (and (integer? limit)
                (< 0 limit))
           true)]}
  (let [impl (unlabel-implication implication)
        body (premise impl)
        head (conclusion impl)]
    (str
     (if ask-only
       "ASK "
       "SELECT ")
     (if amount
       "(COUNT(?entity) AS ?entities)"
       (when-not ask-only
               "?entity"))
     " WHERE {\n  "
     (pattern-for-premise body)
     "\n  "
     (str/join
      " UNION\n  "
      (map pattern-for-conclusion
           head))
     "}"
     (when limit
       (str " LIMIT " limit)))))

(defmacro tautology-or-counterexample
  [implication & body]
  `(if (tautology? ~implication)
     nil
     ~@body))

(defn counterexample?
  "check whether there is a counterexample to the given implication"
  [implication]
  (tautology-or-counterexample
   implication
   (-> implication
       (counterexample-query-for-implication :ask-only true)
       (sparql-query)
       (get :body)
       (json/read-str)
       (get "boolean"))))

(defn counterexample
  "find a counterexample to the given implication, or nil if there is none"
  [implication]
  (tautology-or-counterexample
   implication
   (with-sparql-bindings
     (counterexample-query-for-implication implication :limit 1)
     (let [[{entity "entity"}] bindings]
       entity))))

(defn counterexamples
  "find all counterexample to the given implication, or nil if there is none"
  [implication]
  (tautology-or-counterexample
   implication
   (with-sparql-bindings
     (counterexample-query-for-implication implication)
     (map (fn [{entity "entity"}]
            entity)
          bindings))))

(defn number-of-counterexamples
  "find the number of all counterexamples to the given implication"
  [implication]
  (if (tautology? implication)
    0
    (with-sparql-bindings
      (counterexample-query-for-implication implication :amount true)
      (let [[{{value "value"} "entities"}] bindings]
        (if value
          (read-string value)
          0)))))

Fix with-sparql-bindings macro for clojure-1.9.0

Namespaced maps (introduced in clojure 1.9.0) break the associative
destructuring in with-sparql-bindings' let block, as syntax quoting
will turn `bindings` into a fully qualified name. We use the
quote/unquote to explicitly force an unqualified name in the expansion.


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.main.ui.workspace.sidebar.options.fill
  (:require [sablono.core :as html :refer-macros [html]]
            [rum.core :as rum]
            [lentes.core :as l]
            [uxbox.common.i18n :refer (tr)]
            [uxbox.common.router :as r]
            [uxbox.common.rstore :as rs]
            [uxbox.main.state :as st]
            [uxbox.main.library :as library]
            [uxbox.main.data.shapes :as uds]
            [uxbox.main.data.lightbox :as udl]
            [uxbox.main.ui.icons :as i]
            [uxbox.common.ui.mixins :as mx]
            [uxbox.util.dom :as dom]
            [uxbox.util.data :refer (parse-int parse-float read-string)]))

(defn fill-menu-render
  [own menu shape]
  (letfn [(change-fill [value]
            (let [sid (:id shape)]
              (rs/emit! (uds/update-fill-attrs sid value))))
          (on-color-change [event]
            (let [value (dom/event->value event)]
              (change-fill {:color value})))
          (on-opacity-change [event]
            (let [value (dom/event->value event)
                  value (parse-float value 1)
                  value (/ value 10000)]
              (change-fill {:opacity value})))
          (on-color-picker-event [color]
            (change-fill {:color color}))
          (show-color-picker [event]
            (let [x (.-clientX event)
                  y (.-clientY event)
                  opts {:x x :y y
                        :shape (:id shape)
                        :attr :fill
                        :transparent? true}]
              (udl/open! :workspace/colorpicker opts)))]

    (html
     [:div.element-set {:key (str (:id menu))}
      [:div.element-set-title (:name menu)]
      [:div.element-set-content

       [:span "Color"]
       [:div.row-flex.color-data
        [:span.color-th
         {:style {:background-color (:fill shape)}
          :on-click show-color-picker}]
        [:div.color-info
         [:span (:fill shape)]]]

       [:div.row-flex
        [:input.input-text
         {:placeholder "#"
          :type "text"
          :value (:fill shape "")
          :on-change on-color-change}]]

       ;; SLIDEBAR FOR ROTATION AND OPACITY
       [:span "Opacity"]
       [:div.row-flex
        [:input.slidebar
         {:type "range"
          :min "0"
          :max "10000"
          :value (* 10000 (:fill-opacity shape 1))
          :step "1"
          :on-change on-opacity-change}]]]])))

(def fill-menu
  (mx/component
   {:render fill-menu-render
    :name "fill-menu"
    :mixins [mx/static]}))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.main.ui.workspace.sidebar.options.fill
  (:require [sablono.core :as html :refer-macros [html]]
            [rum.core :as rum]
            [lentes.core :as l]
            [uxbox.common.i18n :refer (tr)]
            [uxbox.common.router :as r]
            [uxbox.common.rstore :as rs]
            [uxbox.main.state :as st]
            [uxbox.main.library :as library]
            [uxbox.main.data.shapes :as uds]
            [uxbox.main.data.lightbox :as udl]
            [uxbox.main.ui.icons :as i]
            [uxbox.common.ui.mixins :as mx]
            [uxbox.util.dom :as dom]
            [uxbox.util.data :refer (parse-int parse-float read-string)]))

(defn fill-menu-render
  [own menu shape]
  (letfn [(change-fill [value]
            (let [sid (:id shape)]
              (rs/emit! (uds/update-fill-attrs sid value))))
          (on-color-change [event]
            (let [value (dom/event->value event)]
              (change-fill {:color value})))
          (on-opacity-change [event]
            (let [value (dom/event->value event)
                  value (parse-float value 1)
                  value (/ value 10000)]
              (change-fill {:opacity value})))
          (on-color-picker-event [color]
            (change-fill {:color color}))
          (show-color-picker [event]
            (let [x (.-clientX event)
                  y (.-clientY event)
                  opts {:x x :y y
                        :shape (:id shape)
                        :attr :fill
                        :transparent? true}]
              (udl/open! :workspace/colorpicker opts)))]

    (html
     [:div.element-set {:key (str (:id menu))}
      [:div.element-set-title (:name menu)]
      [:div.element-set-content

       [:span "Color"]
       [:div.row-flex.color-data
        [:span.color-th
         {:style {:background-color (:fill shape "#000000")}
          :on-click show-color-picker}]
        [:div.color-info
         [:span (:fill shape "#000000")]]]

       [:div.row-flex
        [:input.input-text
         {:placeholder "#"
          :type "text"
          :value (:fill shape "")
          :on-change on-color-change}]]

       ;; SLIDEBAR FOR ROTATION AND OPACITY
       [:span "Opacity"]
       [:div.row-flex
        [:input.slidebar
         {:type "range"
          :min "0"
          :max "10000"
          :value (* 10000 (:fill-opacity shape 1))
          :step "1"
          :on-change on-opacity-change}]]]])))

(def fill-menu
  (mx/component
   {:render fill-menu-render
    :name "fill-menu"
    :mixins [mx/static]}))

Fix default color on fill options.

Fix default color on fill options.


(ns clj-money.models.accounts-test
  (:require [clojure.test :refer :all]
            [environ.core :refer [env]]
            [clj-money.web :refer :all]
            [clojure.pprint :refer [pprint]]
            [clojure.data :refer [diff]])
  (:use [clj-money.models.accounts :as accounts]))

(deftest create-an-account
  (testing "After I add an account, I can retrieve it"
    (accounts/create (env :db) {:name "Checking"
                               :type :asset})
    (let [accounts (->> (env :db)
                        (accounts/select)
                        (map #(select-keys % [:name :type])))
          expected [{:name "Checking"
                     :type :asset}]]
      (is (= expected
             accounts)))))

(ns clj-money.models.accounts-test
  (:require [clojure.test :refer :all]
            [environ.core :refer [env]]
            [clojure.pprint :refer [pprint]]
            [clojure.data :refer [diff]]
            [clojure.java.jdbc :as jdbc]
            [clj-money.web :refer :all])
  (:use [clj-money.models.accounts :as accounts]))

(def data-store (env :db))

(defn reset-db
  "Deletes all records from all tables in the database prior to test execution"
  [f]
  (jdbc/with-db-connection [db data-store]
    (doseq [table ["accounts"]]
      (jdbc/execute! db (str "truncate table " table ";"))))
  (f))

(use-fixtures :each reset-db)

(deftest create-an-account
  (testing "After I add an account, I can retrieve it"
    (accounts/create data-store {:name "Checking"
                                 :type :asset})
    (let [accounts (->> data-store
                        (accounts/select)
                        (map #(select-keys % [:name :type])))
          expected [{:name "Checking"
                     :type :asset}]]
      (is (= expected
             accounts)))))

truncate all tables before the tests

truncate all tables before the tests


(ns iwaswhere-web.ui.markdown
  (:require [markdown.core :as md]
            [iwaswhere-web.helpers :as h]
            [clojure.string :as s]
            [cljsjs.moment]))

(defn hashtags-replacer
  "Replaces hashtags in entry text. Depending on show-hashtags? switch either displays
  the hashtag or not. Creates link for each hashtag, which opens iWasWhere in new tab,
  with the filter set to the clicked hashtag."
  [show-hashtags?]
  (fn [acc hashtag]
    (let [f-hashtag (if show-hashtags? hashtag (subs hashtag 1))
          with-link (str " " f-hashtag " ")]
      (s/replace acc (re-pattern (str "[^*]" hashtag "(?!\\w)")) with-link))))

(defn mentions-replacer
  "Replaces mentions in entry text."
  [acc mention]
  (let [with-link (str " " mention " ")]
    (s/replace acc mention with-link)))

(defn- reducer
  "Generic reducer, allows calling specified function for each item in the collection."
  [text coll fun]
  (reduce fun text coll))

(defn markdown-render
  "Renders a markdown div using :dangerouslySetInnerHTML. Not that dangerous here since
  application is only running locally, so in doubt we could only harm ourselves.
  Returns nil when entry does not contain markdown text."
  [entry show-hashtags?]
  (when-let [md-string (:md entry)]
    (let [formatted-md (-> md-string
                           (reducer (:tags entry) (hashtags-replacer show-hashtags?))
                           (reducer (:mentions entry) mentions-replacer))]
      [:div {:dangerouslySetInnerHTML {:__html (md/md->html formatted-md)}}])))

(defn editable-md-render
  "Renders markdown in a pre>code element, with editable content. Sends update message to store
  component on any change to the component. The save button sends updated entry to the backend."
  [entry temp-entry hashtags mentions put-fn]
  (let [md-string (or (:md temp-entry) (:md entry) "edit here")
        ts (:timestamp entry)
        get-content #(aget (.. % -target -parentElement -parentElement -firstChild -firstChild) "innerText")
        update-temp-fn (fn [ev]
                         (let [cursor-pos {:cursor-pos (.-anchorOffset (.getSelection js/window))}
                               updated (with-meta (merge entry (h/parse-entry (get-content ev))) cursor-pos)]
                           (put-fn [:update/temp-entry {:timestamp ts :updated updated}])))
        on-keydown-fn (fn [ev] (let [key-code (.. ev -keyCode)
                                     meta-key (.. ev -metaKey)]
                                 (when (and meta-key (= key-code 83))
                                   (if (not= entry temp-entry) ; when no change, toggle edit mode
                                     (put-fn [:text-entry/update temp-entry])
                                     (put-fn [:cmd/toggle {:timestamp ts :key :show-edit-for}]))
                                   (.preventDefault ev))
                                 (when (= key-code 9)
                                   ;(put-fn [:text-entry/update temp-entry])
                                   (prn key-code)
                                   (.preventDefault ev))))]
    [:div.edit-md
     [:pre [:code {:content-editable true
                   :on-input         update-temp-fn
                   :on-key-down      on-keydown-fn}
            md-string]]
     (when temp-entry
       (let [cursor-pos (:cursor-pos (meta temp-entry))
             md (:md temp-entry)
             before-cursor (subs md 0 cursor-pos)
             current-tag (re-find (js/RegExp. "(?!^)#[\\w\\-\\u00C0-\\u017F]+$" "m") before-cursor)
             current-tag-regex (js/RegExp. current-tag "i")
             tag-substr-filter (fn [tag] (when current-tag (re-find current-tag-regex tag)))]
         [:div.suggestions
          (for [tag (filter tag-substr-filter hashtags)]
            ^{:key (str ts tag)}
            [:div
             {:on-click #(let [updated (merge entry (h/parse-entry (s/replace md current-tag tag)))]
                          (put-fn [:update/temp-entry {:timestamp ts :updated updated}]))}
             [:span.hashtag tag]])]))
     (when temp-entry
       (let [cursor-pos (:cursor-pos (meta temp-entry))
             md (:md temp-entry)
             before-cursor (subs md 0 cursor-pos)
             current-mention (re-find (js/RegExp. "@[\\w\\-\\u00C0-\\u017F]+$" "m") before-cursor)
             current-mention-regex (js/RegExp. current-mention "i")
             mention-substr-filter (fn [mention] (when current-mention (re-find current-mention-regex mention)))]
         [:div.suggestions
          (for [mention (filter mention-substr-filter mentions)]
            ^{:key (str ts mention)}
            [:div
             {:on-click #(let [updated (merge entry (h/parse-entry (s/replace md current-mention mention)))]
                          (put-fn [:update/temp-entry {:timestamp ts :updated updated}]))}
             [:span.mention mention]])]))]))

(defn md-render
  "Helper for conditionally either showing rendered output or editable markdown."
  [entry temp-entry hashtags mentions put-fn editable? show-hashtags?]
  (if editable? (editable-md-render entry temp-entry hashtags mentions put-fn)
                (markdown-render entry show-hashtags?)))

(ns iwaswhere-web.ui.markdown
  (:require [markdown.core :as md]
            [iwaswhere-web.helpers :as h]
            [clojure.string :as s]
            [cljsjs.moment]))

(defn hashtags-replacer
  "Replaces hashtags in entry text. Depending on show-hashtags? switch either displays
  the hashtag or not. Creates link for each hashtag, which opens iWasWhere in new tab,
  with the filter set to the clicked hashtag."
  [show-hashtags?]
  (fn [acc hashtag]
    (let [f-hashtag (if show-hashtags? hashtag (subs hashtag 1))
          with-link (str " " f-hashtag "")]
      (s/replace acc (re-pattern (str "[^*]" hashtag "(?!\\w)")) with-link))))

(defn mentions-replacer
  "Replaces mentions in entry text."
  [acc mention]
  (let [with-link (str " " mention "")]
    (s/replace acc mention with-link)))

(defn- reducer
  "Generic reducer, allows calling specified function for each item in the collection."
  [text coll fun]
  (reduce fun text coll))

(defn markdown-render
  "Renders a markdown div using :dangerouslySetInnerHTML. Not that dangerous here since
  application is only running locally, so in doubt we could only harm ourselves.
  Returns nil when entry does not contain markdown text."
  [entry show-hashtags?]
  (when-let [md-string (:md entry)]
    (let [formatted-md (-> md-string
                           (reducer (:tags entry) (hashtags-replacer show-hashtags?))
                           (reducer (:mentions entry) mentions-replacer))]
      [:div {:dangerouslySetInnerHTML {:__html (md/md->html formatted-md)}}])))

(defn editable-md-render
  "Renders markdown in a pre>code element, with editable content. Sends update message to store
  component on any change to the component. The save button sends updated entry to the backend."
  [entry temp-entry hashtags mentions put-fn]
  (let [md-string (or (:md temp-entry) (:md entry) "edit here")
        ts (:timestamp entry)
        get-content #(aget (.. % -target -parentElement -parentElement -firstChild -firstChild) "innerText")
        update-temp-fn (fn [ev]
                         (let [cursor-pos {:cursor-pos (.-anchorOffset (.getSelection js/window))}
                               updated (with-meta (merge entry (h/parse-entry (get-content ev))) cursor-pos)]
                           (put-fn [:update/temp-entry {:timestamp ts :updated updated}])))
        on-keydown-fn (fn [ev] (let [key-code (.. ev -keyCode)
                                     meta-key (.. ev -metaKey)]
                                 (when (and meta-key (= key-code 83))
                                   (if (not= entry temp-entry) ; when no change, toggle edit mode
                                     (put-fn [:text-entry/update temp-entry])
                                     (put-fn [:cmd/toggle {:timestamp ts :key :show-edit-for}]))
                                   (.preventDefault ev))
                                 (when (= key-code 9)
                                   ;(put-fn [:text-entry/update temp-entry])
                                   (prn key-code)
                                   (.preventDefault ev))))]
    [:div.edit-md
     [:pre [:code {:content-editable true
                   :on-input         update-temp-fn
                   :on-key-down      on-keydown-fn}
            md-string]]
     (when temp-entry
       (let [cursor-pos (:cursor-pos (meta temp-entry))
             md (:md temp-entry)
             before-cursor (subs md 0 cursor-pos)
             current-tag (re-find (js/RegExp. "(?!^)#[\\w\\-\\u00C0-\\u017F]+$" "m") before-cursor)
             current-tag-regex (js/RegExp. current-tag "i")
             tag-substr-filter (fn [tag] (when current-tag (re-find current-tag-regex tag)))]
         [:div.suggestions
          (for [tag (filter tag-substr-filter hashtags)]
            ^{:key (str ts tag)}
            [:div
             {:on-click #(let [updated (merge entry (h/parse-entry (s/replace md current-tag tag)))]
                          (put-fn [:update/temp-entry {:timestamp ts :updated updated}]))}
             [:span.hashtag tag]])]))
     (when temp-entry
       (let [cursor-pos (:cursor-pos (meta temp-entry))
             md (:md temp-entry)
             before-cursor (subs md 0 cursor-pos)
             current-mention (re-find (js/RegExp. "@[\\w\\-\\u00C0-\\u017F]+$" "m") before-cursor)
             current-mention-regex (js/RegExp. current-mention "i")
             mention-substr-filter (fn [mention] (when current-mention (re-find current-mention-regex mention)))]
         [:div.suggestions
          (for [mention (filter mention-substr-filter mentions)]
            ^{:key (str ts mention)}
            [:div
             {:on-click #(let [updated (merge entry (h/parse-entry (s/replace md current-mention mention)))]
                          (put-fn [:update/temp-entry {:timestamp ts :updated updated}]))}
             [:span.mention mention]])]))]))

(defn md-render
  "Helper for conditionally either showing rendered output or editable markdown."
  [entry temp-entry hashtags mentions put-fn editable? show-hashtags?]
  (if editable? (editable-md-render entry temp-entry hashtags mentions put-fn)
                (markdown-render entry show-hashtags?)))

fix punctation

fix punctation


;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns immutant.websocket
  "Provides the creation of asynchronous Websocket services deployed
  as either an Undertow HttpHandler (create-handler) or a JSR 356
  Endpoint (create-servlet)"
  (:require [immutant.logging :as log]
            [immutant.web.undertow.websocket :as undertow]
            [immutant.web.javax :as javax]
            [ring.util.response :refer [response]]))

(defprotocol Channel
  "Websocket channel interface"
  (open? [ch] "Is the channel open?")
  (close [ch] "Gracefully close the channel")
  (send! [ch message] "Send a message asynchronously"))

(extend-protocol Channel

  io.undertow.websockets.core.WebSocketChannel
  (send! [ch message] (undertow/send! ch message))
  (open? [ch] (.isOpen ch))
  (close [ch] (.sendClose ch))

  javax.websocket.Session
  (send! [ch message] (.sendObject (.getAsyncRemote ch) message))
  (open? [ch] (.isOpen ch))
  (close [ch] (.close ch)))

(defn create-handler
  "The following callbacks are supported, where Channel is an instance
  of io.undertow.websockets.core.WebSocketChannel:

    :on-message (fn [channel message])
    :on-open    (fn [channel])
    :on-close   (fn [channel {:keys [code reason]}])
    :on-error   (fn [channel throwable])
    :fallback   (fn [request] (response ...))"
  [{:keys [on-message on-open on-close on-error fallback] :as args}]
  (undertow/create-websocket-handler args))

(defn create-servlet
  "The same callbacks accepted by create-handler are supported, where
  the Channel passed to the callbacks is an instance of
  javax.websocket.Session

  In addition, a :path may be specified. It will be resolved relative
  to the path on which the returned servlet is mounted"
  [{:keys [path on-message on-open on-close on-error fallback] :as args}]
  (javax/create-endpoint-servlet (javax/create-endpoint args) args))

;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns immutant.websocket
  "Provides the creation of asynchronous Websocket services deployed
  as either an Undertow HttpHandler (create-handler) or a JSR 356
  Endpoint (create-servlet)"
  (:require [immutant.logging :as log]
            [immutant.web.undertow.websocket :as undertow]
            [immutant.web.javax :as javax]
            [ring.util.response :refer [response]]))

(defprotocol Channel
  "Websocket channel interface"
  (open? [ch] "Is the channel open?")
  (close [ch] "Gracefully close the channel")
  (send! [ch message] "Send a message asynchronously"))

(extend-protocol Channel

  io.undertow.websockets.core.WebSocketChannel
  (send! [ch message] (undertow/send! ch message))
  (open? [ch] (.isOpen ch))
  (close [ch] (.sendClose ch))

  javax.websocket.Session
  (send! [ch message] (.sendObject (.getAsyncRemote ch) message))
  (open? [ch] (.isOpen ch))
  (close [ch] (.close ch)))

(defn create-handler
  "The following callbacks are supported, where Channel is an instance
  of io.undertow.websockets.core.WebSocketChannel:

    :on-message (fn [channel message])
    :on-open    (fn [channel])
    :on-close   (fn [channel {:keys [code reason]}])
    :on-error   (fn [channel throwable])
    :fallback   (fn [request] (response ...))"
  ([key value & key-values]
     (create-handler (apply hash-map key value key-values)))
  ([{:keys [on-message on-open on-close on-error fallback] :as args}]
     (undertow/create-websocket-handler args)))

(defn create-servlet
  "The same callbacks accepted by create-handler are supported, where
  the Channel passed to the callbacks is an instance of
  javax.websocket.Session

  In addition, a :path may be specified. It will be resolved relative
  to the path on which the returned servlet is mounted"
  ([key value & key-values]
     (create-servlet (apply hash-map key value key-values)))
  ([{:keys [path on-message on-open on-close on-error fallback] :as args}]
     (javax/create-endpoint-servlet (javax/create-endpoint args) args)))

Allow websocket fns to take kwargs.

Allow websocket fns to take kwargs.


(ns pc.repl
  "Utility functions to make repl access more convenient.
   Also serves as a guide for how nses should be aliased"
  (:require [cheshire.core :as json]
            [clj-http.client :as http]
            [clj-time.core :as time]
            [clojure.java.javadoc :refer (javadoc)]
            [clojure.repl :refer :all]
            [datomic.api :as d]
            [pc.datomic :as pcd]
            [pc.models.chat :as chat-model]
            [pc.models.cust :as cust-model]
            [pc.models.doc :as doc-model]
            [pc.models.layer :as layer-model]
            [pc.models.permission :as permission-model]))

(defmacro pomegranate-load [artifact]
  `(do
     (require 'cemerick.pomegranate)
     (cemerick.pomegranate/add-dependencies
      :coordinates '[~artifact]
      :repositories (merge cemerick.pomegranate.aether/maven-central {"clojars" "http://clojars.org/repo"}))))

(defmacro browser-repl []
  `(do
     (require 'weasel.repl.websocket)
     (cemerick.piggieback/cljs-repl :repl-env (weasel.repl.websocket/repl-env :ip "0.0.0.0" :port 9001))))

(ns pc.repl
  "Utility functions to make repl access more convenient.
   Also serves as a guide for how nses should be aliased"
  (:require [cheshire.core :as json]
            [clj-http.client :as http]
            [clj-time.core :as time]
            [clojure.java.javadoc :refer (javadoc)]
            [clojure.repl :refer :all]
            [datomic.api :as d]
            [pc.datomic :as pcd]
            [pc.datomic.web-peer :as web-peer]
            [pc.email :as email]
            [pc.http.sente :as sente]
            [pc.models.chat :as chat-model]
            [pc.models.cust :as cust-model]
            [pc.models.doc :as doc-model]
            [pc.models.flag :as flag-model]
            [pc.models.layer :as layer-model]
            [pc.models.permission :as permission-model]))

(defmacro pomegranate-load [artifact]
  `(do
     (require 'cemerick.pomegranate)
     (cemerick.pomegranate/add-dependencies
      :coordinates '[~artifact]
      :repositories (merge cemerick.pomegranate.aether/maven-central {"clojars" "http://clojars.org/repo"}))))

(defmacro browser-repl []
  `(do
     (require 'weasel.repl.websocket)
     (cemerick.piggieback/cljs-repl :repl-env (weasel.repl.websocket/repl-env :ip "0.0.0.0" :port 9001))))

add a few more helpers to the repl ns

add a few more helpers to the repl ns


{:user {:signing {:gpg-key "james@logi.cl"}

        :dependencies [[acyclic/squiggly-clojure "0.1.2-SNAPSHOT"]
                       [alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [com.cemerick/pomegranate "0.3.0"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [org.clojure/tools.nrepl "0.2.7"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.5"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [com.palletops/lein-shorthand "0.4.0"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require 'spyscope.core)]

        :shorthand {. [^:lazy alembic.still/distill
                       ^:lazy alembic.still/load-project
                       ^:lazy ^:macro alembic.still/lein
                       ^:lazy cemerick.pomegranate/add-classpath
                       ^:lazy cemerick.pomegranate/get-classpath
                       ^:lazy cemerick.pomegranate/resources
                       ^:lazy clojure.java.shell/sh
                       ^:lazy clojure.pprint/pp
                       ^:lazy clojure.pprint/pprint
                       ^:lazy clojure.pprint/print-table
                       clojure.repl/apropos
                       clojure.repl/dir
                       clojure.repl/doc
                       clojure.repl/find-doc
                       clojure.repl/pst
                       clojure.repl/source
                       ^:lazy clojure.reflect/reflect
                       ^:lazy clojure.test/run-all-tests
                       ^:lazy clojure.test/run-tests
                       ^:lazy clojure.tools.namespace.repl/refresh
                       ^:lazy clojure.tools.namespace.repl/refresh-all
                       ^:lazy ^:macro criterium.core/bench
                       ^:lazy ^:macro criterium.core/quick-bench]}

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

{:user {:signing {:gpg-key "james@logi.cl"}

        :dependencies [[acyclic/squiggly-clojure "0.1.2-SNAPSHOT"]
                       [alembic "0.2.1"]
                       [clj-diff "1.0.0-SNAPSHOT"]
                       [clj-stacktrace "0.2.7"]
                       [com.cemerick/pomegranate "0.3.0"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [org.clojure/tools.nrepl "0.2.7"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.5"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [com.palletops/lein-shorthand "0.4.0"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require 'spyscope.core)]

        :shorthand {. [^:lazy alembic.still/distill
                       ^:lazy alembic.still/load-project
                       ^:lazy ^:macro alembic.still/lein
                       ^:lazy cemerick.pomegranate/add-classpath
                       ^:lazy cemerick.pomegranate/get-classpath
                       ^:lazy cemerick.pomegranate/resources
                       ^:lazy clj-diff.core/diff
                       ^:lazy clojure.java.shell/sh
                       ^:lazy clojure.pprint/pp
                       ^:lazy clojure.pprint/pprint
                       ^:lazy clojure.pprint/print-table
                       clojure.repl/apropos
                       clojure.repl/dir
                       clojure.repl/doc
                       clojure.repl/find-doc
                       clojure.repl/pst
                       clojure.repl/source
                       ^:lazy clojure.reflect/reflect
                       ^:lazy clojure.test/run-all-tests
                       ^:lazy clojure.test/run-tests
                       ^:lazy clojure.tools.namespace.repl/refresh
                       ^:lazy clojure.tools.namespace.repl/refresh-all
                       ^:lazy ^:macro criterium.core/bench
                       ^:lazy ^:macro criterium.core/quick-bench]}

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

Add clj-diff

Add clj-diff


(ns u
  (:require [clojure.pprint])
  (:require [clojure.string :as string]))

; =======
; Utilities: general purpose fns to be used mostly inside other fns

(defn sym-to-var [sym]
  "Converts a symbol to var"
  ((ns-interns ((meta (resolve sym)) :ns)) sym))

(defn split [f coll]
  "Like ruby's partition"
  [(filter f coll) (remove f coll)])

; TODO: only display vars local to a namespace
(defn ns-dynamic-vars
  "dynamic vars for a namespace as determined by *var* convention"
  ([] (ns-dynamic-vars *ns*))
  ([nsname]
   (let [nsmap (ns-map nsname)]
     (->> nsmap (map first) (filter #(re-find #"^\*.*\*$" (str %))) (map #(nsmap %))))))

; =========
; Misc: Collection of useful fns for doc, debugging, etc.

;TODO: macroize so it can sit in front of a call like apply
(defn spy "Simple print debugging" [arg]
  (doto arg prn))

(defn doc-dir "Prints docs for a given namespace" [nsname]
  (let [ [resolved unresolved] (split resolve (clojure.repl/dir-fn nsname)) ]
    (doseq [sym resolved]
      (@#'clojure.repl/print-doc (meta (sym-to-var sym))))
    (when-not (empty? unresolved)
      (println (str "\n" "Unable to resolve these symbols: " (string/join ", " unresolved))))))

(def ^:dynamic *display* :table)

(defn display
  "Pretty prints data or returns it depending on value of *display*. Default is to print with table."
  [data & options]
  (case *display*
    :pprint (do (clojure.pprint/pprint data) (println ""))
    :self (identity data)
    (apply table.core/table data options)))

; =========
; Inspectors: inspect vars, namespaces, fns, envs, properties ...

(defn java-methods "List of methods for a java class" [klass]
  (sort (distinct (map #(.getName %) (seq (.getMethods klass))))))

; mtable 'doc
(defn var-meta "Prints meta of a symbol" [sym]
  (display (meta (resolve sym))))

(defn vars-meta "Prints public vars for a namespace with its meta info"
  ([] (vars-meta *ns*))
  ([nsname]
    (display (map #( meta (resolve %)) (clojure.repl/dir-fn nsname)))))

(defn vars-values
  "Prints dynamic vars for a namespace mapped to their values"
   [& options]
   (let [opts (apply hash-map options)]
     (apply
       display
       (cons
         ["Var" "Value"]
         (map #(identity [% (deref %)]) (ns-dynamic-vars (get opts :ns *ns*))))
       :sort true
       options)))

(defn class-paths "Prints list of class paths" []
  (display (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))

(defn properties "List properties and their values" []
  (display
    (->> (System/getProperties) .stringPropertyNames
      (reduce #(assoc %1 %2 (System/getProperty %2)) {}))))

(defn envs "List of envs and their values" []
  (->> (System/getenv) keys (reduce #(assoc %1 %2 (System/getenv %2)) {}) display))

; Configuration
(set! clojure.core/*print-length* 100)
(set! clojure.core/*print-level* 5)

(println "Loaded user.clj!")

(ns u
  (:require [clojure.pprint])
  (:require [clojure.string :as string]))

; =======
; Utilities: general purpose fns to be used mostly inside other fns

(defn sym-to-var [sym]
  "Converts a symbol to var"
  ((ns-interns ((meta (resolve sym)) :ns)) sym))

(defn split [f coll]
  "Like ruby's partition"
  [(filter f coll) (remove f coll)])

; TODO: only display vars local to a namespace
(defn ns-dynamic-vars
  "dynamic vars for a namespace as determined by *var* convention"
  ([] (ns-dynamic-vars *ns*))
  ([nsname]
   (let [nsmap (ns-map nsname)]
     (->> nsmap (map first) (filter #(re-find #"^\*.*\*$" (str %))) (map #(nsmap %))))))

; =========
; Misc: Collection of useful fns for doc, debugging, etc.

;TODO: macroize so it can sit in front of a call like apply
(defn spy "Simple print debugging" [arg]
  (doto arg prn))

(defn doc-dir "Prints docs for a given namespace" [nsname]
  (let [ [resolved unresolved] (split resolve (clojure.repl/dir-fn nsname)) ]
    (doseq [sym resolved]
      (@#'clojure.repl/print-doc (meta (sym-to-var sym))))
    (when-not (empty? unresolved)
      (println (str "\n" "Unable to resolve these symbols: " (string/join ", " unresolved))))))

(defn pster "Print full error stack"
  ([] (pster *e))
  ([err] (->> err .getStackTrace (map clojure.repl/stack-element-str) display)))

(def ^:dynamic *display* :table)

(defn display
  "Pretty prints data or returns it depending on value of *display*. Default is to print with table."
  [data & options]
  (case *display*
    :pprint (do (clojure.pprint/pprint data) (println ""))
    :self (identity data)
    (apply table.core/table data options)))

; =========
; Inspectors: inspect vars, namespaces, fns, envs, properties ...

(defn java-methods "List of methods for a java class" [klass]
  (sort (distinct (map #(.getName %) (seq (.getMethods klass))))))

(defn java-methods-for "List of methods for java object" [obj]
  (java-methods (class obj)))

; mtable 'doc
(defn var-meta "Prints meta of a symbol" [sym]
  (display (meta (resolve sym))))

(defn vars-meta "Prints public vars for a namespace with its meta info"
  ([] (vars-meta *ns*))
  ([nsname]
    (display (map #( meta (resolve %)) (clojure.repl/dir-fn nsname)))))

(defn vars-values
  "Prints dynamic vars for a namespace mapped to their values"
   [& options]
   (let [opts (apply hash-map options)]
     (apply
       display
       (cons
         ["Var" "Value"]
         (map #(identity [% (deref %)]) (ns-dynamic-vars (get opts :ns *ns*))))
       :sort true
       options)))

(defn class-paths "Prints list of class paths" []
  (display (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))

(defn properties "List properties and their values" []
  (display
    (->> (System/getProperties) .stringPropertyNames
      (reduce #(assoc %1 %2 (System/getProperty %2)) {}))))

(defn envs "List of envs and their values" []
  (->> (System/getenv) keys (reduce #(assoc %1 %2 (System/getenv %2)) {}) display))

; Configuration
(set! clojure.core/*print-length* 100)
(set! clojure.core/*print-level* 5)

(println "Loaded user.clj!")

add java-methods-for and pster

add java-methods-for and pster


(ns rook.dispatcher-spec
  (:use speclj.core
        [clojure.template :only [do-template]])
  (:require [io.aviso.rook.dispatcher :as dispatcher]
            [io.aviso.rook.client :as client]
            [io.aviso.rook.utils :as utils]
            [io.aviso.rook.async :as rook-async]
            [io.aviso.rook :as rook]
            [ring.mock.request :as mock]
            [clojure.core.async :as async]
            ring.middleware.params
            ring.middleware.keyword-params)
  (:import (javax.servlet.http HttpServletResponse)))

(defn namespace-handler
  "Produces a handler based on the given namespace."
  ([ns-sym]
     (dispatcher/compile-dispatch-table
       (dispatcher/namespace-dispatch-table ns-sym)))
  ([context-pathvec ns-sym]
     (dispatcher/compile-dispatch-table
       (dispatcher/namespace-dispatch-table context-pathvec ns-sym)))
  ([context-pathvec ns-sym middleware]
     (dispatcher/compile-dispatch-table
       (dispatcher/namespace-dispatch-table context-pathvec ns-sym middleware)))
  ([options context-pathvec ns-sym middleware]
     (dispatcher/compile-dispatch-table options
       (dispatcher/namespace-dispatch-table context-pathvec ns-sym middleware))))

(defn wrap-with-pprint-request [handler]
  (fn [request]
    (dispatcher/pprint-code request)
    (handler request)))

(defn wrap-with-pprint-response [handler]
  (fn [request]
    (let [resp (handler request)]
      (if (satisfies? clojure.core.async.impl.protocols/ReadPort resp)
        (let [v (async/<!! resp)]
          (async/>!! resp v)
          (dispatcher/pprint-code v))
        (dispatcher/pprint-code resp))
      (prn)
      resp)))

(defn wrap-with-resolve-method [handler]
  (rook/wrap-with-arg-resolvers handler
    (fn [kw request]
      (if (identical? kw :request-method)
        (:request-method request)))))

(create-ns 'example.foo)

(binding [*ns* (the-ns 'example.foo)]
  (eval '(do
           (clojure.core/refer-clojure)
           (require '[ring.util.response :as resp])
           (defn index []
             (resp/response "Hello!"))
           (defn show [id]
             (resp/response (str "Interesting id: " id)))
           (defn create [x]
             (resp/response (str "Created " x))))))

(def ^:dynamic *default-middleware* identity)

(def simple-dispatch-table
  [[:get  ["foo"]     'example.foo/index  `*default-middleware*]
   [:post ["foo"]     'example.foo/create `*default-middleware*]
   [:get  ["foo" :id] 'example.foo/show   `*default-middleware*]])

(describe "io.aviso.rook.dispatcher"

  (describe "unnest-dispatch-table"

    (it "should leave tables with no nesting unchanged"

      (should= simple-dispatch-table
        (dispatcher/unnest-dispatch-table simple-dispatch-table)))

    (it "should correctly unnest DTs WITHOUT default middleware"

      (let [dt [(into [["api"]] simple-dispatch-table)]]
        (should= [[:get  ["api" "foo"]     'example.foo/index  `*default-middleware*]
                  [:post ["api" "foo"]     'example.foo/create `*default-middleware*]
                  [:get  ["api" "foo" :id] 'example.foo/show   `*default-middleware*]]
          (dispatcher/unnest-dispatch-table dt))))

    (it "should correctly unnest DTs WITH default middleware and empty context pathvec"

      (let [dt [(into [[] `*default-middleware*]
                  (mapv pop simple-dispatch-table))]]
        (should= simple-dispatch-table
          (dispatcher/unnest-dispatch-table dt))))

    (it "should correctly unnest DTs WITH default middleware and non-empty context pathvec"

      (let [dt [(into [["api"] `*default-middleware*]
                  (mapv pop simple-dispatch-table))]]
        (should= [[:get  ["api" "foo"]     'example.foo/index  `*default-middleware*]
                  [:post ["api" "foo"]     'example.foo/create `*default-middleware*]
                  [:get  ["api" "foo" :id] 'example.foo/show   `*default-middleware*]]
          (dispatcher/unnest-dispatch-table dt)))))

  (describe "compile-dispatch-table"

    (it "should produce a handler returning valid response maps"

      (let [handler (dispatcher/compile-dispatch-table
                      (mapv (comp #(conj % rook/wrap-with-default-arg-resolvers) pop)
                        simple-dispatch-table))
            index-response  (handler (mock/request :get "/foo"))
            show-response   (handler (mock/request :get "/foo/1"))
            create-response (handler (merge (mock/request :post "/foo")
                                       {:params {:x 123}}))]
        (should= {:status 200 :headers {} :body "Hello!"}
          index-response)
        (should= {:status 200 :headers {} :body "Interesting id: 1"}
          show-response)
        (should= {:status 200 :headers {} :body "Created 123"}
          create-response)))

    (it "should inject the middleware"

      (let [handler (dispatcher/compile-dispatch-table simple-dispatch-table)
            a (atom 0)]
        (binding [*default-middleware* (fn [handler]
                                         (fn [request]
                                           (swap! a inc)
                                           (handler request)))]
          (handler (mock/request :get "/foo"))
          (should= 1 @a)))))

  (describe "namespace-dispatch-table"

    (it "should return a DT reflecting the state of the namespace"

      (let [dt (set (dispatcher/unnest-dispatch-table
                      (dispatcher/namespace-dispatch-table
                        ["foo"] 'example.foo `*default-middleware*)))]
        (should= (set simple-dispatch-table) dt))))

  (describe "compiled handlers"

    (it "should return the expected responses"
      (do-template [method path namespace-name extra-params expected-value]
        (should= expected-value
          (let [mw (fn [handler]
                     (-> handler
                       rook/wrap-with-default-arg-resolvers
                       wrap-with-resolve-method
                       ring.middleware.keyword-params/wrap-keyword-params
                       ring.middleware.params/wrap-params))
                dt (dispatcher/namespace-dispatch-table
                     [] namespace-name mw)
                handler (dispatcher/compile-dispatch-table dt)
                body    #(:body % %)]
            (-> (mock/request method path)
              (update-in [:params] merge extra-params)
              handler
              ;; TODO: fix rook-spec and rook-test/activate (the
              ;; latter should return a response map rather than a
              ;; string) and switch back to :body
              body)))

        :get "/?limit=100"   'rook-test {} "limit=100"
        :get "/"             'rook-test {} "limit="
        :get "/123"          'rook-test {} "id=123"
        :get "/123/activate" 'rook-test {} nil
        :put "/"             'rook-test {} nil
        :put "/123"          'rook-test {} nil

        :post "/123/activate" 'rook-test
        {:test1 "foo" :test2 "bar" :test3 "baz" :test4 "quux"}
        "test1=foo,id=123,test2=bar,test3=baz,test4=quux,request=13,meth=:post")))

  (describe "async handlers"

    (it "should return a channel with the correct response"

      (let [handler (namespace-handler
                      {:apply-middleware-fn dispatcher/apply-middleware-async}
                      [] 'barney `*default-middleware*)]
        (should= {:message "ribs!"}
          (-> (mock/request :get "/") handler async/<!! :body))))

    (it "should expose the request's :params key as an argument"
      (let [handler (namespace-handler
                      {:apply-middleware-fn dispatcher/apply-middleware-async}
                      [] 'echo-params rook/wrap-with-default-arg-resolvers)
            params {:foo :bar}]
        (should-be-same params
          (-> (mock/request :get "/")
            (assoc :params params)
            handler
            async/<!!
            :body
            :params-arg))))

    (it "should return a 500 response if a sync handler throws an exception"
      (let [handler (rook-async/async-handler->ring-handler
                      (rook-async/wrap-with-loopback
                        (namespace-handler ["fail"] 'failing rook-async/wrap-restful-format)))]
          (should= HttpServletResponse/SC_INTERNAL_SERVER_ERROR
            (-> (mock/request :get "/fail") handler :status)))))

  (describe "loopback-handler"

    (it "should allow two resources to collaborate"
      (let [handler (rook-async/async-handler->ring-handler
                      (rook-async/wrap-with-loopback
                        (dispatcher/compile-dispatch-table
                          {:apply-middleware-fn dispatcher/apply-middleware-async}
                          (into
                            (dispatcher/namespace-dispatch-table
                              ["fred"] 'fred rook/wrap-with-default-arg-resolvers)
                            (dispatcher/namespace-dispatch-table
                              ["barney"] 'barney rook/wrap-with-default-arg-resolvers)))))]
        (should= ":barney says `ribs!'"
          (-> (mock/request :get "/fred")
            handler
            :body
            :message))))

    (it "should allow three resources to collaborate"
      (let [handler (rook-async/async-handler->ring-handler
                      (rook-async/wrap-with-loopback
                        (dispatcher/compile-dispatch-table
                          {:apply-middleware-fn dispatcher/apply-middleware-async}
                          (-> (dispatcher/namespace-dispatch-table
                                ["fred"] 'fred rook/wrap-with-default-arg-resolvers)
                            (into
                              (dispatcher/namespace-dispatch-table
                                ["barney"] 'barney rook/wrap-with-default-arg-resolvers))
                            (into
                              (dispatcher/namespace-dispatch-table
                                ["betty"] 'betty rook/wrap-with-default-arg-resolvers))))))]
        (should= ":barney says `:betty says `123 is a very fine id!''"
          (-> (mock/request :get "/fred/123") handler :body :message)))))

  (describe "handlers with schema attached"

    (it "should respond appropriately given a valid request"
      (let [middleware (fn [handler]
                         (-> handler
                           rook-async/wrap-with-schema-validation
                           rook/wrap-with-default-arg-resolvers))
            handler    (->> (dispatcher/namespace-dispatch-table
                              ["validating"] 'validating middleware)
                         (dispatcher/compile-dispatch-table
                           {:apply-middleware-fn dispatcher/apply-middleware-async})
                         rook-async/wrap-with-loopback
                         rook-async/async-handler->ring-handler)
            response   (-> (mock/request :post "/validating")
                         (merge {:params {:name "Vincent"}})
                         handler)]
        (should= HttpServletResponse/SC_OK (:status response))
        (should= [:name] (:body response))))

    (it "should send schema validation failures"
      (let [middleware (fn [handler]
                         (-> handler
                           rook-async/wrap-with-schema-validation
                           ring.middleware.keyword-params/wrap-keyword-params
                           ring.middleware.params/wrap-params))
            handler    (->> (dispatcher/namespace-dispatch-table
                              ["validating"] 'validating middleware)
                         (dispatcher/compile-dispatch-table
                           {:apply-middleware-fn dispatcher/apply-middleware-async})
                         rook-async/wrap-with-loopback
                         rook-async/async-handler->ring-handler)
            response   (-> (mock/request :post "/validating")
                         handler)]
        (should= HttpServletResponse/SC_BAD_REQUEST (:status response))
        (should= "validation-error" (-> response :body :error))
        ;; TODO: Not sure that's the exact format I want sent back to the client!
        (should= "{:name missing-required-key}" (-> response :body :failures))))))

(ns rook.dispatcher-spec
  (:use speclj.core
        [clojure.template :only [do-template]])
  (:require [io.aviso.rook.dispatcher :as dispatcher]
            [io.aviso.rook.client :as client]
            [io.aviso.rook.utils :as utils]
            [io.aviso.rook.async :as rook-async]
            [io.aviso.rook :as rook]
            [ring.mock.request :as mock]
            [clojure.core.async :as async]
            ring.middleware.params
            ring.middleware.keyword-params)
  (:import (javax.servlet.http HttpServletResponse)))

(defn namespace-handler
  "Produces a handler based on the given namespace."
  ([ns-sym]
     (dispatcher/compile-dispatch-table
       (dispatcher/namespace-dispatch-table ns-sym)))
  ([context-pathvec ns-sym]
     (dispatcher/compile-dispatch-table
       (dispatcher/namespace-dispatch-table context-pathvec ns-sym)))
  ([context-pathvec ns-sym middleware]
     (dispatcher/compile-dispatch-table
       (dispatcher/namespace-dispatch-table context-pathvec ns-sym middleware)))
  ([options context-pathvec ns-sym middleware]
     (dispatcher/compile-dispatch-table options
       (dispatcher/namespace-dispatch-table context-pathvec ns-sym middleware))))

(defn wrap-with-pprint-request [handler]
  (fn [request]
    (dispatcher/pprint-code request)
    (handler request)))

(defn wrap-with-pprint-response [handler]
  (fn [request]
    (let [resp (handler request)]
      (if (satisfies? clojure.core.async.impl.protocols/ReadPort resp)
        (let [v (async/<!! resp)]
          (async/>!! resp v)
          (dispatcher/pprint-code v))
        (dispatcher/pprint-code resp))
      (prn)
      resp)))

(defn wrap-with-resolve-method [handler]
  (rook/wrap-with-arg-resolvers handler
    (fn [kw request]
      (if (identical? kw :request-method)
        (:request-method request)))))

(defn wrap-with-incrementer [handler atom]
  (fn [request]
    (swap! atom inc)
    (handler request)))

(create-ns 'example.foo)

(binding [*ns* (the-ns 'example.foo)]
  (eval '(do
           (clojure.core/refer-clojure)
           (require '[ring.util.response :as resp])
           (defn index []
             (resp/response "Hello!"))
           (defn show [id]
             (resp/response (str "Interesting id: " id)))
           (defn create [x]
             (resp/response (str "Created " x))))))

(def default-middleware identity)

(def simple-dispatch-table
  [[:get  ["foo"]     'example.foo/index  `default-middleware]
   [:post ["foo"]     'example.foo/create `default-middleware]
   [:get  ["foo" :id] 'example.foo/show   `default-middleware]])

(describe "io.aviso.rook.dispatcher"

  (describe "unnest-dispatch-table"

    (it "should leave tables with no nesting unchanged"

      (should= simple-dispatch-table
        (dispatcher/unnest-dispatch-table simple-dispatch-table)))

    (it "should correctly unnest DTs WITHOUT default middleware"

      (let [dt [(into [["api"]] simple-dispatch-table)]]
        (should= [[:get  ["api" "foo"]     'example.foo/index  `default-middleware]
                  [:post ["api" "foo"]     'example.foo/create `default-middleware]
                  [:get  ["api" "foo" :id] 'example.foo/show   `default-middleware]]
          (dispatcher/unnest-dispatch-table dt))))

    (it "should correctly unnest DTs WITH default middleware and empty context pathvec"

      (let [dt [(into [[] `default-middleware]
                  (mapv pop simple-dispatch-table))]]
        (should= simple-dispatch-table
          (dispatcher/unnest-dispatch-table dt))))

    (it "should correctly unnest DTs WITH default middleware and non-empty context pathvec"

      (let [dt [(into [["api"] `default-middleware]
                  (mapv pop simple-dispatch-table))]]
        (should= [[:get  ["api" "foo"]     'example.foo/index  `default-middleware]
                  [:post ["api" "foo"]     'example.foo/create `default-middleware]
                  [:get  ["api" "foo" :id] 'example.foo/show   `default-middleware]]
          (dispatcher/unnest-dispatch-table dt)))))

  (describe "compile-dispatch-table"

    (it "should produce a handler returning valid response maps"

      (let [handler (dispatcher/compile-dispatch-table
                      (mapv (comp #(conj % rook/wrap-with-default-arg-resolvers) pop)
                        simple-dispatch-table))
            index-response  (handler (mock/request :get "/foo"))
            show-response   (handler (mock/request :get "/foo/1"))
            create-response (handler (merge (mock/request :post "/foo")
                                       {:params {:x 123}}))]
        (should= {:status 200 :headers {} :body "Hello!"}
          index-response)
        (should= {:status 200 :headers {} :body "Interesting id: 1"}
          show-response)
        (should= {:status 200 :headers {} :body "Created 123"}
          create-response)))

    (it "should inject the middleware"

      (let [a (atom 0)]
        (with-redefs [default-middleware (fn [handler]
                                           (fn [request]
                                             (swap! a inc)
                                             (handler request)))]
          (let [handler (dispatcher/compile-dispatch-table simple-dispatch-table)]
            (handler (mock/request :get "/foo"))
            (should= 1 @a))))))

  (describe "namespace-dispatch-table"

    (it "should return a DT reflecting the state of the namespace"

      (let [dt (set (dispatcher/unnest-dispatch-table
                      (dispatcher/namespace-dispatch-table
                        ["foo"] 'example.foo `default-middleware)))]
        (should= (set simple-dispatch-table) dt))))

  (describe "compiled handlers"

    (it "should return the expected responses"
      (do-template [method path namespace-name extra-params expected-value]
        (should= expected-value
          (let [mw (fn [handler]
                     (-> handler
                       rook/wrap-with-default-arg-resolvers
                       wrap-with-resolve-method
                       ring.middleware.keyword-params/wrap-keyword-params
                       ring.middleware.params/wrap-params))
                dt (dispatcher/namespace-dispatch-table
                     [] namespace-name mw)
                handler (dispatcher/compile-dispatch-table dt)
                body    #(:body % %)]
            (-> (mock/request method path)
              (update-in [:params] merge extra-params)
              handler
              ;; TODO: fix rook-spec and rook-test/activate (the
              ;; latter should return a response map rather than a
              ;; string) and switch back to :body
              body)))

        :get "/?limit=100"   'rook-test {} "limit=100"
        :get "/"             'rook-test {} "limit="
        :get "/123"          'rook-test {} "id=123"
        :get "/123/activate" 'rook-test {} nil
        :put "/"             'rook-test {} nil
        :put "/123"          'rook-test {} nil

        :post "/123/activate" 'rook-test
        {:test1 "foo" :test2 "bar" :test3 "baz" :test4 "quux"}
        "test1=foo,id=123,test2=bar,test3=baz,test4=quux,request=13,meth=:post")))

  (describe "async handlers"

    (it "should return a channel with the correct response"

      (let [handler (namespace-handler
                      {:apply-middleware-fn dispatcher/apply-middleware-async}
                      [] 'barney `default-middleware)]
        (should= {:message "ribs!"}
          (-> (mock/request :get "/") handler async/<!! :body))))

    (it "should expose the request's :params key as an argument"
      (let [handler (namespace-handler
                      {:apply-middleware-fn dispatcher/apply-middleware-async}
                      [] 'echo-params rook/wrap-with-default-arg-resolvers)
            params {:foo :bar}]
        (should-be-same params
          (-> (mock/request :get "/")
            (assoc :params params)
            handler
            async/<!!
            :body
            :params-arg))))

    (it "should return a 500 response if a sync handler throws an exception"
      (let [handler (rook-async/async-handler->ring-handler
                      (rook-async/wrap-with-loopback
                        (namespace-handler ["fail"] 'failing rook-async/wrap-restful-format)))]
          (should= HttpServletResponse/SC_INTERNAL_SERVER_ERROR
            (-> (mock/request :get "/fail") handler :status)))))

  (describe "loopback-handler"

    (it "should allow two resources to collaborate"
      (let [handler (rook-async/async-handler->ring-handler
                      (rook-async/wrap-with-loopback
                        (dispatcher/compile-dispatch-table
                          {:apply-middleware-fn dispatcher/apply-middleware-async}
                          (into
                            (dispatcher/namespace-dispatch-table
                              ["fred"] 'fred rook/wrap-with-default-arg-resolvers)
                            (dispatcher/namespace-dispatch-table
                              ["barney"] 'barney rook/wrap-with-default-arg-resolvers)))))]
        (should= ":barney says `ribs!'"
          (-> (mock/request :get "/fred")
            handler
            :body
            :message))))

    (it "should allow three resources to collaborate"
      (let [handler (rook-async/async-handler->ring-handler
                      (rook-async/wrap-with-loopback
                        (dispatcher/compile-dispatch-table
                          {:apply-middleware-fn dispatcher/apply-middleware-async}
                          (-> (dispatcher/namespace-dispatch-table
                                ["fred"] 'fred rook/wrap-with-default-arg-resolvers)
                            (into
                              (dispatcher/namespace-dispatch-table
                                ["barney"] 'barney rook/wrap-with-default-arg-resolvers))
                            (into
                              (dispatcher/namespace-dispatch-table
                                ["betty"] 'betty rook/wrap-with-default-arg-resolvers))))))]
        (should= ":barney says `:betty says `123 is a very fine id!''"
          (-> (mock/request :get "/fred/123") handler :body :message)))))

  (describe "handlers with schema attached"

    (it "should respond appropriately given a valid request"
      (let [middleware (fn [handler]
                         (-> handler
                           rook-async/wrap-with-schema-validation
                           rook/wrap-with-default-arg-resolvers))
            handler    (->> (dispatcher/namespace-dispatch-table
                              ["validating"] 'validating middleware)
                         (dispatcher/compile-dispatch-table
                           {:apply-middleware-fn dispatcher/apply-middleware-async})
                         rook-async/wrap-with-loopback
                         rook-async/async-handler->ring-handler)
            response   (-> (mock/request :post "/validating")
                         (merge {:params {:name "Vincent"}})
                         handler)]
        (should= HttpServletResponse/SC_OK (:status response))
        (should= [:name] (:body response))))

    (it "should send schema validation failures"
      (let [middleware (fn [handler]
                         (-> handler
                           rook-async/wrap-with-schema-validation
                           ring.middleware.keyword-params/wrap-keyword-params
                           ring.middleware.params/wrap-params))
            handler    (->> (dispatcher/namespace-dispatch-table
                              ["validating"] 'validating middleware)
                         (dispatcher/compile-dispatch-table
                           {:apply-middleware-fn dispatcher/apply-middleware-async})
                         rook-async/wrap-with-loopback
                         rook-async/async-handler->ring-handler)
            response   (-> (mock/request :post "/validating")
                         handler)]
        (should= HttpServletResponse/SC_BAD_REQUEST (:status response))
        (should= "validation-error" (-> response :body :error))
        ;; TODO: Not sure that's the exact format I want sent back to the client!
        (should= "{:name missing-required-key}" (-> response :body :failures))))))

Tweak dispatcher-spec in anticipation of changes to the dispatcher


(ns frontend.elevio
  (:require [frontend.utils :as utils]
            [goog.dom :as gdom]
            [goog.dom.classlist :as class-list]))

(def account-id "5639122987b91")

(defn get-root []
  (gdom/getElement "elevio-widget"))

(defn disable! []
  (when-let [el (get-root)]
    (gdom/removeNode el))
  (aset js/window "_elev" #js {}))

(defn enable! []
  (class-list/add js/document.body "circle-elevio")
  (aset js/window "_elev" (or (aget js/window "_elev") #js {}))
  (let [set-elev! (partial aset (aget js/window "_elev"))]
    (set-elev! "account_id" account-id)
    (set-elev! "user" (aget js/window "elevSettings"))
    (set-elev! "translations"
          #js {"loading"
               #js {"loading_ticket" "Loading support request"
                    "loading_tickets" "Loading support requests"
                    "reloading_ticket" "Reloading support request"},
               "modules"
               #js {"support"
                    #js {"create_new_ticket" "Create new support request"
                         "submit" "Submit support request"
                         "reply_placeholder" "Write your reply here"
                         "no_tickets" "Currently no existing support requests"
                         "back_to_tickets" "Back to your support requests"
                         "deflect" "Before you submit a support request, please check to see if your question has already been answered on Discuss."}}})))

(ns frontend.elevio
  (:require [frontend.utils :as utils]
            [goog.dom :as gdom]
            [goog.dom.classlist :as class-list]))

(def account-id "5639122987b91")

(defn get-root []
  (gdom/getElement "elevio-widget"))

(defn disable! []
  (when-let [el (get-root)]
    (gdom/removeNode el))
  (aset js/window "_elev" #js {}))

(defn enable! []
  (class-list/add js/document.body "circle-elevio")
  (aset js/window "_elev" (or (aget js/window "_elev") #js {}))
  (let [set-elev! (partial aset (aget js/window "_elev"))
        is-free (boolean (some-> js/window
                                 (aget "ldUser")
                                 (aget "custom")
                                 (aget "free")))
        user-info (aget js/window "elevSettings")
        _ (-> user-info
              (aget "traits")
              (aset "free" is-free))]
    (set-elev! "account_id" account-id)
    (set-elev! "user" user-info)
    (set-elev! "translations"
          #js {"loading"
               #js {"loading_ticket" "Loading support request"
                    "loading_tickets" "Loading support requests"
                    "reloading_ticket" "Reloading support request"},
               "modules"
               #js {"support"
                    #js {"create_new_ticket" "Create new support request"
                         "submit" "Submit support request"
                         "reply_placeholder" "Write your reply here"
                         "no_tickets" "Currently no existing support requests"
                         "back_to_tickets" "Back to your support requests"
                         "deflect" "Before you submit a support request, please check to see if your question has already been answered on Discuss."}}})))

Add "free" field to elevio user info

Add "free" field to elevio user info


(ns bookmarks.db.seeddata
  (:require [bookmarks.files :refer [get-words]]
            [bookmarks.db.core :as db]))

(defn gen-tags [file-path]
  (distinct (filter (fn [w] (>= (count w) 3))
                    (get-words file-path))))
(defn gen-urls [file-path]
  (map (fn [w] (str "http://www."w ".com"))
       (gen-tags file-path)))

(defn seed-data [file-path]
  (for [r (gen-tags file-path)
        :let [t (first (db/create-tag {:tagname r}))
              bm (first (db/create-bookmark
                  {:title r :url (str "www."r".com")
                  :description r}))]]
    (db/create-bookmark-tag (:bookmarkid bm) (:tagid t))))

(ns bookmarks.db.seeddata
  (:require [bookmarks.files :refer [get-words]]
            [bookmarks.db.core :as db]))

(defn gen-tags [file-path]
  (distinct (filter (fn [w] (>= (count w) 3))
                    (get-words file-path))))
(defn gen-urls [file-path]
  (map (fn [w] (str "http://www."w ".com"))
       (gen-tags file-path)))

(defn seed-data [file-path]
  (for [r (gen-tags file-path)
        :let [t (first (db/create-tag {:tagname r}))
              bm (first (db/create-bookmark
                  {:title r :url (str "www."r".com")
                  :description r}))]]
    (db/create-bookmark-tag {:bookmarkid (:id bm) :tagid (:id t)})))

update seed-data function in seeddata

update seed-data function  in seeddata


(ns theatralia.core
  "All we have of the client right now.

  Defines an application with a part for searching and a part for adding
  materials. Installs it in the HTML element with ID \"app\" on the page where
  it is loaded."
  (:require-macros [cljs.core.async.macros :refer [go]]
                   [reagent.ratom :refer [reaction]])
  (:require [cljs.core.async :as async :refer [put! chan alts!]]
            [reagent.core :as reagent]
            [re-frame.core :as rf]
            [re-frame.handlers :as handlers]
            [re-frame.utils :as rf-utils]
            re-frame.db
            [cljs-uuid-utils.core :as uuid]
            [theatralia.thomsky :as tsky]
            [theatralia.utils :as th-utils :include-macros true]
            [datascript :as d]
            [ajax.core :as ajax]
            [plumbing.core :as plumbing :refer [safe-get]]
            [kioo.reagent :as kioo :include-macros true]
            kioo.util ; so that kioo/component won't cause warnings
            [kioo.core :as kioo-core]))
 ; Deleted all macro stuff. We might need it.

;;; Credits:
;;;  - https://github.com/ckirkendall/kioo
;;;  - https://github.com/ckirkendall/todomvc/blob/gh-pages/labs/architecture-examples/kioo/src/todomvc/app.cljs

;;;; Application setup

(enable-console-print!)

(handlers/register-base :initialize tsky/set-up-datascript!)

;;;; Various helpers

(defn partitionv
  "Like partition, but returns a sequence of vectors instead of a sequence of
  sequences."
  [& args]
  (map vec (apply partition args)))

(defn value
  "Returns the value of the input field whose change caused the
  TEXT-CHANGE-EVENT."
  [text-change-event]
  (-> text-change-event .-target .-value))

;;;; Event handlers

;; FIXME: Server errors when the search string starts with */%2a. (RM
;;        2015-07-09)
(defn search-submitted
  "Send XHR searching for materials."
  [db [scratch-entid]]
  (let [search-string (get-in (d/pull db [:scratch/val] scratch-entid)
                              [:scratch/val "searchInput"])
        url (str "/gq/" (th-utils/url-encode search-string))]
    (when search-string
      (ajax/GET url
                {:format :edn
                 :handler #(rf/dispatch [:search-returned %])
                 :error-handler #(rf/dispatch [:request-errored url %])})))
  [])
(th-utils/register-handler* search-submitted)

;; TODO: Define a format somewhere. (RM 2015-07-02)
(defn search-returned
  "Transact received search result into the database."
  [db [search-result]]
  (let [entid (d/q '[:find ?e . :where [?e :search-result _]] db)]
    [{:db/id (or entid -1)
      :search-result search-result}]))
(th-utils/register-handler* search-returned)

(defn request-errored
  "Report errors of XHRs. Leave database unchanged."
  [_ [url error-map]]
  (rf-utils/error "Request to URL " url " errored: " error-map)
  [])
(th-utils/register-handler* request-errored)

(defn new-scratch
  "Install scratch area with SCRATCH-KEY as its :scratch/key attribute's value."
  [_ [scratch-key]]
  [{:db/id -1
    :scratch/key scratch-key
    :scratch/val {}}])
(th-utils/register-handler* new-scratch)

(defn set-scratch-val
  "Set V as the value of key K in the scratch area indentified by
  SCRATCH-ENTID."
  [db [scratch-entid k v]]
  {:pre [scratch-entid k v]}
  (let [{m :scratch-val}
        (d/pull db [:scratch/val] scratch-entid)]
    [{:db/id scratch-entid
      :scratch/val (assoc (or m {}) k v)}]))
(th-utils/register-handler* set-scratch-val)

;;;; Subscription handlers

(defn get-scratch-entid
  "Entity ID of the scratch area with SCRATCH-KEY as the value of its
  :scratch/key attribute."
  [conn [_ scratch-key]]
  (tsky/bind '[:find ?e .
               :in $ ?key
               :where [?e :scratch/key ?key]]
             conn scratch-key))
(th-utils/register-sub* get-scratch-entid)

(defn get-scratch-val
  "Scratch area with entity ID SCRATCH-ENTID."
  [conn [_ scratch-entid]]
  (reaction
    (safe-get (d/pull @conn [:scratch/val] scratch-entid) :scratch/val)))
(th-utils/register-sub* get-scratch-val)

(defn search-result
  "Result of the material search."
  [db []]
  (tsky/bind '[:find ?rs .
               :where [_ :search-result ?rs]]
             db))
(th-utils/register-sub* search-result)

;;;; Fns for dealing with the scratch part of the database

;; Instead of a random SQUUID we could also take an argument to use as prefix
;; and then a random number. Or just the provided scratch-key, but we'd have to
;; do check for collisions, which could be ugly.
(defn get-scratch
  "Adds a scratch area to the app-db and returns a pair [eid ratom]. eid is the
  ID of an entity with two attributes: :scratch/key (a unique key identifying
  this scratch area) and :scratch/val (a map, the scratch area itself). ratom is
  a reactive atom holding the current value of :scratch/val."
  []
  (let [scratch-key (uuid/make-random-squuid)]
    (rf/dispatch-sync [:new-scratch scratch-key])
    (let [scratch-entid @(rf/subscribe [:get-scratch-entid scratch-key])
          scratch-val-ra (rf/subscribe [:get-scratch-val scratch-entid])]
      [scratch-entid scratch-val-ra])))

(defn dispatch-scratch
  "Convenience fn around rf/dispatch. Suppose s is what (get-scratch) returned.
  Instead of executing (rf/dispatch [some-request-id (first s) param1 …), you
  can pass the whole s like this: (dispatch-scratch [some-request-id s param1
  …)."
  [[request-id [scratch-entid _] & other]]
  (rf/dispatch (into [request-id scratch-entid] other)))

;;;; Fn for dealing with text input fields

(defn bind-and-set-attr
  "Binds a text input field to the given scratch space in the app-db and adds
  the ATTRS to its existing attributes."
  [[scratch-id scratch-ratom] & attrs]
  {:pre [(even? (count attrs))]}
  (fn [node]
    (let [id (plumbing/safe-get-in node [:attrs :id])
          default-attrs
          [:value (get @scratch-ratom id "")
           :onChange #(rf/dispatch [:set-scratch-val scratch-id id (value %)])]]
      ((apply kioo/set-attr
              (concat default-attrs attrs)) node))))

;;;; Views

(defn result-item
  "One item of the material search results."
  [[id title _]]
  (kioo/component "templates/sandbox.html"
    [:#search-results :> :ol :> first-child]
    {[:li] (kioo/do-> (kioo/content title)
                      (kioo/set-attr :key id))}))

(defn result-view
  "Material search results."
  []
  (let [results-ra (rf/subscribe [:search-result])]
    (fn []
      (kioo/component "templates/sandbox.html" [:#search-results]
        {[:ol] (kioo/content (map result-item @results-ra))}))))

(defn search-view
  "A group of components for searching materials."
  []
  (let [scratch (get-scratch)]
    (fn search-view-infn []
      (kioo/component "templates/sandbox.html" [:#search-field]
        {[:#searchInput]
         (bind-and-set-attr
           scratch
           :onKeyDown
           #(when (= (.-key %) "Enter")
              (dispatch-scratch [:search-submitted scratch])))

         [:#submit]
         (kioo/set-attr :onClick #(dispatch-scratch [:search-submitted
                                                     scratch]))}))))

(defn root-view
  "The application's high-level structure."
  []
  (kioo/component "templates/sandbox.html"
    {[:#search-field] (kioo/substitute [search-view])
     [:#search-results] (kioo/substitute [result-view])}))

;;;; Entry point

(rf/dispatch-sync [:initialize])
(reagent/render [root-view]
                (js/document.getElementById "app"))

(ns theatralia.core
  "All we have of the client right now.

  Defines an application with a part for searching and a part for adding
  materials. Installs it in the HTML element with ID \"app\" on the page where
  it is loaded."
  (:require-macros [cljs.core.async.macros :refer [go]]
                   [reagent.ratom :refer [reaction]])
  (:require [cljs.core.async :as async :refer [put! chan alts!]]
            [reagent.core :as reagent]
            [re-frame.core :as rf]
            [re-frame.handlers :as handlers]
            [re-frame.utils :as rf-utils]
            re-frame.db
            [cljs-uuid-utils.core :as uuid]
            [theatralia.thomsky :as tsky]
            [theatralia.utils :as th-utils :include-macros true]
            [datascript :as d]
            [ajax.core :as ajax]
            [plumbing.core :as plumbing :refer [safe-get]]
            [kioo.reagent :as kioo :include-macros true]
            kioo.util ; so that kioo/component won't cause warnings
            [kioo.core :as kioo-core]))
 ; Deleted all macro stuff. We might need it.

;;; Credits:
;;;  - https://github.com/ckirkendall/kioo
;;;  - https://github.com/ckirkendall/todomvc/blob/gh-pages/labs/architecture-examples/kioo/src/todomvc/app.cljs

;;;; Application setup

(enable-console-print!)

(handlers/register-base :initialize tsky/set-up-datascript!)

;;;; Various helpers

(defn partitionv
  "Like partition, but returns a sequence of vectors instead of a sequence of
  sequences."
  [& args]
  (map vec (apply partition args)))

(defn value
  "Returns the value of the input field whose change caused the
  TEXT-CHANGE-EVENT."
  [text-change-event]
  (-> text-change-event .-target .-value))

(defn pull-single
  "Same as (safe-get (pull db [attr] eid) attr), i. e. it saves you from typing
  the extra map lookup and, especially, mistyping the second occurence of ATTR."
  [db attr eid]
  (safe-get (d/pull db [attr] eid) attr))

;;;; Event handlers

;; FIXME: Server errors when the search string starts with */%2a. (RM
;;        2015-07-09)
(defn search-submitted
  "Send XHR searching for materials."
  [db [scratch-entid]]
  (let [search-string (pull-single db :searchInput scratch-entid)
        url (str "/gq/" (th-utils/url-encode search-string))]
    (when search-string
      (ajax/GET url
                {:format :edn
                 :handler #(rf/dispatch [:search-returned %])
                 :error-handler #(rf/dispatch [:request-errored url %])})))
  [])
(th-utils/register-handler* search-submitted)

;; TODO: Define a format somewhere. (RM 2015-07-02)
(defn search-returned
  "Transact received search result into the database."
  [db [search-result]]
  (let [entid (d/q '[:find ?e . :where [?e :search-result _]] db)]
    [{:db/id (or entid -1)
      :search-result search-result}]))
(th-utils/register-handler* search-returned)

(defn request-errored
  "Report errors of XHRs. Leave database unchanged."
  [_ [url error-map]]
  (rf-utils/error "Request to URL " url " errored: " error-map)
  [])
(th-utils/register-handler* request-errored)

(defn new-scratch
  "Install scratch area with SCRATCH-KEY as its :scratch/key attribute's value."
  [_ [scratch-key]]
  [{:db/id -1
    :scratch/key scratch-key}])
(th-utils/register-handler* new-scratch)

(defn set-scratch-val
  "Set V as the value of key K in the scratch area indentified by
  SCRATCH-ENTID."
  [db [scratch-entid k v]]
  {:pre [scratch-entid (keyword? k)]}
  [{:db/id scratch-entid
    k v}])
(th-utils/register-handler* set-scratch-val)

;;;; Subscription handlers

(defn get-scratch-entid
  "Entity ID of the scratch area with SCRATCH-KEY as the value of its
  :scratch/key attribute. Assumes that this scratch area already exists."
  [conn [_ scratch-key]]
  (let [r (tsky/bind '[:find ?e .
                       :in $ ?key
                       :where [?e :scratch/key ?key]]
                     conn scratch-key)]
    (assert @r)
    r))
(th-utils/register-sub* get-scratch-entid)

(defn get-scratch-contents
  "Contents of scratch area with entity ID SCRATCH-ENTID."
  [conn [_ scratch-entid]]
  (reaction (d/pull @conn '[*] scratch-entid)))
(th-utils/register-sub* get-scratch-contents)

(defn search-result
  "Result of the material search."
  [db []]
  (tsky/bind '[:find ?rs .
               :where [_ :search-result ?rs]]
             db))
(th-utils/register-sub* search-result)

;;;; Fns for dealing with the scratch part of the database

;; Instead of a random SQUUID we could also take an argument to use as prefix
;; and then a random number. Or just the provided scratch-key, but we'd have to
;; do check for collisions, which could be ugly.
(defn get-scratch
  "Adds a scratch entity to the app-db and returns a pair [eid ratom].

  eid is the ID of the scratch entity. It has at least one attribute,
  :scratch/key, a unique key which identifies it. Being a scratch space, you can
  attach arbitrary other attributes to it. Their values should probably be
  scalar, but you might try collections. I'm not sure about this. See also
  https://github.com/tonsky/datascript/issues/69.

  ratom is a reactive atom holding all the attributes of the scratch entity."
  []
  (let [scratch-key (uuid/make-random-squuid)]
    (rf/dispatch-sync [:new-scratch scratch-key])
    (let [scratch-entid @(rf/subscribe [:get-scratch-entid scratch-key])

          scratch-contents-ra
          (rf/subscribe [:get-scratch-contents scratch-entid])]
      [scratch-entid scratch-contents-ra])))

(defn dispatch-scratch
  "Convenience fn around rf/dispatch. Suppose s is what (get-scratch) returned.
  Instead of executing (rf/dispatch [some-request-id (first s) param1 …), you
  can pass the whole s like this: (dispatch-scratch [some-request-id s param1
  …)."
  [[request-id [scratch-entid _] & other]]
  (rf/dispatch (into [request-id scratch-entid] other)))

;;;; Fn for dealing with text input fields

(defn bind-and-set-attr
  "Binds a text input field to the given scratch space in the app-db and adds
  the ATTRS to its existing attributes."
  [[scratch-id scratch-ratom] & attrs]
  {:pre [(even? (count attrs))]}
  (fn [node]
    (let [id (keyword (plumbing/safe-get-in node [:attrs :id]))
          default-attrs
          [:value (get @scratch-ratom id "")
           :onChange #(rf/dispatch [:set-scratch-val scratch-id id (value %)])]]
      ((apply kioo/set-attr
              (concat default-attrs attrs)) node))))

;;;; Views

(defn result-item
  "One item of the material search results."
  [[id title _]]
  (kioo/component "templates/sandbox.html"
    [:#search-results :> :ol :> first-child]
    {[:li] (kioo/do-> (kioo/content title)
                      (kioo/set-attr :key id))}))

(defn result-view
  "Material search results."
  []
  (let [results-ra (rf/subscribe [:search-result])]
    (fn []
      (kioo/component "templates/sandbox.html" [:#search-results]
        {[:ol] (kioo/content (map result-item @results-ra))}))))

(defn search-view
  "A group of components for searching materials."
  []
  (let [scratch (get-scratch)]
    (fn search-view-infn []
      (kioo/component "templates/sandbox.html" [:#search-field]
        {[:#searchInput]
         (bind-and-set-attr
           scratch
           :onKeyDown
           #(when (= (.-key %) "Enter")
              (dispatch-scratch [:search-submitted scratch])))

         [:#submit]
         (kioo/set-attr :onClick #(dispatch-scratch [:search-submitted
                                                     scratch]))}))))

(defn root-view
  "The application's high-level structure."
  []
  (kioo/component "templates/sandbox.html"
    {[:#search-field] (kioo/substitute [search-view])
     [:#search-results] (kioo/substitute [result-view])}))

;;;; Entry point

(rf/dispatch-sync [:initialize])
(reagent/render [root-view]
                (js/document.getElementById "app"))

Correct problems with scratch area

Client: Correct problems with scratch area

For some hysteric reason storing a map as an attribute value in
Datascript stopped working.
https://github.com/tonsky/datascript/issues/69 is the reason, I think,
but shouldn't it be fixed according to that discussion? And why did it
work before and doesn't now? It makes no sense.

(Yes, I did bump to Datascript 0.11.5, but when I debumped and cleaned
several times, it didn't start working again.)

Anyway, restructure some things, so that I don't need to store maps
anymore. Some refactorings strewn in as usual. Sorry for that.