(ns re-com.dropdown
  ;Extra
  (:require-macros [clairvoyant.core :refer [trace-forms]])
  (:require
    [re-com.util  :as util]
    [clojure.string :as string]
    [clairvoyant.core :refer [default-tracer]]
    [reagent.core :as reagent]))

;;  Inspiration: http://alxlit.name/bootstrap-chosen
;;  Alternative: http://silviomoreto.github.io/bootstrap-select

(trace-forms {:tracer default-tracer}
             (defn find-option-index
               [options id]
               "In a vector of maps (where each map has an :id), return the index of the first map containing the id parameter
                Returns nil if id not found"
               (let [index-fn (fn [index item] (when (= (:id item) id) index))
                     index-of-id (first (keep-indexed index-fn options))]
                 index-of-id)))

(trace-forms
  {:tracer default-tracer}
  (defn move-to-new-option
    [options id offset]
    "In a vector of maps (where each map has an :id), return the first map containing the id parameter"
    (let [current-index (find-option-index options id)
          new-index (cond
                      (= offset :start) 0
                      (= offset :end) (dec (count options))
                      (nil? current-index) 0
                      :else (mod (+ current-index offset) (count options)))]
      (:id (nth options new-index)))))

(trace-forms {:tracer default-tracer}
             (defn find-option
               [options id]
               "In a vector of maps (where each map has an :id), return the first map containing the id parameter"
               (let [current-index (find-option-index options id)
                     _ (assert ((complement nil?) current-index) (str "Can't find model index '" id "' in options vector"))]
                 (nth options current-index))))

(defn options-with-headings
  [opts]
  "Converts the user specified data for the dropdown into a form that this code can better work with"
  (let [new-opts   (atom [])
        last-group (atom nil)]
    (doall
      (for [opt opts]
        (let [new-group (not= (:group opt) @last-group)
              _         (reset! last-group (:group opt))]
          (when new-group
            (swap! new-opts conj {:id    (str (:id opt) "##")
                                  :group (:group opt)}))
          (swap! new-opts conj {:id    (:id opt)
                                :label (:label opt)}))
        ))
    @new-opts))

(defn filter-options
  "Filter a list of options based on a filter string using plain string searches (case insensitive). Less powerful
   than regex's but no confusion with reserved characters."
  [options filter-text]
  (let [lower-filter-text (string/lower-case filter-text)
        filter-fn        (fn [opt]
                           (or
                             (>= (.indexOf (string/lower-case (:group opt)) lower-filter-text) 0)
                             (>= (.indexOf (string/lower-case (str (:label opt))) lower-filter-text) 0)))] ;; Need str for non-string labels like hiccup
    (filter filter-fn options)))

(defn filter-options-regex
  "Filter a list of options based on a filter string using regex's (case insensitive). More powerful but can cause
   confusion for users entering reserved characters such as [ ] * + . ( ) etc."
  [options filter-text]
  (let [re        (try
                    (js/RegExp. filter-text "i")
                    (catch js/Object e nil))
        filter-fn (partial (fn [re opt]
                             (when-not (nil? re)
                               (or (.test re (:group opt)) (.test re (:label opt)))))
                           re)]
    (filter filter-fn options)))

(defn option-group-heading
  [opt]
  "Render a group option item"
  [:li.group-result
   {:style {:user-select "none"} ;; Prevent user text selection
    :value (:value opt)}
   (:group opt)])

#_(defn option-item-base
  []
  "Render an option item and set up appropriate mouse events"
  (let [mouse-over? (reagent/atom false)]
    (fn [opt on-click model]
      (let [selected (= @model (:id opt))
            class    (if selected
                       " highlighted"
                       (when @mouse-over? " mouseover"))]
        [:li
         {:class         (str "active-result group-option" class)
          :style         {:-webkit-user-select "none"} ;; Prevent user text selection
          :on-mouse-over #(reset! mouse-over? true)
          :on-mouse-out  #(reset! mouse-over? false)
          :on-mouse-down #(on-click (:id opt))}
         (:label opt)]))))

#_(def option-item (with-meta option-item-base
                            {:component-did-mount #(let [node (reagent/dom-node %)]
                                                    (println "option-item-2 did-mount: " (.-innerText node)))
                             :component-did-update #(let [node (reagent/dom-node %)]
                                                     (println "option-item-2 did-update: " (.-innerText node)))
                             }))

(defn option-item
  [opt on-click model]
  "Render an option item and set up appropriate mouse events"
  (let [mouse-over? (reagent/atom false)]
    #_(println ">IN option-item" (:label opt))
    (reagent/create-class
      {:component-did-mount
        (fn [me]
          (let [node     (reagent/dom-node me)
                selected (= @model (:id opt))]
            (when selected (.scrollIntoView node false))
            #_(println "option-item - did-mount" (:label opt))))

       :component-did-update
        (fn [me old-argv]
          (let [node     (reagent/dom-node me)
                selected (= @model (:id opt))]
            #_(println "option-item - did-update" (:label opt))
            ;; TODO: Only options are to fix the element to the top or bottom of the window. Suggested solution is window.scrollTO() :-( See link below...
            ;; http://social.msdn.microsoft.com/Forums/vstudio/en-US/340637f1-835a-43ed-9724-6eb4b166fdf8/html-scrollintoview-question
            (when selected (.scrollIntoView node false))
            ))

       :render
        (fn [me]
          (let [selected (= @model (:id opt))
                class    (if selected
                           " highlighted"
                           (when @mouse-over? " mouseover"))]
            #_(println "option-item - render" (:label opt) (if selected "*SELECTED*" ""))
            [:li
             {:class         (str "active-result group-option" class)
              :style         {:user-select "none"} ;; Prevent user text selection
              :on-mouse-over #(reset! mouse-over? true)
              :on-mouse-out  #(reset! mouse-over? false)
              :on-mouse-down #(on-click (:id opt))} ;; on-click doesn't work because of blur event
             (:label opt)]))
       })
    ))

(trace-forms {:tracer default-tracer}
             (defn filter-text-box-base
               []
               (fn [filter-text key-handler drop-showing? tmp-model] ;; TODO: Remove tmp-model
                 [:div.chosen-search
                  [:input
                   {:type          "text"
                    :auto-complete "off"
                    :value         @filter-text
                    :on-change     #(reset! filter-text (-> % .-target .-value))
                    :on-focus      #(println @tmp-model @drop-showing? "txt.focus")
                    :on-blur       #(do
                                     (reset! drop-showing? false)
                                     (println @tmp-model @drop-showing? "txt.blur"))
                    :on-key-down   key-handler}]])))

(def filter-text-box
  (with-meta filter-text-box-base
             {:component-did-mount #(let [node (.-firstChild (reagent/dom-node %))]
                                     (println "filter-text-box did-mount:" (.-value node))
                                     (.focus node))
              :component-did-update #(let [node (.-firstChild (reagent/dom-node %))] ;; TODO: REMOVE - did-update not actually required
                                      (println "filter-text-box did-update:" (.-value node))
                                      (.focus node))
              }))

;; TODO: BUG: up/down cycles through full list of options instead of filtered list
;;       This is because the parameters (filter-text key-handler) change from time to time but render is using the
;;       initial values, when the component was first mounted.
;;       So, the question becomes, "how do we pass fresh versions of the parameters to the render function?
#_(defn filter-text-box
  [filter-text key-handler]
  (reagent/create-class
    {:component-did-mount
      (fn [me]
        (let [node (.-firstChild (reagent/dom-node me))]
          #_(println "filter-text-box - did-mount: " (.-value node))
          (.focus node)))

     :component-did-update
      (fn [me old-argv]
        (let [node (.-firstChild (reagent/dom-node me))]
          #_(println "filter-text-box - did-update: " (.-value node))
          (.focus node)))

     :render
      (fn [me]
        (let [argv (reagent/argv me)] ;; TODO: Test code...remove
          [:div.chosen-search
           [:input
            {:type          "text"
             :auto-complete "off"
             :value         @filter-text
             :on-change     #(reset! filter-text (-> % .-target .-value))
             :on-key-down   key-handler
             }]]))
     }))

(trace-forms {:tracer default-tracer}
             (defn dropdown-top-base
               []
               (let [ignore-click (atom false)]
                 (fn
                   [tmp-model options tab-index placeholder dropdown-click key-handler filter-box drop-showing?]
                   (let [_ (reagent/set-state (reagent/current-component) {:filter-box filter-box})]
                     [:a.chosen-single.chosen-default
                      {:style         {:user-select "none"} ;; Prevent user text selection
                       :href          "javascript:"   ;; Required to make this anchor appear in the tab order
                       :tab-index     (when tab-index tab-index)
                       :on-click      #(do
                                        (println @tmp-model @drop-showing? "a.click")
                                        (if @ignore-click
                                          (reset! ignore-click false)
                                          (dropdown-click)))
                       :on-mouse-down #(do
                                        (println @tmp-model @drop-showing? "a.mousedown")
                                        (when (and filter-box @drop-showing?) (reset! ignore-click true))) ;; Clicking anchor when filter-text-box is enabled and drop-down
                       :on-key-down   #(do            ;; is open closes then reopens because of txt.blur event
                                        (println @tmp-model @drop-showing? "a.key")
                                        (key-handler %)
                                        (reset! ignore-click true)) ;; Pressing enter on an anchor also triggers click event, which we don't want
                       :on-focus      #(println @tmp-model @drop-showing? "a.focus") ;; TODO: Remove
                       :on-blur       #(do
                                        (println @tmp-model @drop-showing? "a.blur")
                                        (when-not filter-box (reset! drop-showing? false)))
                       }
                      [:span
                       (if @tmp-model
                         (:label (find-option options @tmp-model))
                         placeholder)]
                      [:div [:b]]])))))               ;; This odd bit of markup produces the visual arrow on the right

(def dropdown-top
  (with-meta dropdown-top-base
             {
               ;:component-did-mount #(let [node       (reagent/dom-node %) ;; TODO: REMOVE - did-mount not actually required
               ;                            filter-box (:filter-box (reagent/state %))]
               ;                       (println "dropdown-top did-mount: " (.-text node))
               ;                       #_(when-not filter-box (.focus node)))
               :component-did-update #(let [node       (reagent/dom-node %)
                                            filter-box (:filter-box (reagent/state %))]
                                       (println "dropdown-top did-update: " (.-text node))
                                       (when-not filter-box (.focus node)))}))

(defn single-dropdown
  [& {:keys [model]}]
  "Render a bootstrap styled choosen"
  (let [tmp-model     (reagent/atom (if (satisfies? cljs.core/IDeref model) @model model)) ;; Create a new atom from the model value passed in for use with keyboard actions
        drop-showing? (reagent/atom false)
        filter-text   (reagent/atom "")]
    (fn [& {:keys [options model on-select disabled filter-box regex-filter placeholder width max-height tab-index]}]
      (let [options          (if (satisfies? cljs.core/IDeref options) @options options)
            save-model       (reagent/atom (if (satisfies? cljs.core/IDeref model) @model model))
            disabled         (if (satisfies? cljs.core/IDeref disabled) @disabled disabled)
            changeable       (and on-select (not disabled))
            callback         #(do
                               (reset! tmp-model %)
                               (when changeable (on-select @tmp-model))
                               (reset! drop-showing? (not @drop-showing?)) ;; toggle to allow opening dropdown on Enter key
                               (reset! filter-text ""))
            cancel           #(do
                               (reset! drop-showing? false)
                               (reset! filter-text "")
                               (reset! tmp-model @save-model))
            dropdown-click   #(when-not disabled
                               (reset! drop-showing? (not @drop-showing?)))
            filtered-options (if regex-filter
                               (filter-options-regex options @filter-text)
                               (filter-options options @filter-text))
            key-handler      #(if (not disabled)
                               (case (.-which %)
                                 13 (do
                                      (println @tmp-model @drop-showing? "enter.key")
                                      (if disabled        ;; Enter key
                                        (cancel)
                                        (callback @tmp-model)))
                                 27 (do
                                      (println @tmp-model @drop-showing? "esc.key")
                                      (cancel))           ;; Esc key
                                 9 (do                   ;; Tab key
                                     (println @tmp-model @drop-showing? "tab.key")
                                     (if disabled
                                       (cancel)
                                       (do   ;; Was (callback @tmp-model) but needed a customised version
                                         (when changeable (on-select @tmp-model))
                                         (reset! drop-showing? false)
                                         (reset! filter-text "")))
                                     (reset! drop-showing? false))
                                 38 (do
                                      (println @tmp-model @drop-showing? "up.key")
                                      (if @drop-showing?  ;; Up arrow
                                        (reset! tmp-model (move-to-new-option filtered-options @tmp-model -1))
                                        (reset! drop-showing? true)))
                                 40 (do
                                      (println @tmp-model @drop-showing? "down.key")
                                      (if @drop-showing?  ;; Down arrow
                                        (reset! tmp-model (move-to-new-option filtered-options @tmp-model 1))
                                        (reset! drop-showing? true)))
                                 36 (when @drop-showing?  ;; Home key
                                      (reset! tmp-model (move-to-new-option filtered-options @tmp-model :start)))
                                 35 (when @drop-showing?  ;; End key
                                      (reset! tmp-model (move-to-new-option filtered-options @tmp-model :end)))
                                 true))]
        [:div
         {:class (str "chosen-container chosen-container-single" (when @drop-showing? " chosen-container-active chosen-with-drop"))
          :style (if width
                   {:flex (str "0 0 " width) :width width}
                   {:flex "auto"})}
         [dropdown-top tmp-model options tab-index placeholder dropdown-click key-handler filter-box drop-showing?]
         (when (and @drop-showing? (not disabled))
           [:div.chosen-drop
            (when filter-box [filter-text-box filter-text key-handler drop-showing? tmp-model]) ;; TODO: Remove tmp-model
            [:ul.chosen-results
             (when max-height {:style {:max-height max-height}})
             (if (-> filtered-options count pos?)
               (for [opt (options-with-headings filtered-options)]
                 (if (:group opt)
                   ^{:key (:id opt)} [option-group-heading opt]
                   ^{:key (:id opt)} [option-item opt callback tmp-model]))
               [:li.no-results (str "No results match \"" @filter-text "\"")])]])]))))

(ns re-com.dropdown
  ;Extra
  (:require-macros [clairvoyant.core :refer [trace-forms]])
  (:require
    [re-com.util  :as util]
    [clojure.string :as string]
    [clairvoyant.core :refer [default-tracer]]
    [reagent.core :as reagent]))

;;  Inspiration: http://alxlit.name/bootstrap-chosen
;;  Alternative: http://silviomoreto.github.io/bootstrap-select

(trace-forms {:tracer default-tracer}
             (defn find-option-index
               [options id]
               "In a vector of maps (where each map has an :id), return the index of the first map containing the id parameter
                Returns nil if id not found"
               (let [index-fn (fn [index item] (when (= (:id item) id) index))
                     index-of-id (first (keep-indexed index-fn options))]
                 index-of-id)))

(trace-forms
  {:tracer default-tracer}
  (defn move-to-new-option
    [options id offset]
    "In a vector of maps (where each map has an :id), return the first map containing the id parameter"
    (let [current-index (find-option-index options id)
          new-index (cond
                      (= offset :start) 0
                      (= offset :end) (dec (count options))
                      (nil? current-index) 0
                      :else (mod (+ current-index offset) (count options)))]
      (:id (nth options new-index)))))

(trace-forms {:tracer default-tracer}
             (defn find-option
               [options id]
               "In a vector of maps (where each map has an :id), return the first map containing the id parameter"
               (let [current-index (find-option-index options id)
                     _ (assert ((complement nil?) current-index) (str "Can't find model index '" id "' in options vector"))]
                 (nth options current-index))))

(defn options-with-headings
  [opts]
  "Converts the user specified data for the dropdown into a form that this code can better work with"
  (let [new-opts   (atom [])
        last-group (atom nil)]
    (doall
      (for [opt opts]
        (let [new-group (not= (:group opt) @last-group)
              _         (reset! last-group (:group opt))]
          (when new-group
            (swap! new-opts conj {:id    (str (:id opt) "##")
                                  :group (:group opt)}))
          (swap! new-opts conj {:id    (:id opt)
                                :label (:label opt)}))
        ))
    @new-opts))

(defn filter-options
  "Filter a list of options based on a filter string using plain string searches (case insensitive). Less powerful
   than regex's but no confusion with reserved characters."
  [options filter-text]
  (let [lower-filter-text (string/lower-case filter-text)
        filter-fn        (fn [opt]
                           (or
                             (>= (.indexOf (string/lower-case (:group opt)) lower-filter-text) 0)
                             (>= (.indexOf (string/lower-case (str (:label opt))) lower-filter-text) 0)))] ;; Need str for non-string labels like hiccup
    (filter filter-fn options)))

(defn filter-options-regex
  "Filter a list of options based on a filter string using regex's (case insensitive). More powerful but can cause
   confusion for users entering reserved characters such as [ ] * + . ( ) etc."
  [options filter-text]
  (let [re        (try
                    (js/RegExp. filter-text "i")
                    (catch js/Object e nil))
        filter-fn (partial (fn [re opt]
                             (when-not (nil? re)
                               (or (.test re (:group opt)) (.test re (:label opt)))))
                           re)]
    (filter filter-fn options)))

(defn option-group-heading
  [opt]
  "Render a group option item"
  [:li.group-result
   {:style {:user-select "none"} ;; Prevent user text selection
    :value (:value opt)}
   (:group opt)])

#_(defn option-item-base
  []
  "Render an option item and set up appropriate mouse events"
  (let [mouse-over? (reagent/atom false)]
    (fn [opt on-click model]
      (let [selected (= @model (:id opt))
            class    (if selected
                       " highlighted"
                       (when @mouse-over? " mouseover"))]
        [:li
         {:class         (str "active-result group-option" class)
          :style         {:-webkit-user-select "none"} ;; Prevent user text selection
          :on-mouse-over #(reset! mouse-over? true)
          :on-mouse-out  #(reset! mouse-over? false)
          :on-mouse-down #(on-click (:id opt))}
         (:label opt)]))))

#_(def option-item (with-meta option-item-base
                            {:component-did-mount #(let [node (reagent/dom-node %)]
                                                    (println "option-item-2 did-mount: " (.-innerText node)))
                             :component-did-update #(let [node (reagent/dom-node %)]
                                                     (println "option-item-2 did-update: " (.-innerText node)))
                             }))

(defn option-item
  [opt on-click model]
  "Render an option item and set up appropriate mouse events"
  (let [mouse-over? (reagent/atom false)]
    #_(println ">IN option-item" (:label opt))
    (reagent/create-class
      {:component-did-mount
        (fn [me]
          (let [node     (reagent/dom-node me)
                selected (= @model (:id opt))]
            (when selected (.scrollIntoView node false))
            #_(println "option-item - did-mount" (:label opt))))

       :component-did-update
        (fn [me old-argv]
          (let [node     (reagent/dom-node me)
                selected (= @model (:id opt))]
            #_(println "option-item - did-update" (:label opt))
            ;; TODO: Only options are to fix the element to the top or bottom of the window. Suggested solution is window.scrollTO() :-( See link below...
            ;; http://social.msdn.microsoft.com/Forums/vstudio/en-US/340637f1-835a-43ed-9724-6eb4b166fdf8/html-scrollintoview-question
            (when selected (.scrollIntoView node false))
            ))

       :render
        (fn [me]
          (let [selected (= @model (:id opt))
                class    (if selected
                           " highlighted"
                           (when @mouse-over? " mouseover"))]
            #_(println "option-item - render" (:label opt) (if selected "*SELECTED*" ""))
            [:li
             {:class         (str "active-result group-option" class)
              :style         {:user-select "none"} ;; Prevent user text selection
              :on-mouse-over #(reset! mouse-over? true)
              :on-mouse-out  #(reset! mouse-over? false)
              :on-mouse-down #(on-click (:id opt))} ;; on-click doesn't work because of blur event
             (:label opt)]))
       })
    ))

(trace-forms {:tracer default-tracer}
             (defn filter-text-box-base
               []
               (fn [filter-text key-handler drop-showing? tmp-model] ;; TODO: Remove tmp-model
                 [:div.chosen-search
                  [:input
                   {:type          "text"
                    :auto-complete "off"
                    :value         @filter-text
                    :on-change     #(reset! filter-text (-> % .-target .-value))
                    :on-focus      #(println @tmp-model @drop-showing? "txt.focus")
                    :on-blur       #(do
                                     (reset! drop-showing? false)
                                     (println @tmp-model @drop-showing? "txt.blur"))
                    :on-key-down   key-handler}]])))

(def filter-text-box
  (with-meta filter-text-box-base
             {:component-did-mount #(let [node (.-firstChild (reagent/dom-node %))]
                                     (println "filter-text-box did-mount:" (.-value node))
                                     (.focus node))
              :component-did-update #(let [node (.-firstChild (reagent/dom-node %))] ;; TODO: REMOVE - did-update not actually required
                                      (println "filter-text-box did-update:" (.-value node))
                                      (.focus node))
              }))

;; TODO: BUG: up/down cycles through full list of options instead of filtered list
;;       This is because the parameters (filter-text key-handler) change from time to time but render is using the
;;       initial values, when the component was first mounted.
;;       So, the question becomes, "how do we pass fresh versions of the parameters to the render function?
#_(defn filter-text-box
  [filter-text key-handler]
  (reagent/create-class
    {:component-did-mount
      (fn [me]
        (let [node (.-firstChild (reagent/dom-node me))]
          #_(println "filter-text-box - did-mount: " (.-value node))
          (.focus node)))

     :component-did-update
      (fn [me old-argv]
        (let [node (.-firstChild (reagent/dom-node me))]
          #_(println "filter-text-box - did-update: " (.-value node))
          (.focus node)))

     :render
      (fn [me]
        (let [argv (reagent/argv me)] ;; TODO: Test code...remove
          [:div.chosen-search
           [:input
            {:type          "text"
             :auto-complete "off"
             :value         @filter-text
             :on-change     #(reset! filter-text (-> % .-target .-value))
             :on-key-down   key-handler
             }]]))
     }))

(trace-forms {:tracer default-tracer}
             (defn dropdown-top-base
               []
               (let [ignore-click (atom false)]
                 (fn
                   [tmp-model options tab-index placeholder dropdown-click key-handler filter-box drop-showing?]
                   (let [_ (reagent/set-state (reagent/current-component) {:filter-box filter-box})]
                     [:a.chosen-single.chosen-default
                      {:style         {:user-select "none"} ;; Prevent user text selection
                       :href          "javascript:"   ;; Required to make this anchor appear in the tab order
                       :tab-index     (when tab-index tab-index)
                       :on-click      #(do
                                        (println @tmp-model @drop-showing? "a.click")
                                        (if @ignore-click
                                          (reset! ignore-click false)
                                          (dropdown-click)))
                       :on-mouse-down #(do
                                        (println @tmp-model @drop-showing? "a.mousedown")
                                        (when (and filter-box @drop-showing?) (reset! ignore-click true))) ;; Clicking anchor when filter-text-box is enabled and drop-down
                       :on-key-down   #(do            ;; is open closes then reopens because of txt.blur event
                                        (println @tmp-model @drop-showing? "a.key")
                                        (key-handler %)
                                        (reset! ignore-click true)) ;; Pressing enter on an anchor also triggers click event, which we don't want
                       :on-focus      #(println @tmp-model @drop-showing? "a.focus") ;; TODO: Remove
                       :on-blur       #(do
                                        (println @tmp-model @drop-showing? "a.blur")
                                        (when-not filter-box (reset! drop-showing? false)))
                       }
                      [:span
                       (if @tmp-model
                         (:label (find-option options @tmp-model))
                         placeholder)]
                      [:div [:b]]])))))               ;; This odd bit of markup produces the visual arrow on the right

(def dropdown-top
  (with-meta dropdown-top-base
             {
               ;:component-did-mount #(let [node       (reagent/dom-node %) ;; TODO: REMOVE - did-mount not actually required
               ;                            filter-box (:filter-box (reagent/state %))]
               ;                       (println "dropdown-top did-mount: " (.-text node))
               ;                       #_(when-not filter-box (.focus node)))
               :component-did-update #(let [node       (reagent/dom-node %)
                                            filter-box (:filter-box (reagent/state %))]
                                       (println "dropdown-top did-update: " (.-text node))
                                       (when-not filter-box (.focus node)))}))

(defn single-dropdown
  [& {:keys [model]}]
  "Render a bootstrap styled choosen"
  (let [tmp-model     (reagent/atom (if (satisfies? cljs.core/IDeref model) @model model)) ;; Create a new atom from the model value passed in for use with keyboard actions
        drop-showing? (reagent/atom false)
        filter-text   (reagent/atom "")]
    (fn [& {:keys [options model on-select disabled filter-box regex-filter placeholder width max-height tab-index]}]
      (let [options          (if (satisfies? cljs.core/IDeref options) @options options)
            save-model       (reagent/atom (if (satisfies? cljs.core/IDeref model) @model model))
            disabled         (if (satisfies? cljs.core/IDeref disabled) @disabled disabled)
            changeable       (and on-select (not disabled))
            callback         #(do
                               (reset! tmp-model %)
                               (when changeable (on-select @tmp-model))
                               (reset! drop-showing? (not @drop-showing?)) ;; toggle to allow opening dropdown on Enter key
                               (reset! filter-text ""))
            cancel           #(do
                               (reset! drop-showing? false)
                               (reset! filter-text "")
                               (reset! tmp-model @save-model))
            dropdown-click   #(when-not disabled
                               (reset! drop-showing? (not @drop-showing?)))
            filtered-options (if regex-filter
                               (filter-options-regex options @filter-text)
                               (filter-options options @filter-text))
            key-handler      #(if (not disabled)
                               (case (.-which %)
                                 13 (do
                                      (println @tmp-model @drop-showing? "enter.key")
                                      (if disabled        ;; Enter key
                                        (cancel)
                                        (callback @tmp-model)))
                                 27 (do
                                      (println @tmp-model @drop-showing? "esc.key")
                                      (cancel))           ;; Esc key
                                 9 (do                   ;; Tab key
                                     (println @tmp-model @drop-showing? "tab.key")
                                     (if disabled
                                       (cancel)
                                       (do   ;; Was (callback @tmp-model) but needed a customised version
                                         (when changeable (on-select @tmp-model))
                                         (reset! drop-showing? false)
                                         (reset! filter-text "")))
                                     (reset! drop-showing? false))
                                 38 (do
                                      (println @tmp-model @drop-showing? "up.key")
                                      (if @drop-showing?  ;; Up arrow
                                        (reset! tmp-model (move-to-new-option filtered-options @tmp-model -1))
                                        (reset! drop-showing? true)))
                                 40 (do
                                      (println @tmp-model @drop-showing? "down.key")
                                      (if @drop-showing?  ;; Down arrow
                                        (reset! tmp-model (move-to-new-option filtered-options @tmp-model 1))
                                        (reset! drop-showing? true)))
                                 36 (when @drop-showing?  ;; Home key
                                      (reset! tmp-model (move-to-new-option filtered-options @tmp-model :start)))
                                 35 (when @drop-showing?  ;; End key
                                      (reset! tmp-model (move-to-new-option filtered-options @tmp-model :end)))
                                 true))]

        ;; TODO: Remove this comment

        [:div
         {:class (str "chosen-container chosen-container-single" (when @drop-showing? " chosen-container-active chosen-with-drop"))
          :style (if width
                   {:flex (str "0 0 " width) :width width}
                   {:flex "auto"})}
         [dropdown-top tmp-model options tab-index placeholder dropdown-click key-handler filter-box drop-showing?]
         (when (and @drop-showing? (not disabled))
           [:div.chosen-drop
            (when filter-box [filter-text-box filter-text key-handler drop-showing? tmp-model]) ;; TODO: Remove tmp-model
            [:ul.chosen-results
             (when max-height {:style {:max-height max-height}})
             (if (-> filtered-options count pos?)
               (for [opt (options-with-headings filtered-options)]
                 (if (:group opt)
                   ^{:key (:id opt)} [option-group-heading opt]
                   ^{:key (:id opt)} [option-item opt callback tmp-model]))
               [:li.no-results (str "No results match \"" @filter-text "\"")])]])]))))

Test commit to get git-flow going?

Test commit to get git-flow going?


(ns circle.web.views.common
  (:use noir.core
        hiccup.core
        hiccup.page-helpers)
  (:use [circle.web.user-session :only (logged-in?)])
  (:use [circle.web.util :only (post-link)]))

;; This is hard coded for the signup-page-as-frontpage. Go back some revisions to find the original.

(defn css [path & {:keys [rel type media title] :as opts}]
  [:link (merge {:href (resolve-uri path)} opts)])

(defn center-vertically
  "Take the provided div and center it vertically, by adding classes and
  wrapping it's contents in more divs. It relies on additional.css having
  .vcenter{1,2,3} defined."
  [[tag & args]]
  (let [[m & remaining] args
        property-map (into {:class "vcenter1"} (if (map? m) m {}))
        inner-tags (if (map? m) remaining args)]
    [tag property-map [:div.vcenter2 (apply vector :div.vcenter3 inner-tags)]]))

(defn center-vertically-span
  "Take the provided div and center it vertically, by adding classes and
  wrapping it's contents in more divs. It relies on additional.css having
  .vcenter{1,2,3} defined."
  [[tag & args]]
  (let [[m & remaining] args
        property-map (into {:class "vcenter1"} (if (map? m) m {}))
        inner-tags (if (map? m) remaining args)]
    [tag property-map [:span.vcenter2 (apply vector :span.vcenter3 inner-tags)]]))

(defn google-analytics []
  (html
   [:script {:type "text/javascript"} "
  var _gaq = _gaq || [];
  _gaq.push(['_setAccount', 'UA-25580673-1']);
  _gaq.push(['_trackPageview']);

  (function() {
    var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
    ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
    var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
  })();"]))

(defn login-box []
  (if (logged-in?)
    (post-link "/logout" (format "Logout"))
    (link-to "/login" "Login")))

(defpartial layout
  ;; "Options - a map,
  ;;    :absolute-urls - if true, css and other static assets will use absolute URLs rather than relative"
  [options & content]
  (html5
   [:head
    (google-analytics)
    [:meta {:name "google-site-verification" :content "rCckS33lTuN6tiIrxLMykv_uRR0dMoHNM4XrR4yYUQ0"}]
    [:meta {:http-equiv "Content-Type"
            :content "text/html; charset=utf-8"}]
    [:meta {:name "description"
            :content "Continuous Integration made easy"}]
    [:meta {:name "keywords"
            :content "Circle, heroku, continuous integration, continuous deployment, CI, github"}]
    (css "/css/reset.css" :rel "stylesheet" :type "text/css" :media "screen")
    (css "/css/core.css" :rel "stylesheet" :type "text/css" :media "screen")
    (css "/css/colors_blue_and_green.css" :rel "stylesheet" :type "text/css" :title "Blue and green" :media "screen")
    (css "/css/additional.css" :rel "stylesheet" :type "text/css" :media "screen")
    (css "/css/wufoo.css" :rel "stylesheet" :type "text/css" :media "screen")
    "<!--[if lte IE 8]>
		<link href=\"css/ie.css\" rel=\"stylesheet\" type=\"text/css\" media=\"screen\" />
              <![endif]-->"
    "<!--[if lte IE 10]>
              <script src=\"http://html5shiv.googlecode.com/svn/trunk/html5.js\"></script>
              <![endif]-->"
    (css "http://fonts.googleapis.com/css?family=PT+Sans" :rel "stylesheet" :type "text/css" :media "screen")
    (include-js "/js/jquery_minimized_core.js" "/js/wufoo.js")
    [:title "Circle - Continuous Integration made easy"]]
   [:body
    [:div#notthefooter
     [:div#header_wrap
      [:div#header
       [:h1#logo (link-to {:title "Go to Circle homepage"} "/" [:img#circle {:src "/img/circle-transparent.png"}]
                          [:img#circle-word {:src "/img/circle-word.png"}])]
       (unordered-list {:id "nav"}
                       [(link-to {:class "current_page"}
                                 "/" "Signup")
                        (login-box)])
       [:div.clear]]]
     content
     [:div.clear]
     [:div#notthefooterclear]]
    [:div#footer_wrap
     [:div#footer
      [:div.box_wide.separator_r
       [:p#copyright "Copyright © 2011 Circle"]]
      [:div#social_info.box_small.separator_r
       [:ul
        [:li#twitter [:a {:href "http://twitter.com/circleci"} "follow @circleci"]]]]
      [:div#contact_info.box_small
       [:h5
        (unordered-list
         ["questions@circleci.com"])]]
      [:div.clear]]]]))

(ns circle.web.views.common
  (:use noir.core
        hiccup.core
        hiccup.page-helpers)
  (:use [circle.web.user-session :only (logged-in?)])
  (:use [circle.web.util :only (post-link)]))

;; This is hard coded for the signup-page-as-frontpage. Go back some revisions to find the original.

(defn css [path & {:keys [rel type media title] :as opts}]
  [:link (merge {:href (resolve-uri path)} opts)])

(defn center-vertically
  "Take the provided div and center it vertically, by adding classes and
  wrapping it's contents in more divs. It relies on additional.css having
  .vcenter{1,2,3} defined."
  [[tag & args]]
  (let [[m & remaining] args
        property-map (into {:class "vcenter1"} (if (map? m) m {}))
        inner-tags (if (map? m) remaining args)]
    [tag property-map [:div.vcenter2 (apply vector :div.vcenter3 inner-tags)]]))

(defn center-vertically-span
  "Take the provided div and center it vertically, by adding classes and
  wrapping it's contents in more divs. It relies on additional.css having
  .vcenter{1,2,3} defined."
  [[tag & args]]
  (let [[m & remaining] args
        property-map (into {:class "vcenter1"} (if (map? m) m {}))
        inner-tags (if (map? m) remaining args)]
    [tag property-map [:span.vcenter2 (apply vector :span.vcenter3 inner-tags)]]))

(defn google-analytics []
  (html
   [:script {:type "text/javascript"} "
  var _gaq = _gaq || [];
  _gaq.push(['_setAccount', 'UA-25580673-1']);
  _gaq.push(['_trackPageview']);

  (function() {
    var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
    ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
    var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
  })();"]))

(defn login-box []
  (if (logged-in?)
    (post-link "/logout" (format "Logout"))
    (link-to "/login" "Login")))

(defpartial layout
  ;; "Options - a map,
  ;;    :absolute-urls - if true, css and other static assets will use absolute URLs rather than relative"
  [options & content]
  (html5
   [:head
    (google-analytics)
    [:meta {:name "google-site-verification" :content "rCckS33lTuN6tiIrxLMykv_uRR0dMoHNM4XrR4yYUQ0"}]
    [:meta {:http-equiv "Content-Type"
            :content "text/html; charset=utf-8"}]
    [:meta {:name "description"
            :content "Continuous Integration made easy"}]
    [:meta {:name "keywords"
            :content "Circle, heroku, continuous integration, continuous deployment, CI, github"}]
    (css "/css/reset.css" :rel "stylesheet" :type "text/css" :media "screen")
    (css "/css/core.css" :rel "stylesheet" :type "text/css" :media "screen")
    (css "/css/colors_blue_and_green.css" :rel "stylesheet" :type "text/css" :title "Blue and green" :media "screen")
    (css "/css/additional.css" :rel "stylesheet" :type "text/css" :media "screen")
    (css "/css/wufoo.css" :rel "stylesheet" :type "text/css" :media "screen")
    "<!--[if lte IE 8]>
		<link href=\"css/ie.css\" rel=\"stylesheet\" type=\"text/css\" media=\"screen\" />
              <![endif]-->"
    "<!--[if lte IE 10]>
              <script src=\"http://html5shiv.googlecode.com/svn/trunk/html5.js\"></script>
              <![endif]-->"
    (css "http://fonts.googleapis.com/css?family=PT+Sans" :rel "stylesheet" :type "text/css" :media "screen")
    (include-js "/js/jquery_minimized_core.js" "/js/wufoo.js")
    [:title "Circle - Continuous Integration made easy"]]
   [:body
    [:div#notthefooter
     [:div#header_wrap
      [:div#header
       [:h1#logo (link-to {:title "Go to Circle homepage"} "/" [:img#circle {:src "/img/circle-transparent.png"}]
                          [:img#circle-word {:src "/img/circle-word.png"}])]
       (unordered-list {:id "nav"}
                       [(link-to {:class "current_page"}
                                 "/" "Signup")
;                        (login-box)
                        ])
       [:div.clear]]]
     content
     [:div.clear]
     [:div#notthefooterclear]]
    [:div#footer_wrap
     [:div#footer
      [:div.box_wide.separator_r
       [:p#copyright "Copyright © 2011 Circle"]]
      [:div#social_info.box_small.separator_r
       [:ul
        [:li#twitter [:a {:href "http://twitter.com/circleci"} "follow @circleci"]]]]
      [:div#contact_info.box_small
       [:h5
        (unordered-list
         ["questions@circleci.com"])]]
      [:div.clear]]]]))

Remove login box.

Remove login box.


(ns subman.models
  (:require [clojurewerkz.elastisch.rest :as esr]
            [clojurewerkz.elastisch.rest.index :as esi]
            [clojurewerkz.elastisch.rest.document :as esd]
            [clojurewerkz.elastisch.query :as q]))

(esr/connect! "http://127.0.0.1:9200")

(def index "subman1")

(defn create-index [i-name]
  (esi/create i-name :mappings {"subtitle"
                                {:properties {
                                              :show {:type "string"}
                                              :season {:type "string"}
                                              :episode {:type "string"}
                                              :name {:type "string"}
                                              :lang {:type "string"}
                                              :version {:type "string"}
                                              :url {:type "string"}}}}))

(defn create-document
  "Put document into elastic"
  [doc] (esd/create index "subtitle" doc))

(defn delete-all
  "Delete all documents"
  [] (esd/delete-by-query-across-all-types index (q/match-all)))

(defn search
  "Search for documents"
  [query] (->> (esd/search index "subtitle"
                           :query (q/fuzzy-like-this :like_text "1")
                           :size 100)
               :hits
               :hits
               (map :_source)))

(ns subman.models
  (:require [clojurewerkz.elastisch.rest :as esr]
            [clojurewerkz.elastisch.rest.index :as esi]
            [clojurewerkz.elastisch.rest.document :as esd]
            [clojurewerkz.elastisch.query :as q]))

(esr/connect! "http://127.0.0.1:9200")

(def index "subman1")

(defn create-index [i-name]
  (esi/create i-name :mappings {"subtitle"
                                {:properties {
                                              :show {:type "string"}
                                              :season {:type "string"}
                                              :episode {:type "string"}
                                              :name {:type "string"}
                                              :lang {:type "string"}
                                              :version {:type "string"}
                                              :url {:type "string"}}}}))

(defn create-document
  "Put document into elastic"
  [doc] (esd/create index "subtitle" doc))

(defn delete-all
  "Delete all documents"
  [] (esd/delete-by-query-across-all-types index (q/match-all)))

(defn search
  "Search for documents"
  [query] (->> (esd/search index "subtitle"
                           :query (q/fuzzy-like-this :like_text query)
                           :size 100)
               :hits
               :hits
               (map :_source)))

Fix typo

Fix typo


(ns leiningen.git-deps
  "How this works: It clones projects into .lein-git-deps/<whatever>.
  If the directory already exists, it does a git pull and git checkout."
  (:require [clojure.java.shell :as sh]
            [clojure.java.io :as io]
            [clojure.string :as string]))

(def ^:private git-deps-dir ".lein-git-deps")

(defn- directory-exists?
  "Return true if the specified directory exists."
  [dir]
  (.isDirectory (io/file dir)))

(defn- default-clone-dir
  "Given a git URL, return the directory it would clone into by default."
  [uri]
  (string/join "." (-> uri
                       (string/split #"/")
                       (last)
                       (string/split #"\.")
                       butlast)))

(defn- exec
  "Run a command, throwing an exception if it fails, returning the
  result as with clojure.java.shell/sh."
  [& args]
  (let [{:keys [exit out err] :as result} (apply sh/sh args)]
    (if (zero? exit)
      result
      (throw
       (Exception.
        (format "Command %s failed with exit code %s\n%s\n%s"
                (apply str (interpose " " args))
                exit
                out
                err))))))

(defn- git-clone
  "Clone the git repository at url into dir-name while working in
  directory working-dir."
  [url dir-name working-dir]
  (apply exec (remove nil? ["git" "clone" url (str dir-name) :dir working-dir])))

(defn- git-checkout
  "Check out the specified commit in dir."
  [commit dir]
  (println "Running git checkout " commit " in " (str dir))
  (exec "git" "checkout" commit :dir dir))

(defn- detached-head?
  "Return true if the git repository in dir has HEAD detached."
  [dir]
  (let [{out :out} (exec "git" "branch" "--color=never" :dir dir)
        lines (string/split-lines out)
        current-branch (first (filter #(.startsWith % "*") lines))]
    (when-not current-branch
      (throw (Exception. "Unable to determine current branch")))
    (= current-branch "* (no branch)")))

(defn- git-pull
  "Run 'git-pull' in directory dir, but only if we're on a branch. If
  HEAD is detached, we only do a fetch, not a full pull."
  [dir]
  (println "Running git pull on " (str dir))
  (if (detached-head? dir)
    (do
      (println "Not on a branch, so fetching instead of pulling.")
      (exec "git" "fetch" :dir dir))
    (exec "git" "pull" :dir dir)))

(defn git-deps
  "A leiningen task that will pull dependencies in via git.

  Dependencies should be listed in project.clj under the
  :git-dependencies key in one of these three forms:
  :git-dependencies [;; First form: just a URL.
                     [\"https://github.com/foo/bar.git\"]

                     ;; Second form: A URL and a ref, which can be anything
                     ;; you can specify for 'git checkout', like a commit ide
                     ;; or a branch name.
                     [\"https://github.com/foo/baz.git\"
                      \"329708b\"]

                     ;; Third form: A URL, a commit, and a map
                     [\"https://github.com/foo/quux.git\"
                      \"some-branch\"
                      {:dir \"alternate-directory\"}]]"
  [project]
  (when-not (directory-exists? git-deps-dir)
    (.mkdir (io/file git-deps-dir)))
  (doseq [dep (:git-dependencies project)]
    (println "Setting up dependency for " dep)
    (let [[dep-url commit {clone-dir-name :dir}] dep
          commit (or commit "master")
          clone-dir-name (or clone-dir-name (default-clone-dir dep-url))
          clone-dir (io/file git-deps-dir clone-dir-name)]
      (if (directory-exists? clone-dir)
        (git-pull clone-dir)
        (git-clone dep-url clone-dir-name git-deps-dir))
      (git-checkout commit clone-dir))))

(ns leiningen.git-deps
  "How this works: It clones projects into .lein-git-deps/<whatever>.
  If the directory already exists, it does a git pull and git checkout."
  (:require [clojure.java.shell :as sh]
            [clojure.java.io :as io]
            [clojure.string :as string]))

;; Why, you might ask, are we using str here instead of simply def'ing
;; the var to a string directly? The answer is that we are working
;; around a bug in marginalia where it can't tell the difference
;; between the string that's the value for a def and a docstring. It
;; will hopefully be fixed RSN, because this makes us feel dirty.
(def ^{:private true
       :doc "The directory into which dependencies will be cloned."}
  git-deps-dir (str ".lein-git-deps"))

(defn- directory-exists?
  "Return true if the specified directory exists."
  [dir]
  (.isDirectory (io/file dir)))

(defn- default-clone-dir
  "Given a git URL, return the directory it would clone into by default."
  [uri]
  (string/join "." (-> uri
                       (string/split #"/")
                       (last)
                       (string/split #"\.")
                       butlast)))

(defn- exec
  "Run a command, throwing an exception if it fails, returning the
  result as with clojure.java.shell/sh."
  [& args]
  (let [{:keys [exit out err] :as result} (apply sh/sh args)]
    (if (zero? exit)
      result
      (throw
       (Exception.
        (format "Command %s failed with exit code %s\n%s\n%s"
                (apply str (interpose " " args))
                exit
                out
                err))))))

(defn- git-clone
  "Clone the git repository at url into dir-name while working in
  directory working-dir."
  [url dir-name working-dir]
  (apply exec (remove nil? ["git" "clone" url (str dir-name) :dir working-dir])))

(defn- git-checkout
  "Check out the specified commit in dir."
  [commit dir]
  (println "Running git checkout " commit " in " (str dir))
  (exec "git" "checkout" commit :dir dir))

(defn- detached-head?
  "Return true if the git repository in dir has HEAD detached."
  [dir]
  (let [{out :out} (exec "git" "branch" "--color=never" :dir dir)
        lines (string/split-lines out)
        current-branch (first (filter #(.startsWith % "*") lines))]
    (when-not current-branch
      (throw (Exception. "Unable to determine current branch")))
    (= current-branch "* (no branch)")))

(defn- git-pull
  "Run 'git-pull' in directory dir, but only if we're on a branch. If
  HEAD is detached, we only do a fetch, not a full pull."
  [dir]
  (println "Running git pull on " (str dir))
  (if (detached-head? dir)
    (do
      (println "Not on a branch, so fetching instead of pulling.")
      (exec "git" "fetch" :dir dir))
    (exec "git" "pull" :dir dir)))

(defn git-deps
  "A leiningen task that will pull dependencies in via git.

  Dependencies should be listed in project.clj under the
  :git-dependencies key in one of these three forms:

    :git-dependencies [;; First form: just a URL.
                       [\"https://github.com/foo/bar.git\"]

                       ;; Second form: A URL and a ref, which can be anything
                       ;; you can specify for 'git checkout', like a commit id
                       ;; or a branch name.
                       [\"https://github.com/foo/baz.git\"
                        \"329708b\"]

                       ;; Third form: A URL, a commit, and a map
                       [\"https://github.com/foo/quux.git\"
                        \"some-branch\"
                        {:dir \"alternate-directory\"}]]
"
  [project]
  (when-not (directory-exists? git-deps-dir)
    (.mkdir (io/file git-deps-dir)))
  (doseq [dep (:git-dependencies project)]
    (println "Setting up dependency for " dep)
    (let [[dep-url commit {clone-dir-name :dir}] dep
          commit (or commit "master")
          clone-dir-name (or clone-dir-name (default-clone-dir dep-url))
          clone-dir (io/file git-deps-dir clone-dir-name)]
      (if (directory-exists? clone-dir)
        (git-pull clone-dir)
        (git-clone dep-url clone-dir-name git-deps-dir))
      (git-checkout commit clone-dir))))

Update doc strings to fix Marginalia formatting issues.


(ns ow.factum.logicdb
  (:require [clojure.core.logic.pldb :as lp]
            [clojure.string :as str]
            [ow.factum.clientstorage :as cs]))

(lp/db-rel fact e a v t)

(defn new-logicdb
  ([clientstorage timestamp]
   {:clientstorage clientstorage
    :timestamp timestamp})
  ([clientstorage] (new-logicdb clientstorage nil)))

(defn get-core-logic-db [this]
  ;;; TODO: if timestamp is set and not in the future (minus last update),
  ;;;       we don't need to always recalculate the resulting data, but can
  ;;;       instead cache it:
  (->> (cs/project (:clientstorage this))
       (into [] (map #(vec (cons fact %))))
       (apply lp/db)))

#_(extend-type Fact
  clojure.core.logic.protocols/IUnifyTerms
  (unify-terms [u v s]
    ;;;(println "U:" u ", V:" v ", S:" s)
    (when (and (instance? clojure.lang.PersistentVector v)
               (> (count v) 1))
      (loop [i 0 v v s s]
        ;;;(println "I:" i ", V:" v ", S:" s)
        (if (empty? v)
          s
          (when-let [s (l/unify s (first v) (get u (nth [:e :a :v :t] i)))]
            (recur (inc i) (next v) s)))))))

#_(defn fact-rel [q]
  (fn [a]
    (l/to-stream
     (map #(l/unify a % q)
          #_(sort-by :t > db)
          (get-facts)
          ))))

#_(defmacro query [ldb & body]
  `(lp/with-db ~ldb
     ~@body))

#_(defmacro query1 [ldb & body]
  `(-> (query ~ldb ~@body)
       first))

(ns ow.factum.logicdb
  (:require [clojure.core.logic.pldb :as lp]
            [clojure.string :as str]
            [ow.factum.clientstorage :as cs]))

(lp/db-rel fact e a v t)

(defn new-logicdb
  ([clientstorage timestamp]
   {:clientstorage clientstorage
    :timestamp timestamp})
  ([clientstorage] (new-logicdb clientstorage nil)))

(defn get-core-logic-db [this]
  ;;; TODO: if timestamp is set and not in the future (minus last update),
  ;;;       we don't need to always recalculate the resulting data, but can
  ;;;       instead cache it:
  (->> (cs/project (:clientstorage this)
                   (:timestamp this))
       (into [] (map #(vec (cons fact %))))
       (apply lp/db)))

#_(extend-type Fact
  clojure.core.logic.protocols/IUnifyTerms
  (unify-terms [u v s]
    ;;;(println "U:" u ", V:" v ", S:" s)
    (when (and (instance? clojure.lang.PersistentVector v)
               (> (count v) 1))
      (loop [i 0 v v s s]
        ;;;(println "I:" i ", V:" v ", S:" s)
        (if (empty? v)
          s
          (when-let [s (l/unify s (first v) (get u (nth [:e :a :v :t] i)))]
            (recur (inc i) (next v) s)))))))

#_(defn fact-rel [q]
  (fn [a]
    (l/to-stream
     (map #(l/unify a % q)
          #_(sort-by :t > db)
          (get-facts)
          ))))

#_(defmacro query [ldb & body]
  `(lp/with-db ~ldb
     ~@body))

#_(defmacro query1 [ldb & body]
  `(-> (query ~ldb ~@body)
       first))

fix call to project fn

fix call to project fn


(ns time-tracker.core
  (:require [time-tracker.logging :as log]
            [time-tracker.web.service :as web-service]
            [time-tracker.util :refer [from-config]])
  (:use org.httpkit.server))

(defn -main
  [& args]
  (web-service/init!)
  (log/info {:event ::server-start})
  (run-server web-service/app {:port (Integer/parseInt (from-config :port))}))

(ns time-tracker.core
  (:gen-class)
  (:require [time-tracker.logging :as log]
            [time-tracker.web.service :as web-service]
            [time-tracker.util :refer [from-config]])
  (:use org.httpkit.server))

(defn -main
  [& args]
  (web-service/init!)
  (log/info {:event ::server-start})
  (run-server web-service/app {:port (Integer/parseInt (from-config :port))}))

Add gen-class

Add gen-class


(ns puppetlabs.trapperkeeper.logging-test
  (:import (org.apache.log4j Level Logger))
  (:require [clojure.test :refer :all]
            [puppetlabs.trapperkeeper.core :as trapperkeeper]
            [puppetlabs.trapperkeeper.testutils.logging :refer :all]
            [puppetlabs.trapperkeeper.logging :refer :all]))

(deftest test-catch-all-logger
  (testing "catch-all-logger ensures that message from an exception is logged"
    (with-test-logging
      (catch-all-logger
        (Exception. "This exception is expected; testing error logging")
        "this is my error message")
      (is (logged? #"this is my error message" :error)))))

(deftest test-logging-configuration
  (testing "Calling `configure-logging!` with a log4j.properties file"
    (configure-logging! {:global {:logging-config "./test-resources/log4j.properties"}})
    (is (= (Level/DEBUG) (.getLevel (Logger/getRootLogger)))))

  (testing "Calling `configure-logging!` with another log4j.properties file"
    (configure-logging! {:global {:logging-config "./test-resources/another-log4j.properties"}})
    (is (= (Level/WARN) (.getLevel (Logger/getRootLogger))))))

(ns puppetlabs.trapperkeeper.logging-test
  (:import (org.apache.log4j Level Logger))
  (:require [clojure.test :refer :all]
            [puppetlabs.trapperkeeper.core :as trapperkeeper]
            [puppetlabs.trapperkeeper.testutils.logging :refer :all]
            [puppetlabs.trapperkeeper.logging :refer :all]))

(deftest test-catch-all-logger
  (testing "catch-all-logger ensures that message from an exception is logged"
    (with-test-logging
      (catch-all-logger
        (Exception. "This exception is expected; testing error logging")
        "this is my error message")
      (is (logged? #"this is my error message" :error)))))

(deftest test-logging-configuration
  (testing "Calling `configure-logging!` with a log4j.properties file"
    (configure-logging! {:global {:logging-config "./test-resources/log4j.properties"}})
    (is (= (Level/DEBUG) (.getLevel (Logger/getRootLogger)))))

  (testing
      "Calling `configure-logging!` with another log4j.properties file
      in case the default logging level is DEBUG"
    (configure-logging! {:global {:logging-config "./test-resources/another-log4j.properties"}})
    (is (= (Level/WARN) (.getLevel (Logger/getRootLogger))))))

improve description of test

improve description of test


(ns sample.rangemap)

(deftype RangeMap [kind ^clojure.lang.IPersistentMap m leftfn rightfn]

  clojure.lang.IPersistentMap

  (assoc [this k v]
    (RangeMap. kind (.assoc m k v) leftfn rightfn))

  (assocEx [this k v]
    (RangeMap. kind (.assocEx m k v) leftfn rightfn))

  clojure.lang.ILookup

  (valAt [this k]
    (.valAt this k nil))

  (valAt [this k not-found]
    (let [idx (loop [ks     (keys m)
                     n      (count ks)
                     lastki nil]
                #_(println "LOOP1" lastki ks)
                (if (not-empty ks)
                  (let [i   (int (/ n 2))
                        ki  (get (vec ks) i)
                        cmp (compare ki k)]
                    #_(println "LOOP2" n i ki cmp)
                    (cond
                      (> cmp 0) (recur (take i ks)       i         (leftfn lastki ki))   ;; traverse left
                      (< cmp 0) (recur (drop (inc i) ks) (- n i 1) (rightfn lastki ki))  ;; traverse right
                      (= cmp 0) ki))
                  lastki))]
      (if-not (nil? idx)
        (get m idx)
        not-found)))

  clojure.lang.Seqable

  (seq [this]
    (.seq m))

  java.lang.Iterable

  (iterator [this]
    (.iterator m))

  Object

  (toString [this]
    (.toString m)))

(defn range-map [kind & kvs]
  {:pre [(or (= kind :find-ceiling)
             (= kind :find-floor))]}
  (let [[leftfn rightfn] (case kind
                           :find-floor   [(fn [lastki ki] lastki)
                                          (fn [lastki ki] ki)]
                           :find-ceiling [(fn [lastki ki] ki)
                                          (fn [lastki ki] lastki)])]
    (->RangeMap kind (apply sorted-map kvs) leftfn rightfn)))

(defn range-map-ceiling [& kvs]
  (apply range-map :find-ceiling kvs))

(defn range-map-floor [& kvs]
  (apply range-map :find-floor kvs))

(ns sample.rangemap)

(deftype RangeMap [kind ^clojure.lang.IPersistentMap m leftfn rightfn]

  clojure.lang.IPersistentMap

  (assoc [this k v]
    (RangeMap. kind (.assoc m k v) leftfn rightfn))

  (assocEx [this k v]
    (RangeMap. kind (.assocEx m k v) leftfn rightfn))

  clojure.lang.ILookup

  (valAt [this k]
    (.valAt this k nil))

  (valAt [this k not-found]
    (let [idx (loop [ks     (keys m)
                     n      (count ks)
                     lastki nil]
                #_(println "LOOP1" lastki ks)
                (if (not-empty ks)
                  (let [i   (int (/ n 2))
                        ki  (get (vec ks) i)
                        cmp (compare ki k)]
                    #_(println "LOOP2" n i ki cmp)
                    (cond
                      (> cmp 0) (recur (take i ks)       i         (leftfn lastki ki))   ;; traverse left
                      (< cmp 0) (recur (drop (inc i) ks) (- n i 1) (rightfn lastki ki))  ;; traverse right
                      (= cmp 0) ki))
                  lastki))]
      (if-not (nil? idx)
        (get m idx)
        not-found)))

  clojure.lang.IFn

  (invoke [this arg1]
    (.valAt this arg1))

  clojure.lang.Seqable

  (seq [this]
    (.seq m))

  java.lang.Iterable

  (iterator [this]
    (.iterator m))

  Object

  (toString [this]
    (.toString m)))

(defn range-map [kind & kvs]
  {:pre [(or (= kind :find-ceiling)
             (= kind :find-floor))]}
  (let [[leftfn rightfn] (case kind
                           :find-floor   [(fn [lastki ki] lastki)
                                          (fn [lastki ki] ki)]
                           :find-ceiling [(fn [lastki ki] ki)
                                          (fn [lastki ki] lastki)])]
    (->RangeMap kind (apply sorted-map kvs) leftfn rightfn)))

(defn range-map-ceiling [& kvs]
  (apply range-map :find-ceiling kvs))

(defn range-map-floor [& kvs]
  (apply range-map :find-floor kvs))

implement clojure.lang.IFn for RangeMap

implement clojure.lang.IFn for RangeMap


{:dev
 {:aliases {"test-all" ["with-profile" "dev,1.8:dev,1.6:dev,1.5:dev" "test"]}
  :codeina {:sources ["src"]
            :reader :clojure
            :target "doc/dist/latest/api"
            :src-uri "http://github.com/funcool/buddy-core/blob/master/"
            :src-uri-prefix "#L"}
  :plugins [[funcool/codeina "0.3.0"]
            [lein-ancient "0.6.7"]]}
 :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}
 :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}
 :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}}

{:dev
 {:aliases {"test-all" ["with-profile" "dev:dev,1.7:dev,1.6:dev,1.5" "test"]}
  :codeina {:sources ["src"]
            :reader :clojure
            :target "doc/dist/latest/api"
            :src-uri "http://github.com/funcool/buddy-core/blob/master/"
            :src-uri-prefix "#L"}
  :plugins [[funcool/codeina "0.3.0"]
            [lein-ancient "0.6.7"]]}
 :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}
 :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}
 :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}}

Improve test-all alias.

Improve test-all alias.


;; 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.web-test
  (:require [clojure.test          :refer :all]
            [clojure.set           :refer :all]
            [immutant.util         :as u]
            [immutant.web          :refer :all]
            [immutant.web.internal.wunderboss :refer [create-defaults register-defaults]]
            [testing.web           :refer [get-body hello handler]]
            [testing.hello.service :as pedestal]
            [ring.middleware.resource :refer [wrap-resource]]
            [ring.util.response :refer (charset)]
            [clj-http.client :as http]
            [immutant.web.undertow :as undertow])
  (:import clojure.lang.ExceptionInfo
           java.net.ConnectException))

(u/set-log-level! (or (System/getenv "LOG_LEVEL") :OFF))

(use-fixtures :each u/reset-fixture)

(def url "http://localhost:8080/")
(def url2 "http://localhost:8081/")

(deftest mount-and-remount-pedestal-service
  (run pedestal/servlet)
  (is (= "Hello World!" (get-body url)))
  (run pedestal/servlet)
  (is (= "Hello World!" (get-body url))))

(deftest nil-body
  (run (constantly {:status 200 :body nil}))
  (is (nil? (get-body url))))

(deftest run-takes-kwargs
  (run hello :path "/kwarg")
  (is (= "hello" (get-body (str url "kwarg")))))

(deftest run-returns-default-opts
  (let [opts (run hello)]
    (is (subset? (-> (merge register-defaults create-defaults) keys set)
          (-> opts keys set)))))

(deftest run-returns-passed-opts-with-defaults
  (let [opts (run hello {:path "/abc"})]
    (is (subset? (-> (merge register-defaults create-defaults) keys set)
          (-> opts keys set)))
    (is (= "/abc" (:path opts)))))

(deftest run-should-throw-with-invalid-options
  (is (thrown? IllegalArgumentException (run hello {:invalid true}))))

(deftest stop-should-throw-with-invalid-options
  (is (thrown? IllegalArgumentException (stop {:invalid true}))))

(deftest stop-without-args-stops-default-context
  (run hello)
  (is (= "hello" (get-body url)))
  (run (handler "howdy") {:path "/howdy"})
  (is (= "howdy" (get-body (str url "howdy"))))
  (stop)
  (is (= "howdy" (get-body (str url "howdy"))))
  (is (= 404 (get-body url))))

(deftest stop-with-context-stops-that-context
  (run hello)
  (is (= "hello" (get-body url)))
  (run (handler "howdy") {:path "/howdy"})
  (is (= "howdy" (get-body (str url "howdy"))))
  (stop {:path "/howdy"})
  (is (= "hello" (get-body url)))
  (is (= "hello" (get-body (str url "howdy")))))

(deftest stop-should-accept-kwargs
  (run hello)
  (is (stop :path "/")))

(deftest stopping-last-handler-stops-the-server
  (let [root-opts (run hello)]
    (is (= "hello" (get-body url)))
    (stop root-opts))
  (is (thrown? ConnectException (get-body url))))

(deftest stop-stops-the-requested-server
  (run hello)
  (is (= "hello" (get-body url)))
  (run hello {:port 8081})
  (is (= "hello" (get-body url2)))
  (stop {:port 8081})
  (is (= "hello" (get-body url)))
  (is (thrown? ConnectException (get-body url2))))

(deftest stop-stops-the-default-server-even-with-explicit-opts
  (run hello)
  (is (= "hello" (get-body url)))
  (stop {:port 8080})
  (is (thrown? ConnectException (get-body url))))

(deftest string-args-to-run-should-work
  (run hello {"port" "8081"})
  (is (= "hello" (get-body url2))))

(deftest string-args-to-stop-should-work
  (run hello)
  (run (handler "howdy") {"path" "/howdy"})
  (is (= "hello" (get-body url)))
  (is (= "howdy" (get-body (str url "howdy"))))
  (stop {"path" "/howdy"})
  (is (= "hello" (get-body (str url "howdy")))))

(deftest run-with-threading
  (-> (run hello)
    (assoc :path "/howdy")
    (->> (run (handler "howdy")))
    (assoc :port 8081)
    (->> (run (handler "howdy"))))
  (is (= "hello" (get-body url)))
  (is (= "howdy" (get-body (str url "howdy"))))
  (is (= "howdy" (get-body (str url2 "howdy")))))

(deftest stop-should-stop-all-threaded-apps
  (let [everything (-> (run hello)
                     (assoc :path "/howdy")
                     (->> (run (handler "howdy")))
                     (merge {:path "/" :port 8081})
                     (->> (run (handler "howdy"))))]
    (is (true? (stop everything)))
    (is (thrown? ConnectException (get-body url)))
    (is (thrown? ConnectException (get-body url2)))
    (is (not (stop everything)))))

(deftest run-dmc-should-work
  (let [called (promise)]
    (with-redefs [clojure.java.browse/browse-url (fn [u] (deliver called u))]
      (let [result (run-dmc hello :path "/hello")
            uri (str url "hello")]
        (is (= "hello" (get-body uri)))
        (is (= uri (deref called 1 false)))
        (is (= (run hello :path "/hello") result))))))

(deftest run-dmc-should-take-kwargs
  (let [called (promise)]
    (with-redefs [clojure.java.browse/browse-url (fn [_] (deliver called true))]
      (run-dmc hello :path "/foo")
      (is (= "hello" (get-body (str url "foo"))))
      (is (deref called 1 false)))))

(deftest run-dmc-with-threading
  (let [call-count (atom 0)]
    (with-redefs [clojure.java.browse/browse-url (fn [_] (swap! call-count inc))]
      (-> (run-dmc hello)
        (assoc :path "/howdy")
        (->> (run-dmc (handler "howdy")))
        (assoc :port 8081)
        (->> (run-dmc (handler "howdy"))))
      (is (= 3 @call-count))
      (is (= "hello" (get-body url)))
      (is (= "howdy" (get-body (str url "howdy"))))
      (is (= "howdy" (get-body (str url2 "howdy")))))))

(deftest request-map-entries
  (let [request (atom {})
        handler (comp hello #(swap! request into %))
        server (run handler)]
    (get-body (str url "?query=help") :headers {:content-type "text/html; charset=utf-8"})
    (are [x expected] (= expected (x @request))
         :content-type        "text/html; charset=utf-8"
         :character-encoding  "utf-8"
         :remote-addr         "127.0.0.1"
         :server-port         8080
         :content-length      -1
         :uri                 "/"
         :server-name         "localhost"
         :query-string        "query=help"
         :scheme              :http
         :request-method      :get)
    (is (:body @request))
    (is (map? (:headers @request)))
    (is (< 3 (count (:headers @request))))))

(deftest virtual-hosts
  (let [all (-> (run hello :virtual-host ["integ-app1.torquebox.org" "integ-app2.torquebox.org"])
              (assoc :virtual-host "integ-app3.torquebox.org")
              (->> (run (handler "howdy"))))]
    (is (= "hello" (get-body "http://integ-app1.torquebox.org:8080/")))
    (is (= "hello" (get-body "http://integ-app2.torquebox.org:8080/")))
    (is (= "howdy" (get-body "http://integ-app3.torquebox.org:8080/")))
    (is (= 404 (get-body url)))
    (is (true? (stop :virtual-host "integ-app1.torquebox.org")))
    (is (= 404 (get-body "http://integ-app1.torquebox.org:8080/")))
    (is (= "hello" (get-body "http://integ-app2.torquebox.org:8080/")))
    (is (= "howdy" (get-body "http://integ-app3.torquebox.org:8080/")))
    (is (true? (stop all)))
    (is (thrown? ConnectException (get-body "http://integ-app2.torquebox.org:8080/")))
    (is (thrown? ConnectException (get-body "http://integ-app3.torquebox.org:8080/")))
    (is (nil? (stop all)))))

(deftest relative-resource-paths
  (run (-> hello (wrap-resource "public")))
  (is (= "foo" (get-body (str url "foo.html"))))
  (stop)
  (run (-> hello (wrap-resource "public")) :path "/foo")
  (is (= "foo" (get-body (str url "foo/foo.html"))))
  (is (= "hello" (get-body (str url "foo")))))

(deftest servers
  (let [srv (server)]
    (is (every? (partial identical? srv)
          [(server :port 8080)
           (server {:port 8080})
           (server (run hello))]))
    (is (.isRunning srv))
    (.stop srv)
    (is (not (.isRunning srv)))
    (.start srv)
    (is (.isRunning srv))
    (is (= "hello" (get-body url)))))

(deftest https
  (run hello (undertow/options
               :ssl-port 8443
               :keystore "dev-resources/keystore.jks"
               :key-password "password"))
  (let [response (http/get "https://localhost:8443" {:insecure? true})]
    (is (= (:status response) 200))
    (is (= (:body response) "hello"))))

(deftest encoding
  (run (fn [r] (charset ((handler "ɮѪϴ") r) "UTF-16")))
  (is (= "ɮѪϴ" (get-body url))))

;; 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.web-test
  (:require [clojure.test          :refer :all]
            [clojure.set           :refer :all]
            [immutant.util         :as u]
            [immutant.web          :refer :all]
            [immutant.web.internal.wunderboss :refer [create-defaults register-defaults]]
            [testing.web           :refer [get-body hello handler]]
            [testing.hello.service :as pedestal]
            [ring.middleware.resource :refer [wrap-resource]]
            [ring.util.response :refer (charset)]
            [clj-http.client :as http]
            [immutant.web.undertow :as undertow])
  (:import clojure.lang.ExceptionInfo
           java.net.ConnectException))

(u/set-log-level! (or (System/getenv "LOG_LEVEL") :OFF))

(use-fixtures :each u/reset-fixture)

(def url "http://localhost:8080/")
(def url2 "http://localhost:8081/")

(deftest mount-and-remount-pedestal-service
  (run pedestal/servlet)
  (is (= "Hello World!" (get-body url)))
  (run pedestal/servlet)
  (is (= "Hello World!" (get-body url))))

(deftest nil-body
  (run (constantly {:status 200 :body nil}))
  (is (nil? (get-body url))))

(deftest run-takes-kwargs
  (run hello :path "/kwarg")
  (is (= "hello" (get-body (str url "kwarg")))))

(deftest run-returns-default-opts
  (let [opts (run hello)]
    (is (subset? (-> (merge register-defaults create-defaults) keys set)
          (-> opts keys set)))))

(deftest run-returns-passed-opts-with-defaults
  (let [opts (run hello {:path "/abc"})]
    (is (subset? (-> (merge register-defaults create-defaults) keys set)
          (-> opts keys set)))
    (is (= "/abc" (:path opts)))))

(deftest run-should-throw-with-invalid-options
  (is (thrown? IllegalArgumentException (run hello {:invalid true}))))

(deftest stop-should-throw-with-invalid-options
  (is (thrown? IllegalArgumentException (stop {:invalid true}))))

(deftest stop-without-args-stops-default-context
  (run hello)
  (is (= "hello" (get-body url)))
  (run (handler "howdy") {:path "/howdy"})
  (is (= "howdy" (get-body (str url "howdy"))))
  (stop)
  (is (= "howdy" (get-body (str url "howdy"))))
  (is (= 404 (get-body url))))

(deftest stop-with-context-stops-that-context
  (run hello)
  (is (= "hello" (get-body url)))
  (run (handler "howdy") {:path "/howdy"})
  (is (= "howdy" (get-body (str url "howdy"))))
  (stop {:path "/howdy"})
  (is (= "hello" (get-body url)))
  (is (= "hello" (get-body (str url "howdy")))))

(deftest stop-should-accept-kwargs
  (run hello)
  (is (stop :path "/")))

(deftest stopping-last-handler-stops-the-server
  (let [root-opts (run hello)]
    (is (= "hello" (get-body url)))
    (stop root-opts))
  (is (thrown? ConnectException (get-body url))))

(deftest stop-stops-the-requested-server
  (run hello)
  (is (= "hello" (get-body url)))
  (run hello {:port 8081})
  (is (= "hello" (get-body url2)))
  (stop {:port 8081})
  (is (= "hello" (get-body url)))
  (is (thrown? ConnectException (get-body url2))))

(deftest stop-stops-the-default-server-even-with-explicit-opts
  (run hello)
  (is (= "hello" (get-body url)))
  (stop {:port 8080})
  (is (thrown? ConnectException (get-body url))))

(deftest string-args-to-run-should-work
  (run hello {"port" "8081"})
  (is (= "hello" (get-body url2))))

(deftest string-args-to-stop-should-work
  (run hello)
  (run (handler "howdy") {"path" "/howdy"})
  (is (= "hello" (get-body url)))
  (is (= "howdy" (get-body (str url "howdy"))))
  (stop {"path" "/howdy"})
  (is (= "hello" (get-body (str url "howdy")))))

(deftest run-with-threading
  (-> (run hello)
    (assoc :path "/howdy")
    (->> (run (handler "howdy")))
    (assoc :port 8081)
    (->> (run (handler "howdy"))))
  (is (= "hello" (get-body url)))
  (is (= "howdy" (get-body (str url "howdy"))))
  (is (= "howdy" (get-body (str url2 "howdy")))))

(deftest stop-should-stop-all-threaded-apps
  (let [everything (-> (run hello)
                     (assoc :path "/howdy")
                     (->> (run (handler "howdy")))
                     (merge {:path "/" :port 8081})
                     (->> (run (handler "howdy"))))]
    (is (true? (stop everything)))
    (is (thrown? ConnectException (get-body url)))
    (is (thrown? ConnectException (get-body url2)))
    (is (not (stop everything)))))

(deftest run-dmc-should-work
  (let [called (promise)]
    (with-redefs [clojure.java.browse/browse-url (fn [u] (deliver called u))]
      (let [result (run-dmc hello :path "/hello")
            uri (str url "hello")]
        (is (= "hello" (get-body uri)))
        (is (= uri (deref called 1 false)))
        (is (= (run hello :path "/hello") result))))))

(deftest run-dmc-should-take-kwargs
  (let [called (promise)]
    (with-redefs [clojure.java.browse/browse-url (fn [_] (deliver called true))]
      (run-dmc hello :path "/foo")
      (is (= "hello" (get-body (str url "foo"))))
      (is (deref called 1 false)))))

(deftest run-dmc-with-threading
  (let [call-count (atom 0)]
    (with-redefs [clojure.java.browse/browse-url (fn [_] (swap! call-count inc))]
      (-> (run-dmc hello)
        (assoc :path "/howdy")
        (->> (run-dmc (handler "howdy")))
        (assoc :port 8081)
        (->> (run-dmc (handler "howdy"))))
      (is (= 3 @call-count))
      (is (= "hello" (get-body url)))
      (is (= "howdy" (get-body (str url "howdy"))))
      (is (= "howdy" (get-body (str url2 "howdy")))))))

(deftest request-map-entries
  (let [request (atom {})
        handler (comp hello #(swap! request into %))
        server (run handler)]
    (get-body (str url "?query=help") :headers {:content-type "text/html; charset=utf-8"})
    (are [x expected] (= expected (x @request))
         :content-type        "text/html; charset=utf-8"
         :character-encoding  "utf-8"
         :remote-addr         "127.0.0.1"
         :server-port         8080
         :content-length      -1
         :uri                 "/"
         :server-name         "localhost"
         :query-string        "query=help"
         :scheme              :http
         :request-method      :get)
    (is (:body @request))
    (is (map? (:headers @request)))
    (is (< 3 (count (:headers @request))))))

(deftest virtual-hosts
  (let [all (-> (run hello :virtual-host ["integ-app1.torquebox.org" "integ-app2.torquebox.org"])
              (assoc :virtual-host "integ-app3.torquebox.org")
              (->> (run (handler "howdy"))))]
    (is (= "hello" (get-body "http://integ-app1.torquebox.org:8080/")))
    (is (= "hello" (get-body "http://integ-app2.torquebox.org:8080/")))
    (is (= "howdy" (get-body "http://integ-app3.torquebox.org:8080/")))
    (is (= 404 (get-body url)))
    (is (true? (stop :virtual-host "integ-app1.torquebox.org")))
    (is (= 404 (get-body "http://integ-app1.torquebox.org:8080/")))
    (is (= "hello" (get-body "http://integ-app2.torquebox.org:8080/")))
    (is (= "howdy" (get-body "http://integ-app3.torquebox.org:8080/")))
    (is (true? (stop all)))
    (is (thrown? ConnectException (get-body "http://integ-app2.torquebox.org:8080/")))
    (is (thrown? ConnectException (get-body "http://integ-app3.torquebox.org:8080/")))
    (is (nil? (stop all)))))

(deftest relative-resource-paths
  (run (-> hello (wrap-resource "public")))
  (is (= "foo" (get-body (str url "foo.html"))))
  (stop)
  (run (-> hello (wrap-resource "public")) :path "/foo")
  (is (= "foo" (get-body (str url "foo/foo.html"))))
  (is (= "hello" (get-body (str url "foo")))))

(deftest servers
  (let [srv (server)]
    (is (every? (partial identical? srv)
          [(server :port 8080)
           (server {:port 8080})
           (server (run hello))]))
    (is (.isRunning srv))
    (.stop srv)
    (is (not (.isRunning srv)))
    (.start srv)
    (is (.isRunning srv))
    (is (= "hello" (get-body url)))))

(deftest https
  (run hello (undertow/options
               :ssl-port 8443
               :keystore "dev-resources/keystore.jks"
               :key-password "password"))
  (let [response (http/get "https://localhost:8443" {:insecure? true})]
    (is (= (:status response) 200))
    (is (= (:body response) "hello"))))

(deftest encoding
  (run (fn [r] (charset ((handler "ɮѪϴ") r) "UTF-16")))
  (is (= "ɮѪϴ" (:body (http/get url {:as :auto})))))

Use clj-http instead of the buggier http.async.client [IMMUTANT-506]


(set-env!
 :source-paths    #{"src/main"}
 :resource-paths  #{"resources"}
 :dependencies '[[org.clojure/clojurescript   "1.9.89"]
                 [org.omcljs/om               "1.0.0-alpha41"]
                 [compassus                   "0.2.1"]
                 [bidi                        "2.0.9"]
                 [kibu/pushy                  "0.3.6"]

                 [com.cognitect/transit-clj   "0.8.288"        :scope "test"]
                 [com.cemerick/piggieback     "0.2.1"          :scope "test"]
                 [adzerk/boot-cljs            "1.7.228-1"      :scope "test"]
                 [adzerk/boot-cljs-repl       "0.3.3"          :scope "test"]
                 [adzerk/boot-reload          "0.4.12"         :scope "test"]
                 [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]
                 [deraen/boot-less            "0.5.0"          :scope "test"]
                 [org.clojure/tools.nrepl     "0.2.12"         :scope "test"]
                 [pandeiro/boot-http          "0.7.3"          :scope "test"]
                 [weasel                      "0.7.0"          :scope "test"]])

(require
 '[adzerk.boot-cljs            :refer [cljs]]
 '[adzerk.boot-cljs-repl       :refer [cljs-repl start-repl]]
 '[adzerk.boot-reload          :refer [reload]]
 '[crisptrutski.boot-cljs-test :refer [test-cljs]]
 '[deraen.boot-less            :refer [less]]
 '[pandeiro.boot-http          :refer [serve]])

(deftask dev []
  (comp
    (serve)
    (watch)
    (cljs-repl)
    (reload :on-jsload '{{name}}.core/init!)
    (speak)
    (less)
    (cljs :source-map true
          :compiler-options {:parallel-build true}
          :ids #{"js/dev"})
    (sift :move {#"dev.js" "main.js"})
    (target)))

(deftask release []
  (comp
    (less)
    (cljs :optimizations :advanced
      :ids #{"js/dev"}
      :compiler-options {:parallel-build true
                         :elide-asserts true
                         :closure-defines {"goog.DEBUG" false}})
    (sift :move {#"dev.js" "main.js"})
    (target)))

(deftask testing []
  (set-env! :source-paths #(conj % "src/test"))
  identity)

(ns-unmap 'boot.user 'test)

(deftask test
  [e exit?     bool  "Exit after running the tests."]
  (let [exit? (cond-> exit?
                (nil? exit?) not)]
    (comp
      (testing)
      (test-cljs
        :js-env :node
        :namespaces #{'{{name}}.tests}
        :cljs-opts {:parallel-build true}
        :exit? exit?))))

(deftask auto-test []
  (comp
    (watch)
    (speak)
    (test :exit? false)))

(set-env!
 :source-paths    #{"src/main"}
 :resource-paths  #{"resources"}
 :dependencies '[[org.clojure/clojurescript   "1.9.89"]
                 [org.omcljs/om               "1.0.0-alpha41"]
                 [compassus                   "0.2.1"]
                 [bidi                        "2.0.9"]
                 [kibu/pushy                  "0.3.6"]

                 [com.cognitect/transit-clj   "0.8.288"        :scope "test"]
                 [com.cemerick/piggieback     "0.2.1"          :scope "test"]
                 [adzerk/boot-cljs            "1.7.228-1"      :scope "test"]
                 [adzerk/boot-cljs-repl       "0.3.3"          :scope "test"]
                 [adzerk/boot-reload          "0.4.12"         :scope "test"]
                 [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]
                 [deraen/boot-less            "0.5.0"          :scope "test"]
                 [org.slf4j/slf4j-nop         "1.7.21"         :scope "test"]
                 [org.clojure/tools.nrepl     "0.2.12"         :scope "test"]
                 [pandeiro/boot-http          "0.7.3"          :scope "test"]
                 [weasel                      "0.7.0"          :scope "test"]])

(require
 '[adzerk.boot-cljs            :refer [cljs]]
 '[adzerk.boot-cljs-repl       :refer [cljs-repl start-repl]]
 '[adzerk.boot-reload          :refer [reload]]
 '[crisptrutski.boot-cljs-test :refer [test-cljs]]
 '[deraen.boot-less            :refer [less]]
 '[pandeiro.boot-http          :refer [serve]])

(deftask dev []
  (comp
    (serve)
    (watch)
    (cljs-repl)
    (reload :on-jsload '{{name}}.core/init!)
    (speak)
    (less)
    (cljs :source-map true
          :compiler-options {:parallel-build true}
          :ids #{"js/dev"})
    (sift :move {#"dev.js" "main.js"})
    (target)))

(deftask release []
  (comp
    (less)
    (cljs :optimizations :advanced
      :ids #{"js/dev"}
      :compiler-options {:parallel-build true
                         :elide-asserts true
                         :closure-defines {"goog.DEBUG" false}})
    (sift :move {#"dev.js" "main.js"})
    (target)))

(deftask testing []
  (set-env! :source-paths #(conj % "src/test"))
  identity)

(ns-unmap 'boot.user 'test)

(deftask test
  [e exit?     bool  "Exit after running the tests."]
  (let [exit? (cond-> exit?
                (nil? exit?) not)]
    (comp
      (testing)
      (test-cljs
        :js-env :node
        :namespaces #{'{{name}}.tests}
        :cljs-opts {:parallel-build true}
        :exit? exit?))))

(deftask auto-test []
  (comp
    (watch)
    (speak)
    (test :exit? false)))

add slf4j-nop to suppres boot-less logging warnings